1-- VHDL parser. 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.Nodes_Utils; use Vhdl.Nodes_Utils; 17with Vhdl.Tokens; use Vhdl.Tokens; 18with Vhdl.Scanner; use Vhdl.Scanner; 19with Vhdl.Utils; use Vhdl.Utils; 20with Errorout; use Errorout; 21with Vhdl.Errors; use Vhdl.Errors; 22with Std_Names; use Std_Names; 23with Flags; use Flags; 24with Vhdl.Parse_Psl; 25with Str_Table; 26with Vhdl.Xrefs; 27with Vhdl.Elocations; use Vhdl.Elocations; 28with PSL.Types; use PSL.Types; 29 30-- Recursive descendant parser. 31-- Each subprogram (should) parse one production rules. 32-- Rules are written in a comment just before the subprogram. 33-- terminals are written in upper case. 34-- non-terminal are written in lower case. 35-- syntaxic category of a non-terminal are written in upper case. 36-- eg: next_statement ::= [ label : ] NEXT [ LOOP_label ] [ WHEN condition ] ; 37-- Or (|) must be aligned by the previous or, or with the '=' character. 38-- Indentation is 4. 39-- 40-- To document what is expected for input and what is left as an output 41-- concerning token stream, a precond and a postcond comment shoud be 42-- added before the above rules. 43-- a token (such as IF or ';') means the current token is this token. 44-- 'a token' means the current token was analysed. 45-- 'next token' means the current token is to be analysed. 46 47package body Vhdl.Parse is 48 49 -- current_token must be valid. 50 -- Leaves a token. 51 function Parse_Primary return Iir_Expression; 52 function Parse_Use_Clause return Iir_Use_Clause; 53 54 function Parse_Association_List return Iir; 55 function Parse_Association_List_In_Parenthesis return Iir; 56 57 function Parse_Sequential_Statements (Parent : Iir) return Iir; 58 function Parse_Configuration_Item return Iir; 59 function Parse_Block_Configuration return Iir_Block_Configuration; 60 procedure Parse_Concurrent_Statements (Parent : Iir); 61 function Parse_Subprogram_Declaration return Iir; 62 function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir; 63 function Parse_Subnature_Indication return Iir; 64 function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : Iir) 65 return Iir; 66 procedure Parse_Component_Specification (Res : Iir); 67 function Parse_Binding_Indication return Iir_Binding_Indication; 68 function Parse_Aggregate return Iir; 69 function Parse_Signature return Iir_Signature; 70 procedure Parse_Declarative_Part (Parent : Iir; Package_Parent : Iir); 71 function Parse_Tolerance_Aspect_Opt return Iir; 72 function Parse_Package (Parent : Iir) return Iir; 73 74 function Parse_Simultaneous_If_Statement (Label : Name_Id; 75 Label_Loc : Location_Type; 76 If_Loc : Location_Type; 77 First_Cond : Iir) return Iir; 78 function Parse_Simultaneous_Case_Statement 79 (Label : Name_Id; Loc : Location_Type; Expr : Iir) return Iir; 80 function Parse_Generic_Map_Aspect return Iir; 81 82 -- Maximum number of nested parenthesis, before generating an error. 83 Max_Parenthesis_Depth : constant Natural := 1000; 84 85 -- Current number of open parenthesis (in expressions). 86 Parenthesis_Depth : Natural := 0; 87 88 -- Copy the current location into an iir. 89 procedure Set_Location (Node : Iir) is 90 begin 91 Set_Location (Node, Get_Token_Location); 92 end Set_Location; 93 94 -- Disp a message during parse 95 -- The location of the current token is automatically displayed before 96 -- the message. 97 procedure Error_Msg_Parse (Msg: String; Arg1 : Earg_Type) is 98 begin 99 Report_Msg (Msgid_Error, Errorout.Parse, Get_Token_Coord, 100 Msg, (1 => Arg1)); 101 end Error_Msg_Parse; 102 103 procedure Error_Msg_Parse (Msg: String; Args : Earg_Arr := No_Eargs) is 104 begin 105 Report_Msg (Msgid_Error, Errorout.Parse, Get_Token_Coord, Msg, Args); 106 end Error_Msg_Parse; 107 108 procedure Error_Msg_Parse (Loc : Location_Type; 109 Msg: String; 110 Args : Earg_Arr := No_Eargs) is 111 begin 112 Report_Msg (Msgid_Error, Errorout.Parse, +Loc, Msg, Args); 113 end Error_Msg_Parse; 114 115 procedure Unexpected (Where: String) is 116 begin 117 Error_Msg_Parse ("unexpected token %t in a " & Where, +Current_Token); 118 end Unexpected; 119 120 procedure Expect_Error (Token: Token_Type; Msg: String := "") 121 is 122 Loc : Location_Type; 123 begin 124 case Token is 125 when Tok_Semi_Colon 126 | Tok_Right_Paren 127 | Tok_Comma => 128 Loc := Get_Prev_Location; 129 when others => 130 Loc := Get_Token_Location; 131 end case; 132 133 if Msg'Length > 0 then 134 Report_Start_Group; 135 Error_Msg_Parse (Loc, Msg, Args => No_Eargs); 136 Error_Msg_Parse (Loc, "(found: %t)", (1 => +Current_Token)); 137 Report_End_Group; 138 elsif Current_Token = Tok_Identifier then 139 Error_Msg_Parse (Loc, "%t is expected instead of %i", 140 (+Token, +Current_Identifier)); 141 else 142 Error_Msg_Parse 143 (Loc, "%t is expected instead of %t", (+Token, +Current_Token)); 144 end if; 145 end Expect_Error; 146 147 -- Emit an error if the current_token if different from TOKEN. 148 -- Otherwise, accept the current_token (ie set it to tok_invalid, unless 149 -- TOKEN is Tok_Identifier). 150 procedure Expect (Token: Token_Type; Msg: String := "") is 151 begin 152 if Current_Token /= Token then 153 Expect_Error (Token, Msg); 154 end if; 155 end Expect; 156 157 procedure Expect_Scan (Token: Token_Type; Msg: String := "") is 158 begin 159 if Current_Token = Token then 160 -- Skip token. 161 Scan; 162 else 163 Expect_Error (Token, Msg); 164 end if; 165 end Expect_Scan; 166 167 -- Expect the identifier for node RES. 168 procedure Scan_Identifier (Res : Iir) is 169 begin 170 Set_Location (Res); 171 if Current_Token = Tok_Identifier then 172 Set_Identifier (Res, Current_Identifier); 173 174 -- Skip identifier. 175 Scan; 176 else 177 Expect (Tok_Identifier); 178 end if; 179 end Scan_Identifier; 180 181 -- If the current_token is an identifier, it must be equal to name. 182 -- In this case, a token is eaten. 183 -- If the current_token is not an identifier, this is a noop. 184 procedure Check_End_Name (Name : Name_Id; Decl : Iir) is 185 begin 186 if Current_Token /= Tok_Identifier then 187 return; 188 end if; 189 if Name = Null_Identifier then 190 Error_Msg_Parse 191 ("end label for an unlabeled declaration or statement"); 192 else 193 if Current_Identifier /= Name then 194 Error_Msg_Parse ("misspelling, %i expected", +Name); 195 else 196 Set_End_Has_Identifier (Decl, True); 197 Xrefs.Xref_End (Get_Token_Location, Decl); 198 end if; 199 end if; 200 201 -- Skip identifier. 202 Scan; 203 end Check_End_Name; 204 205 procedure Check_End_Name (Decl : Iir) is 206 begin 207 Check_End_Name (Get_Identifier (Decl), Decl); 208 end Check_End_Name; 209 210 -- Skip the reserved identifier after 'end'. 211 procedure Scan_End_Token (Tok : Token_Type; Decl : Iir) is 212 begin 213 if Current_Token /= Tok then 214 Error_Msg_Parse ("""end"" must be followed by %t", +Tok); 215 case Current_Token is 216 when Tok_If 217 | Tok_Loop 218 | Tok_Case 219 | Tok_Process => 220 -- Mismatching token. 221 Scan; 222 when others => 223 null; 224 end case; 225 else 226 Set_End_Has_Reserved_Id (Decl, True); 227 228 -- Skip tok. 229 Scan; 230 end if; 231 end Scan_End_Token; 232 233 -- Expect ' END tok [ name ] ; ' 234 procedure Check_End_Name (Tok : Token_Type; Decl : Iir) is 235 begin 236 if Current_Token /= Tok_End then 237 Error_Msg_Parse ("""end " & Image (Tok) & ";"" expected"); 238 else 239 -- Skip 'end'. 240 Scan; 241 242 Scan_End_Token (Tok, Decl); 243 244 Check_End_Name (Decl); 245 end if; 246 end Check_End_Name; 247 248 procedure Skip_Until_Semi_Colon is 249 begin 250 loop 251 case Current_Token is 252 when Tok_Semi_Colon 253 | Tok_Eof => 254 exit; 255 when others => 256 Scan; 257 end case; 258 end loop; 259 end Skip_Until_Semi_Colon; 260 261 procedure Resync_To_End_Of_Statement is 262 begin 263 loop 264 case Current_Token is 265 when Tok_Eof 266 | Tok_Semi_Colon 267 | Tok_End => 268 exit; 269 when Tok_If 270 | Tok_Else 271 | Tok_Case 272 | Tok_For 273 | Tok_While 274 | Tok_Loop 275 | Tok_Wait 276 | Tok_Assert => 277 -- Sequential statement. 278 exit; 279 when Tok_Process 280 | Tok_Block => 281 -- Concurrent statement. 282 exit; 283 when others => 284 Scan; 285 end case; 286 end loop; 287 end Resync_To_End_Of_Statement; 288 289 procedure Resync_To_End_Of_Declaration is 290 begin 291 loop 292 case Current_Token is 293 when Tok_Eof => 294 exit; 295 when Tok_Semi_Colon => 296 Scan; 297 exit; 298 when Tok_End 299 | Tok_Begin => 300 -- End of current block. 301 exit; 302 when Tok_Signal 303 | Tok_Variable 304 | Tok_Constant 305 | Tok_File 306 | Tok_Alias 307 | Tok_Type 308 | Tok_Subtype 309 | Tok_Use 310 | Tok_Component 311 | Tok_Attribute 312 | Tok_Group 313 | Tok_For 314 | Tok_Disconnect 315 | Tok_Shared 316 | Tok_Impure 317 | Tok_Pure 318 | Tok_Function 319 | Tok_Procedure 320 | Tok_Package => 321 -- Start of a new declaration 322 exit; 323 when others => 324 -- Eat. 325 Scan; 326 end case; 327 end loop; 328 end Resync_To_End_Of_Declaration; 329 330 procedure Resync_To_Next_Unit is 331 begin 332 -- Resync. 333 loop 334 case Current_Token is 335 when Tok_Eof => 336 exit; 337 when Tok_Semi_Colon => 338 -- Skip ';'. 339 Scan; 340 exit; 341 when Tok_Library 342 | Tok_Use 343 | Tok_Architecture 344 | Tok_Entity 345 | Tok_Package 346 | Tok_Configuration 347 | Tok_Context => 348 -- Possible start of a new unit. 349 exit; 350 when others => 351 Scan; 352 end case; 353 end loop; 354 end Resync_To_Next_Unit; 355 356 procedure Skip_Until_Closing_Parenthesis 357 is 358 Level : Natural; 359 begin 360 Level := 0; 361 362 -- Skip '('. 363 Scan; 364 365 loop 366 case Current_Token is 367 when Tok_Right_Paren => 368 if Level = 0 then 369 -- Skip ')'. 370 Scan; 371 exit; 372 end if; 373 Level := Level - 1; 374 when Tok_Left_Paren => 375 Level := Level + 1; 376 when Tok_Eof 377 | Tok_Semi_Colon 378 | Tok_End 379 | Tok_Then 380 | Tok_Else 381 | Tok_Loop => 382 exit; 383 when others => 384 null; 385 end case; 386 387 Scan; 388 end loop; 389 end Skip_Until_Closing_Parenthesis; 390 391 -- Return True if at the end of the list, False if there is another 392 -- interface. 393 function Resync_To_End_Of_Interface return Boolean 394 is 395 Nested : Natural; 396 begin 397 Nested := 0; 398 loop 399 case Current_Token is 400 when Tok_End 401 | Tok_Port 402 | Tok_Is 403 | Tok_Begin 404 | Tok_Eof => 405 -- Certainly comes after interface list. 406 return True; 407 when Tok_Left_Paren => 408 Nested := Nested + 1; 409 when Tok_Right_Paren => 410 if Nested = 0 then 411 -- Skip ')'. 412 Scan; 413 414 return True; 415 end if; 416 Nested := Nested - 1; 417 when Tok_Semi_Colon => 418 if Nested = 0 then 419 -- Skip ';'. 420 Scan; 421 422 return False; 423 end if; 424 when Tok_Signal 425 | Tok_Variable 426 | Tok_Constant 427 | Tok_File 428 | Tok_Function 429 | Tok_Procedure 430 | Tok_Type 431 | Tok_Package => 432 -- Next interface ? 433 return False; 434 when Tok_Colon 435 | Tok_Identifier 436 | Tok_In 437 | Tok_Out 438 | Tok_Inout 439 | Tok_Buffer 440 | Tok_Linkage => 441 -- Certainly part of an interface. 442 null; 443 when others => 444 null; 445 end case; 446 447 -- Skip token. 448 Scan; 449 end loop; 450 end Resync_To_End_Of_Interface; 451 452 procedure Error_Missing_Semi_Colon (Msg : String) is 453 begin 454 Error_Msg_Parse (Get_Prev_Location, "missing "";"" at end of " & Msg); 455 end Error_Missing_Semi_Colon; 456 457 -- Expect and scan ';' emit an error message using MSG if not present. 458 procedure Scan_Semi_Colon (Msg : String) is 459 begin 460 if Current_Token /= Tok_Semi_Colon then 461 Error_Missing_Semi_Colon (Msg); 462 else 463 Scan; 464 end if; 465 end Scan_Semi_Colon; 466 467 procedure Scan_Semi_Colon_Declaration (Msg : String) is 468 begin 469 if Current_Token = Tok_Semi_Colon then 470 -- Skip ';'. 471 Scan; 472 else 473 Error_Missing_Semi_Colon (Msg); 474 475 Resync_To_End_Of_Declaration; 476 end if; 477 end Scan_Semi_Colon_Declaration; 478 479 procedure Scan_Semi_Colon_Unit (Msg : String) is 480 begin 481 if Current_Token = Tok_Semi_Colon then 482 -- Skip ';'. 483 Scan; 484 else 485 Error_Missing_Semi_Colon (Msg); 486 Resync_To_Next_Unit; 487 end if; 488 end Scan_Semi_Colon_Unit; 489 490 function Create_Error_Node (Orig : Iir := Null_Iir) return Iir 491 is 492 Res : Iir; 493 begin 494 Res := Create_Error (Orig); 495 if Orig = Null_Iir then 496 Set_Location (Res); 497 end if; 498 return Res; 499 end Create_Error_Node; 500 501 -- precond : next token 502 -- postcond: next token. 503 -- 504 -- [ LRM93 4.3.2 ] 505 -- mode ::= IN | OUT | INOUT | BUFFER | LINKAGE 506 -- 507 -- If there is no mode, DEFAULT is returned. 508 function Parse_Mode return Iir_Mode is 509 begin 510 case Current_Token is 511 when Tok_In => 512 Scan; 513 if Current_Token = Tok_Out then 514 -- Nice message for Ada users... 515 Error_Msg_Parse 516 ("typo error, 'in out' must be 'inout' in vhdl"); 517 Scan; 518 return Iir_Inout_Mode; 519 end if; 520 return Iir_In_Mode; 521 when Tok_Out => 522 Scan; 523 return Iir_Out_Mode; 524 when Tok_Inout => 525 Scan; 526 return Iir_Inout_Mode; 527 when Tok_Linkage => 528 Scan; 529 return Iir_Linkage_Mode; 530 when Tok_Buffer => 531 Scan; 532 return Iir_Buffer_Mode; 533 when others => 534 -- Cannot happen. 535 raise Internal_Error; 536 end case; 537 end Parse_Mode; 538 539 -- precond : next token 540 -- postcond: next token 541 -- 542 -- [ LRM93 4.3.1.2 ] 543 -- signal_kind ::= REGISTER | BUS 544 -- 545 -- If there is no signal_kind, then no_signal_kind is returned. 546 procedure Parse_Signal_Kind 547 (Is_Guarded : out Boolean; Signal_Kind : out Iir_Signal_Kind) is 548 begin 549 if Current_Token = Tok_Bus then 550 -- Eat 'bus' 551 Scan; 552 553 Is_Guarded := True; 554 Signal_Kind := Iir_Bus_Kind; 555 elsif Current_Token = Tok_Register then 556 -- Eat 'register' 557 Scan; 558 559 Is_Guarded := True; 560 Signal_Kind := Iir_Register_Kind; 561 else 562 Is_Guarded := False; 563 -- Avoid uninitialized variable. 564 Signal_Kind := Iir_Bus_Kind; 565 end if; 566 end Parse_Signal_Kind; 567 568 -- precond : TO, DOWNTO 569 -- postcond: next token 570 -- 571 -- Parse a range. 572 -- If LEFT is not null_iir, then it must be an expression corresponding to 573 -- the left limit of the range, and the current_token must be either 574 -- tok_to or tok_downto. 575 -- If left is null_iir, the current token is used to create the left limit 576 -- expression. 577 -- 578 -- [ LRM93 3.1 ] 579 -- range_constraint ::= RANGE range 580 -- 581 -- [ LRM93 3.1 ] 582 -- range ::= RANGE_attribute_name 583 -- | simple_expression direction simple_expression 584 -- 585 -- direction ::= TO | DOWNTO 586 function Parse_Range_Expression (Left : Iir) return Iir 587 is 588 Res : Iir; 589 begin 590 Res := Create_Iir (Iir_Kind_Range_Expression); 591 592 if Left /= Null_Iir then 593 Set_Left_Limit_Expr (Res, Left); 594 Location_Copy (Res, Left); 595 end if; 596 597 case Current_Token is 598 when Tok_To => 599 Set_Direction (Res, Dir_To); 600 when Tok_Downto => 601 Set_Direction (Res, Dir_Downto); 602 when others => 603 raise Internal_Error; 604 end case; 605 606 -- Skip 'to' or 'downto'. 607 Scan; 608 609 Set_Right_Limit_Expr (Res, Parse_Expression (Prio_Simple)); 610 return Res; 611 end Parse_Range_Expression; 612 613 -- precond: next token 614 -- postcond: next token 615 function Parse_Range return Iir 616 is 617 Left: Iir; 618 begin 619 Left := Parse_Expression (Prio_Simple); 620 621 case Current_Token is 622 when Tok_To 623 | Tok_Downto => 624 return Parse_Range_Expression (Left); 625 when others => 626 if Left /= Null_Iir then 627 if Is_Range_Attribute_Name (Left) then 628 return Left; 629 end if; 630 Error_Msg_Parse ("'to' or 'downto' expected"); 631 end if; 632 return Create_Error_Node (Left); 633 end case; 634 end Parse_Range; 635 636 -- precond: next token (after RANGE) 637 -- postcond: next token 638 function Parse_Range_Constraint return Iir is 639 begin 640 if Current_Token = Tok_Box then 641 Error_Msg_Parse ("range constraint required"); 642 Scan; 643 return Null_Iir; 644 end if; 645 646 return Parse_Range; 647 end Parse_Range_Constraint; 648 649 -- precond: next token (after RANGE) 650 -- postcond: next token 651 function Parse_Range_Constraint_Of_Subtype_Indication 652 (Type_Mark : Iir; 653 Resolution_Indication : Iir := Null_Iir) 654 return Iir 655 is 656 Def : Iir; 657 begin 658 Def := Create_Iir (Iir_Kind_Subtype_Definition); 659 if Type_Mark /= Null_Iir then 660 Location_Copy (Def, Type_Mark); 661 Set_Subtype_Type_Mark (Def, Type_Mark); 662 else 663 Set_Location (Def); 664 end if; 665 Set_Range_Constraint (Def, Parse_Range_Constraint); 666 Set_Resolution_Indication (Def, Resolution_Indication); 667 Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt); 668 669 return Def; 670 end Parse_Range_Constraint_Of_Subtype_Indication; 671 672 -- precond: next token 673 -- postcond: next token 674 -- 675 -- [ LRM93 3.2.1 ] 676 -- discrete_range ::= discrete_subtype_indication | range 677 function Parse_Discrete_Range return Iir 678 is 679 Left: Iir; 680 begin 681 Left := Parse_Expression (Prio_Simple); 682 683 case Current_Token is 684 when Tok_To 685 | Tok_Downto => 686 return Parse_Range_Expression (Left); 687 when Tok_Range => 688 return Parse_Subtype_Indication (Left); 689 when others => 690 -- Either a /range/_attribute_name or a type_mark. 691 return Left; 692 end case; 693 end Parse_Discrete_Range; 694 695 -- Convert the STR (0 .. LEN - 1) into a operator symbol identifier. 696 -- Emit an error message if the name is not an operator name. 697 function Str_To_Operator_Name (Str_Id : String8_Id; 698 Len : Nat32; 699 Loc : Location_Type) return Name_Id 700 is 701 -- LRM93 2.1 702 -- Extra spaces are not allowed in an operator symbol, and the 703 -- case of letters is not signifiant. 704 705 -- LRM93 2.1 706 -- The sequence of characters represented by an operator symbol 707 -- must be an operator belonging to one of classes of operators 708 -- defined in section 7.2. 709 710 procedure Bad_Operator_Symbol is 711 begin 712 Error_Msg_Parse 713 (+Loc, "%s is not an operator symbol", (1 => +((Str_Id, Len)))); 714 end Bad_Operator_Symbol; 715 716 procedure Check_Vhdl93 is 717 begin 718 if Flags.Vhdl_Std = Vhdl_87 then 719 Error_Msg_Parse 720 (+Loc, "%s is not a vhdl87 operator symbol", 721 (1 => +((Str_Id, Len)))); 722 end if; 723 end Check_Vhdl93; 724 725 Id : Name_Id; 726 C1, C2, C3, C4 : Character; 727 begin 728 C1 := Str_Table.Char_String8 (Str_Id, 1); 729 case Len is 730 when 1 => 731 -- =, <, >, +, -, *, /, & 732 case C1 is 733 when '=' => 734 Id := Name_Op_Equality; 735 when '>' => 736 Id := Name_Op_Greater; 737 when '<' => 738 Id := Name_Op_Less; 739 when '+' => 740 Id := Name_Op_Plus; 741 when '-' => 742 Id := Name_Op_Minus; 743 when '*' => 744 Id := Name_Op_Mul; 745 when '/' => 746 Id := Name_Op_Div; 747 when '&' => 748 Id := Name_Op_Concatenation; 749 when others => 750 Bad_Operator_Symbol; 751 Id := Name_Op_Plus; 752 end case; 753 when 2 => 754 -- or, /=, <=, >=, ** 755 C2 := Str_Table.Char_String8 (Str_Id, 2); 756 case C1 is 757 when 'o' | 'O' => 758 Id := Name_Or; 759 if C2 /= 'r' and C2 /= 'R' then 760 Bad_Operator_Symbol; 761 end if; 762 when '/' => 763 Id := Name_Op_Inequality; 764 if C2 /= '=' then 765 Bad_Operator_Symbol; 766 end if; 767 when '<' => 768 Id := Name_Op_Less_Equal; 769 if C2 /= '=' then 770 Bad_Operator_Symbol; 771 end if; 772 when '>' => 773 Id := Name_Op_Greater_Equal; 774 if C2 /= '=' then 775 Bad_Operator_Symbol; 776 end if; 777 when '*' => 778 Id := Name_Op_Exp; 779 if C2 /= '*' then 780 Bad_Operator_Symbol; 781 end if; 782 when '?' => 783 if Vhdl_Std < Vhdl_08 then 784 Bad_Operator_Symbol; 785 Id := Name_Op_Condition; 786 elsif C2 = '?' then 787 Id := Name_Op_Condition; 788 elsif C2 = '=' then 789 Id := Name_Op_Match_Equality; 790 elsif C2 = '<' then 791 Id := Name_Op_Match_Less; 792 elsif C2 = '>' then 793 Id := Name_Op_Match_Greater; 794 else 795 Bad_Operator_Symbol; 796 Id := Name_Op_Condition; 797 end if; 798 when others => 799 Bad_Operator_Symbol; 800 Id := Name_Op_Equality; 801 end case; 802 when 3 => 803 -- mod, rem, and, xor, nor, abs, not, sll, sla, sra, srl, rol 804 -- ror 805 C2 := Str_Table.Char_String8 (Str_Id, 2); 806 C3 := Str_Table.Char_String8 (Str_Id, 3); 807 case C1 is 808 when 'm' | 'M' => 809 Id := Name_Mod; 810 if (C2 /= 'o' and C2 /= 'O') or (C3 /= 'd' and C3 /= 'D') 811 then 812 Bad_Operator_Symbol; 813 end if; 814 when 'a' | 'A' => 815 if (C2 = 'n' or C2 = 'N') and (C3 = 'd' or C3 = 'D') then 816 Id := Name_And; 817 elsif (C2 = 'b' or C2 = 'B') and (C3 = 's' or C3 = 'S') then 818 Id := Name_Abs; 819 else 820 Id := Name_And; 821 Bad_Operator_Symbol; 822 end if; 823 when 'x' | 'X' => 824 Id := Name_Xor; 825 if (C2 /= 'o' and C2 /= 'O') or (C3 /= 'r' and C3 /= 'R') 826 then 827 Bad_Operator_Symbol; 828 end if; 829 when 'n' | 'N' => 830 if C2 = 'o' or C2 = 'O' then 831 if C3 = 'r' or C3 = 'R' then 832 Id := Name_Nor; 833 elsif C3 = 't' or C3 = 'T' then 834 Id := Name_Not; 835 else 836 Id := Name_Not; 837 Bad_Operator_Symbol; 838 end if; 839 else 840 Id := Name_Not; 841 Bad_Operator_Symbol; 842 end if; 843 when 's' | 'S' => 844 if C2 = 'l' or C2 = 'L' then 845 if C3 = 'l' or C3 = 'L' then 846 Check_Vhdl93; 847 Id := Name_Sll; 848 elsif C3 = 'a' or C3 = 'A' then 849 Check_Vhdl93; 850 Id := Name_Sla; 851 else 852 Id := Name_Sll; 853 Bad_Operator_Symbol; 854 end if; 855 elsif C2 = 'r' or C2 = 'R' then 856 if C3 = 'l' or C3 = 'L' then 857 Check_Vhdl93; 858 Id := Name_Srl; 859 elsif C3 = 'a' or C3 = 'A' then 860 Check_Vhdl93; 861 Id := Name_Sra; 862 else 863 Id := Name_Srl; 864 Bad_Operator_Symbol; 865 end if; 866 else 867 Id := Name_Sll; 868 Bad_Operator_Symbol; 869 end if; 870 when 'r' | 'R' => 871 if C2 = 'e' or C2 = 'E' then 872 if C3 = 'm' or C3 = 'M' then 873 Id := Name_Rem; 874 else 875 Id := Name_Rem; 876 Bad_Operator_Symbol; 877 end if; 878 elsif C2 = 'o' or C2 = 'O' then 879 if C3 = 'l' or C3 = 'L' then 880 Check_Vhdl93; 881 Id := Name_Rol; 882 elsif C3 = 'r' or C3 = 'R' then 883 Check_Vhdl93; 884 Id := Name_Ror; 885 else 886 Id := Name_Rol; 887 Bad_Operator_Symbol; 888 end if; 889 else 890 Id := Name_Rem; 891 Bad_Operator_Symbol; 892 end if; 893 when '?' => 894 if Vhdl_Std < Vhdl_08 then 895 Bad_Operator_Symbol; 896 Id := Name_Op_Match_Less_Equal; 897 else 898 if C2 = '<' and C3 = '=' then 899 Id := Name_Op_Match_Less_Equal; 900 elsif C2 = '>' and C3 = '=' then 901 Id := Name_Op_Match_Greater_Equal; 902 elsif C2 = '/' and C3 = '=' then 903 Id := Name_Op_Match_Inequality; 904 else 905 Bad_Operator_Symbol; 906 Id := Name_Op_Match_Less_Equal; 907 end if; 908 end if; 909 when others => 910 Id := Name_And; 911 Bad_Operator_Symbol; 912 end case; 913 when 4 => 914 -- nand, xnor 915 C2 := Str_Table.Char_String8 (Str_Id, 2); 916 C3 := Str_Table.Char_String8 (Str_Id, 3); 917 C4 := Str_Table.Char_String8 (Str_Id, 4); 918 if (C1 = 'n' or C1 = 'N') 919 and (C2 = 'a' or C2 = 'A') 920 and (C3 = 'n' or C3 = 'N') 921 and (C4 = 'd' or C4 = 'D') 922 then 923 Id := Name_Nand; 924 elsif (C1 = 'x' or C1 = 'X') 925 and (C2 = 'n' or C2 = 'N') 926 and (C3 = 'o' or C3 = 'O') 927 and (C4 = 'r' or C4 = 'R') 928 then 929 Check_Vhdl93; 930 Id := Name_Xnor; 931 else 932 Id := Name_Nand; 933 Bad_Operator_Symbol; 934 end if; 935 when others => 936 Id := Name_Op_Plus; 937 Bad_Operator_Symbol; 938 end case; 939 return Id; 940 end Str_To_Operator_Name; 941 942 function Scan_To_Operator_Name (Loc : Location_Type) return Name_Id is 943 begin 944 return Str_To_Operator_Name 945 (Current_String_Id, Current_String_Length, Loc); 946 end Scan_To_Operator_Name; 947 pragma Inline (Scan_To_Operator_Name); 948 949 -- Convert string literal STR to an operator symbol. 950 -- Emit an error message if the string is not an operator name. 951 function String_To_Operator_Symbol (Str : Iir) return Iir 952 is 953 Id : Name_Id; 954 Res : Iir; 955 begin 956 Id := Str_To_Operator_Name 957 (Get_String8_Id (Str), Get_String_Length (Str), Get_Location (Str)); 958 Res := Create_Iir (Iir_Kind_Operator_Symbol); 959 Location_Copy (Res, Str); 960 Set_Identifier (Res, Id); 961 Free_Iir (Str); 962 return Res; 963 end String_To_Operator_Symbol; 964 965 -- [ LRM93 6.6 ] 966 -- attribute_name ::= 967 -- prefix [ signature ] ' attribute_designator [ ( expression ) ] 968 -- 969 function Parse_Attribute_Name (Prefix : Iir) return Iir 970 is 971 Res : Iir; 972 begin 973 case Current_Token is 974 when Tok_Range 975 | Tok_Identifier 976 | Tok_Stable => 977 -- Tok_Stable is possible within PSL expressions. 978 null; 979 when Tok_Across 980 | Tok_Through 981 | Tok_Reference 982 | Tok_Tolerance => 983 -- AMS reserved words. 984 null; 985 when Tok_Subtype => 986 if Vhdl_Std < Vhdl_08 then 987 Error_Msg_Parse 988 ("'subtype attribute is not allowed before vhdl08"); 989 end if; 990 when others => 991 return Null_Iir; 992 end case; 993 994 Res := Create_Iir (Iir_Kind_Attribute_Name); 995 Set_Identifier (Res, Current_Identifier); 996 Set_Location (Res); 997 if Get_Kind (Prefix) = Iir_Kind_Signature then 998 Set_Attribute_Signature (Res, Prefix); 999 1000 -- Transfer the prefix from the signature to the attribute. 1001 Set_Prefix (Res, Get_Signature_Prefix (Prefix)); 1002 Set_Signature_Prefix (Prefix, Null_Iir); 1003 else 1004 Set_Prefix (Res, Prefix); 1005 end if; 1006 1007 return Res; 1008 end Parse_Attribute_Name; 1009 1010 -- precond : next token 1011 -- postcond: next token 1012 -- 1013 -- [ LRM93 6.1 ] 1014 -- name ::= simple_name 1015 -- | operator_symbol 1016 -- | selected_name 1017 -- | indexed_name 1018 -- | slice_name 1019 -- | attribute_name 1020 -- 1021 -- [ LRM93 6.2 ] 1022 -- simple_name ::= identifier 1023 -- 1024 -- [ LRM93 6.5 ] 1025 -- slice_name ::= prefix ( discrete_range ) 1026 -- 1027 -- [ LRM93 6.3 ] 1028 -- selected_name ::= prefix . suffix 1029 -- 1030 -- [ LRM93 6.1 ] 1031 -- prefix ::= name 1032 -- | function_call 1033 -- 1034 -- [ LRM93 6.3 ] 1035 -- suffix ::= simple_name 1036 -- | character_literal 1037 -- | operator_symbol 1038 -- | ALL 1039 -- 1040 -- [ LRM93 3.2.1 ] 1041 -- discrete_range ::= DISCRETE_subtype_indication | range 1042 -- 1043 -- [ LRM93 3.1 ] 1044 -- range ::= RANGE_attribute_name 1045 -- | simple_expression direction simple_expression 1046 -- 1047 -- [ LRM93 3.1 ] 1048 -- direction ::= TO | DOWNTO 1049 -- 1050 -- [ LRM93 6.6 ] 1051 -- attribute_designator ::= ATTRIBUTE_simple_name 1052 -- 1053 -- Note: in order to simplify the parsing, this function may return a 1054 -- signature without attribute designator. Signatures may appear at 3 1055 -- places: 1056 -- - in attribute name 1057 -- - in alias declaration 1058 -- - in entity designator 1059 function Parse_Name_Suffix (Pfx : Iir; 1060 Allow_Indexes: Boolean := True; 1061 Allow_Signature : Boolean := False) 1062 return Iir 1063 is 1064 Res: Iir; 1065 Prefix: Iir; 1066 begin 1067 Res := Pfx; 1068 loop 1069 Prefix := Res; 1070 1071 case Current_Token is 1072 when Tok_Left_Bracket => 1073 if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then 1074 Prefix := String_To_Operator_Symbol (Prefix); 1075 end if; 1076 1077 -- There is a signature. They are normally followed by an 1078 -- attribute. 1079 Res := Parse_Signature; 1080 Set_Signature_Prefix (Res, Prefix); 1081 1082 when Tok_Tick => 1083 -- There is an attribute. 1084 if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then 1085 Prefix := String_To_Operator_Symbol (Prefix); 1086 end if; 1087 1088 -- Skip '''. 1089 Scan; 1090 1091 if Current_Token = Tok_Left_Paren then 1092 -- A qualified expression. 1093 Res := Create_Iir (Iir_Kind_Qualified_Expression); 1094 Set_Type_Mark (Res, Prefix); 1095 Location_Copy (Res, Prefix); 1096 Set_Expression (Res, Parse_Aggregate); 1097 return Res; 1098 else 1099 Res := Parse_Attribute_Name (Prefix); 1100 if Res = Null_Iir then 1101 Error_Msg_Parse ("attribute identifier expected after '"); 1102 return Create_Error_Node (Prefix); 1103 end if; 1104 1105 -- accept the identifier. 1106 Scan; 1107 end if; 1108 1109 when Tok_Left_Paren => 1110 if not Allow_Indexes then 1111 return Res; 1112 end if; 1113 1114 if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then 1115 Prefix := String_To_Operator_Symbol (Prefix); 1116 end if; 1117 1118 Res := Create_Iir (Iir_Kind_Parenthesis_Name); 1119 Set_Location (Res); 1120 Set_Prefix (Res, Prefix); 1121 Set_Association_Chain 1122 (Res, Parse_Association_List_In_Parenthesis); 1123 1124 when Tok_Dot => 1125 if Get_Kind (Prefix) = Iir_Kind_String_Literal8 then 1126 Prefix := String_To_Operator_Symbol (Prefix); 1127 end if; 1128 1129 -- Skip '.'. 1130 Scan; 1131 1132 case Current_Token is 1133 when Tok_All => 1134 Res := Create_Iir (Iir_Kind_Selected_By_All_Name); 1135 Set_Location (Res); 1136 Set_Prefix (Res, Prefix); 1137 1138 -- Skip 'all'. 1139 Scan; 1140 1141 when Tok_Identifier 1142 | Tok_Character => 1143 Res := Create_Iir (Iir_Kind_Selected_Name); 1144 Set_Location (Res); 1145 Set_Prefix (Res, Prefix); 1146 Set_Identifier (Res, Current_Identifier); 1147 1148 -- Skip identifier/character. 1149 Scan; 1150 1151 when Tok_String => 1152 Res := Create_Iir (Iir_Kind_Selected_Name); 1153 Set_Location (Res); 1154 Set_Prefix (Res, Prefix); 1155 Set_Identifier 1156 (Res, Scan_To_Operator_Name (Get_Token_Location)); 1157 1158 -- Skip string. 1159 Scan; 1160 1161 when others => 1162 Error_Msg_Parse 1163 ("identifier or ""all"" is expected after '.'"); 1164 Res := Prefix; 1165 end case; 1166 1167 when others => 1168 if not Allow_Signature 1169 and then Get_Kind (Res) = Iir_Kind_Signature 1170 then 1171 -- Not as a name. 1172 Error_Msg_Parse ("signature name not expected here"); 1173 Prefix := Get_Signature_Prefix (Res); 1174 Set_Signature_Prefix (Res, Null_Iir); 1175 Free_Iir (Res); 1176 Res := Prefix; 1177 end if; 1178 return Res; 1179 end case; 1180 end loop; 1181 end Parse_Name_Suffix; 1182 1183 -- Precond: next token 1184 -- Postcond: next token 1185 -- 1186 -- LRM08 8.7 External names 1187 -- 1188 -- external_pathname ::= 1189 -- package_pathname 1190 -- | absolute_pathname 1191 -- | relative_pathname 1192 -- 1193 -- package_pathname ::= 1194 -- @ library_logical_name . package_simple_name . 1195 -- { package_simple_name . } object_simple_name 1196 -- 1197 -- absolute_pathname ::= 1198 -- . partial_pathname 1199 -- 1200 -- relative_pathname ::= 1201 -- { ^ . } partial_pathname 1202 -- 1203 -- partial_pathname ::= { pathname_element . } object_simple_name 1204 -- 1205 -- pathname_element ::= 1206 -- entity_simple_name 1207 -- | component_instantiation_label 1208 -- | block_label 1209 -- | generate_statement_label [ ( static_expression ) ] 1210 -- | package_simple_name 1211 function Parse_External_Pathname return Iir 1212 is 1213 Res : Iir; 1214 Last : Iir; 1215 El : Iir; 1216 begin 1217 case Current_Token is 1218 when Tok_Arobase => 1219 Res := Create_Iir (Iir_Kind_Package_Pathname); 1220 Set_Location (Res); 1221 Last := Res; 1222 1223 -- Skip '@'. 1224 Scan; 1225 1226 if Current_Token /= Tok_Identifier then 1227 Error_Msg_Parse ("library name expected after '@'"); 1228 else 1229 Set_Identifier (Res, Current_Identifier); 1230 1231 -- Skip identifier. 1232 Scan; 1233 end if; 1234 1235 if Current_Token /= Tok_Dot then 1236 Error_Msg_Parse ("'.' expected after library name"); 1237 else 1238 -- Skip '.'. 1239 Scan; 1240 end if; 1241 1242 when Tok_Dot => 1243 Res := Create_Iir (Iir_Kind_Absolute_Pathname); 1244 Set_Location (Res); 1245 Last := Res; 1246 1247 -- Skip '.'. 1248 Scan; 1249 1250 when Tok_Caret => 1251 Last := Null_Iir; 1252 loop 1253 El := Create_Iir (Iir_Kind_Relative_Pathname); 1254 Set_Location (El); 1255 1256 -- Skip '^'. 1257 Scan; 1258 1259 if Current_Token /= Tok_Dot then 1260 Error_Msg_Parse ("'.' expected after '^'"); 1261 else 1262 -- Skip '.'. 1263 Scan; 1264 end if; 1265 1266 if Last = Null_Iir then 1267 Res := El; 1268 else 1269 Set_Pathname_Suffix (Last, El); 1270 end if; 1271 Last := El; 1272 1273 exit when Current_Token /= Tok_Caret; 1274 end loop; 1275 1276 when Tok_Identifier => 1277 Last := Null_Iir; 1278 1279 when others => 1280 Last := Null_Iir; 1281 -- Error is handled just below. 1282 end case; 1283 1284 -- Parse pathname elements. 1285 loop 1286 if Current_Token /= Tok_Identifier then 1287 Error_Msg_Parse ("pathname element expected"); 1288 -- FIXME: resync. 1289 return Res; 1290 end if; 1291 1292 El := Create_Iir (Iir_Kind_Pathname_Element); 1293 Set_Location (El); 1294 Set_Identifier (El, Current_Identifier); 1295 if Last = Null_Iir then 1296 Res := El; 1297 else 1298 Set_Pathname_Suffix (Last, El); 1299 end if; 1300 Last := El; 1301 1302 -- Skip identifier. 1303 Scan; 1304 1305 exit when Current_Token /= Tok_Dot; 1306 1307 -- Skip '.'. 1308 Scan; 1309 end loop; 1310 1311 return Res; 1312 end Parse_External_Pathname; 1313 1314 -- Precond: '<<' 1315 -- Postcond: next token 1316 -- 1317 -- LRM08 8.7 External names 1318 -- external_name ::= 1319 -- external_constant_name 1320 -- | external_signal_name 1321 -- | external_variable_name 1322 -- 1323 -- external_constant_name ::= 1324 -- << CONSTANT external_pathname : subtype_indication >> 1325 -- 1326 -- external_signal_name ::= 1327 -- << SIGNAL external_pathname : subtype_indication >> 1328 -- 1329 -- external_variable_name ::= 1330 -- << VARIABLE external_pathname : subtype_indication >> 1331 function Parse_External_Name return Iir 1332 is 1333 Loc : Location_Type; 1334 Res : Iir; 1335 Kind : Iir_Kind; 1336 begin 1337 Loc := Get_Token_Location; 1338 1339 -- Skip '<<'. 1340 Scan; 1341 1342 case Current_Token is 1343 when Tok_Constant => 1344 Kind := Iir_Kind_External_Constant_Name; 1345 -- Skip 'constant'. 1346 Scan; 1347 when Tok_Signal => 1348 Kind := Iir_Kind_External_Signal_Name; 1349 -- Skip 'signal'. 1350 Scan; 1351 when Tok_Variable => 1352 Kind := Iir_Kind_External_Variable_Name; 1353 -- Skip 'variable'. 1354 Scan; 1355 when others => 1356 Error_Msg_Parse 1357 ("constant, signal or variable expected after '<<'"); 1358 Kind := Iir_Kind_External_Signal_Name; 1359 end case; 1360 1361 Res := Create_Iir (Kind); 1362 Set_Location (Res, Loc); 1363 1364 Set_External_Pathname (Res, Parse_External_Pathname); 1365 1366 if Current_Token /= Tok_Colon then 1367 Error_Msg_Parse ("':' expected after external pathname"); 1368 else 1369 -- Skip ':' 1370 Scan; 1371 end if; 1372 1373 Set_Subtype_Indication (Res, Parse_Subtype_Indication); 1374 1375 if Current_Token /= Tok_Double_Greater then 1376 Error_Msg_Parse ("'>>' expected at end of external name"); 1377 else 1378 -- Skip '>>' 1379 Scan; 1380 end if; 1381 1382 return Res; 1383 end Parse_External_Name; 1384 1385 -- LRM09 8.2 Simple names 1386 -- simple_name ::= identifier 1387 function Parse_Simple_Name return Iir 1388 is 1389 Res : Iir; 1390 begin 1391 Expect (Tok_Identifier); 1392 1393 Res := Create_Iir (Iir_Kind_Simple_Name); 1394 Set_Identifier (Res, Current_Identifier); 1395 Set_Location (Res); 1396 1397 -- Skip identifier 1398 Scan; 1399 1400 return Res; 1401 end Parse_Simple_Name; 1402 1403 -- Precond: next token (identifier, string or '<<') 1404 -- Postcond: next token 1405 -- 1406 -- LRM08 8. Names 1407 -- name ::= 1408 -- simple_name 1409 -- | operator_symbol 1410 -- | character_literal -- FIXME: not handled. 1411 -- | selected_name 1412 -- | indexed_name 1413 -- | slice_name 1414 -- | attribute_name 1415 -- | external_name 1416 function Parse_Any_Name 1417 (Allow_Indexes: Boolean; Allow_Signature : Boolean) return Iir 1418 is 1419 Res: Iir; 1420 begin 1421 case Current_Token is 1422 when Tok_Identifier => 1423 Res := Parse_Simple_Name; 1424 1425 when Tok_String => 1426 -- For operator symbol, such as: "+" (A, B). 1427 Res := Create_Iir (Iir_Kind_String_Literal8); 1428 Set_String8_Id (Res, Current_String_Id); 1429 Set_String_Length (Res, Current_String_Length); 1430 Set_Literal_Length (Res, Get_Token_Length); 1431 Set_Location (Res); 1432 1433 -- Skip string 1434 Scan; 1435 when Tok_Double_Less => 1436 if Vhdl_Std < Vhdl_08 then 1437 Error_Msg_Parse ("external name not allowed before vhdl 08"); 1438 end if; 1439 Res := Parse_External_Name; 1440 when others => 1441 if Current_Token = Tok_Invalid then 1442 Error_Msg_Parse ("name expected here"); 1443 else 1444 Error_Msg_Parse 1445 ("name expected here, found %t", +Current_Token); 1446 end if; 1447 return Create_Error_Node; 1448 end case; 1449 1450 return Parse_Name_Suffix (Res, Allow_Indexes, Allow_Signature); 1451 end Parse_Any_Name; 1452 1453 function Parse_Name (Allow_Indexes: Boolean := True) return Iir is 1454 begin 1455 return Parse_Any_Name (Allow_Indexes, False); 1456 end Parse_Name; 1457 1458 function Parse_Signature_Name return Iir is 1459 begin 1460 return Parse_Any_Name (True, True); 1461 end Parse_Signature_Name; 1462 1463 -- Emit an error message if MARK doesn't have the form of a type mark. 1464 function Check_Type_Mark (Mark : Iir) return Boolean is 1465 begin 1466 case Get_Kind (Mark) is 1467 when Iir_Kind_Simple_Name 1468 | Iir_Kind_Selected_Name => 1469 return True; 1470 when Iir_Kind_Attribute_Name => 1471 -- For O'Subtype. 1472 return True; 1473 when others => 1474 Error_Msg_Parse (+Mark, "type mark must be a name of a type"); 1475 return False; 1476 end case; 1477 end Check_Type_Mark; 1478 1479 -- precond : next token 1480 -- postcond: next token 1481 -- 1482 -- [ 4.2 ] 1483 -- type_mark ::= type_name 1484 -- | subtype_name 1485 function Parse_Type_Mark (Check_Paren : Boolean := False) return Iir 1486 is 1487 Res : Iir; 1488 Old : Iir; 1489 pragma Unreferenced (Old); 1490 begin 1491 Res := Parse_Name (Allow_Indexes => False); 1492 1493 if Check_Type_Mark (Res) then 1494 if Check_Paren and then Current_Token = Tok_Left_Paren then 1495 Error_Msg_Parse ("index constraint not allowed here"); 1496 Old := Parse_Name_Suffix (Res, True); 1497 end if; 1498 else 1499 Res := Null_Iir; 1500 end if; 1501 return Res; 1502 end Parse_Type_Mark; 1503 1504 -- precond : CONSTANT, SIGNAL, VARIABLE. FILE or identifier 1505 -- postcond: next token (';' or ')') 1506 -- 1507 -- [ LRM93 4.3.2 ] [ LRM08 6.5.2 ] 1508 -- interface_declaration ::= interface_constant_declaration 1509 -- | interface_signal_declaration 1510 -- | interface_variable_declaration 1511 -- | interface_file_declaration 1512 -- 1513 -- 1514 -- [ LRM93 3.2.2 ] 1515 -- identifier_list ::= identifier { , identifier } 1516 -- 1517 -- [ LRM93 4.3.2 ] 1518 -- interface_constant_declaration ::= 1519 -- [ CONSTANT ] identifier_list : [ IN ] subtype_indication 1520 -- [ := STATIC_expression ] 1521 -- 1522 -- [ LRM93 4.3.2 ] 1523 -- interface_file_declaration ::= FILE identifier_list : subtype_indication 1524 -- 1525 -- [ LRM93 4.3.2 ] 1526 -- interface_signal_declaration ::= 1527 -- [ SIGNAL ] identifier_list : [ mode ] subtype_indication [ BUS ] 1528 -- [ := STATIC_expression ] 1529 -- 1530 -- [ LRM93 4.3.2 ] 1531 -- interface_variable_declaration ::= 1532 -- [ VARIABLE ] identifier_list : [ mode ] subtype_indication 1533 -- [ := STATIC_expression ] 1534 -- 1535 -- [ AMS-LRM17 6.5.2 ] 1536 -- interface_quantity_declaration ::= 1537 -- QUANTITY identifier_list : [ IN | OUT ] subtype_indication 1538 -- [ := /static/_expression ] 1539 -- 1540 -- The default kind of interface declaration is DEFAULT. 1541 function Parse_Interface_Object_Declaration (Ctxt : Interface_Kind_Type) 1542 return Iir 1543 is 1544 Kind : Iir_Kind; 1545 Last : Iir; 1546 First : Iir; 1547 Inter: Iir; 1548 Is_Default : Boolean; 1549 Interface_Mode: Iir_Mode; 1550 Interface_Type: Iir; 1551 Is_Guarded : Boolean; 1552 Signal_Kind: Iir_Signal_Kind; 1553 Default_Value: Iir; 1554 Has_Mode : Boolean; 1555 Has_Class : Boolean; 1556 begin 1557 -- LRM08 6.5.2 Interface object declarations 1558 -- Interface obejcts include interface constants that appear as 1559 -- generics of a design entity, a component, a block, a package or 1560 -- a subprogram, or as constant parameter of subprograms; interface 1561 -- signals that appear as ports of a design entity, component or 1562 -- block, or as signal parameters of subprograms; interface variables 1563 -- that appear as variable parameter subprograms; interface files 1564 -- that appear as file parameters of subrograms. 1565 case Current_Token is 1566 when Tok_Identifier => 1567 -- The class of the object is unknown. Select default 1568 -- according to the above rule, assuming the mode is IN. If 1569 -- the mode is not IN, Parse_Interface_Object_Declaration will 1570 -- change the class. 1571 case Ctxt is 1572 when Generic_Interface_List 1573 | Parameter_Interface_List => 1574 Kind := Iir_Kind_Interface_Constant_Declaration; 1575 when Port_Interface_List => 1576 Kind := Iir_Kind_Interface_Signal_Declaration; 1577 end case; 1578 when Tok_Constant => 1579 Kind := Iir_Kind_Interface_Constant_Declaration; 1580 when Tok_Signal => 1581 if Ctxt = Generic_Interface_List then 1582 Error_Msg_Parse 1583 ("signal interface not allowed in generic clause"); 1584 end if; 1585 Kind := Iir_Kind_Interface_Signal_Declaration; 1586 when Tok_Variable => 1587 if Ctxt not in Parameter_Interface_List then 1588 Error_Msg_Parse 1589 ("variable interface not allowed in generic or port clause"); 1590 end if; 1591 Kind := Iir_Kind_Interface_Variable_Declaration; 1592 when Tok_File => 1593 if Flags.Vhdl_Std = Vhdl_87 then 1594 Error_Msg_Parse ("file interface not allowed in vhdl 87"); 1595 end if; 1596 if Ctxt not in Parameter_Interface_List then 1597 Error_Msg_Parse 1598 ("variable interface not allowed in generic or port clause"); 1599 end if; 1600 Kind := Iir_Kind_Interface_File_Declaration; 1601 when Tok_Quantity => 1602 Kind := Iir_Kind_Interface_Quantity_Declaration; 1603 when others => 1604 -- Fall back in case of parse error. 1605 Kind := Iir_Kind_Interface_Variable_Declaration; 1606 end case; 1607 1608 First := Create_Iir (Kind); 1609 1610 if Flag_Elocations then 1611 Create_Elocations (First); 1612 Set_Start_Location (First, Get_Token_Location); 1613 end if; 1614 1615 if Current_Token = Tok_Identifier then 1616 Is_Default := True; 1617 Has_Class := False; 1618 else 1619 Is_Default := False; 1620 Has_Class := True; 1621 1622 -- Skip 'signal', 'variable', 'constant' or 'file'. 1623 Scan; 1624 end if; 1625 1626 -- Parse list of identifiers. 1627 Inter := First; 1628 Last := First; 1629 loop 1630 Scan_Identifier (Inter); 1631 1632 exit when Current_Token /= Tok_Comma; 1633 1634 -- Skip ',' 1635 Scan; 1636 1637 Inter := Create_Iir (Kind); 1638 1639 if Flag_Elocations then 1640 Create_Elocations (Inter); 1641 Set_Start_Location (Inter, Get_Start_Location (First)); 1642 end if; 1643 1644 Set_Chain (Last, Inter); 1645 Last := Inter; 1646 end loop; 1647 1648 if Flag_Elocations then 1649 Set_Colon_Location (First, Get_Token_Location); 1650 end if; 1651 1652 -- Skip ':' 1653 Expect_Scan (Tok_Colon, "':' expected after interface identifier"); 1654 1655 -- Parse mode. 1656 case Current_Token is 1657 when Tok_In 1658 | Tok_Out 1659 | Tok_Inout 1660 | Tok_Linkage 1661 | Tok_Buffer => 1662 Interface_Mode := Parse_Mode; 1663 Has_Mode := True; 1664 when others => 1665 Interface_Mode := Iir_Unknown_Mode; 1666 Has_Mode := False; 1667 end case; 1668 1669 -- LRM93 2.1.1 LRM08 4.2.2.1 1670 -- If the mode is INOUT or OUT, and no object class is explicitly 1671 -- specified, variable is assumed. 1672 if Is_Default 1673 and then Ctxt in Parameter_Interface_List 1674 and then Interface_Mode in Iir_Out_Modes 1675 then 1676 -- Convert into variable. 1677 declare 1678 O_Interface : Iir_Interface_Constant_Declaration; 1679 N_Interface : Iir_Interface_Variable_Declaration; 1680 begin 1681 O_Interface := First; 1682 while O_Interface /= Null_Iir loop 1683 N_Interface := 1684 Create_Iir (Iir_Kind_Interface_Variable_Declaration); 1685 Location_Copy (N_Interface, O_Interface); 1686 Set_Identifier (N_Interface, Get_Identifier (O_Interface)); 1687 1688 if Flag_Elocations then 1689 Create_Elocations (N_Interface); 1690 Set_Start_Location 1691 (N_Interface, Get_Start_Location (O_Interface)); 1692 Set_Colon_Location 1693 (N_Interface, Get_Colon_Location (O_Interface)); 1694 end if; 1695 1696 if O_Interface = First then 1697 First := N_Interface; 1698 else 1699 Set_Chain (Last, N_Interface); 1700 end if; 1701 Last := N_Interface; 1702 1703 Inter := Get_Chain (O_Interface); 1704 Free_Iir (O_Interface); 1705 O_Interface := Inter; 1706 end loop; 1707 Inter := First; 1708 end; 1709 end if; 1710 1711 -- Parse mode (and handle default mode). 1712 case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is 1713 when Iir_Kind_Interface_File_Declaration => 1714 if Interface_Mode /= Iir_Unknown_Mode then 1715 Error_Msg_Parse 1716 ("mode can't be specified for a file interface"); 1717 end if; 1718 Interface_Mode := Iir_Inout_Mode; 1719 when Iir_Kind_Interface_Signal_Declaration 1720 | Iir_Kind_Interface_Variable_Declaration => 1721 -- LRM93 4.3.2 1722 -- If no mode is explicitly given in an interface declaration 1723 -- other than an interface file declaration, mode IN is 1724 -- assumed. 1725 if Interface_Mode = Iir_Unknown_Mode then 1726 Interface_Mode := Iir_In_Mode; 1727 end if; 1728 when Iir_Kind_Interface_Constant_Declaration => 1729 if Interface_Mode = Iir_Unknown_Mode then 1730 Interface_Mode := Iir_In_Mode; 1731 elsif Interface_Mode /= Iir_In_Mode then 1732 Error_Msg_Parse ("mode must be 'in' for a constant"); 1733 Interface_Mode := Iir_In_Mode; 1734 end if; 1735 when Iir_Kind_Interface_Quantity_Declaration => 1736 case Interface_Mode is 1737 when Iir_Unknown_Mode => 1738 Interface_Mode := Iir_In_Mode; 1739 when Iir_In_Mode 1740 | Iir_Out_Mode => 1741 null; 1742 when Iir_Inout_Mode 1743 | Iir_Linkage_Mode 1744 | Iir_Buffer_Mode => 1745 Error_Msg_Parse 1746 ("mode must be 'in' or 'out' for a quantity"); 1747 Interface_Mode := Iir_In_Mode; 1748 end case; 1749 end case; 1750 1751 Interface_Type := Parse_Subtype_Indication; 1752 1753 -- Signal kind (but only for signal). 1754 if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then 1755 Parse_Signal_Kind (Is_Guarded, Signal_Kind); 1756 else 1757 Is_Guarded := False; 1758 Signal_Kind := Iir_Register_Kind; 1759 end if; 1760 1761 if Current_Token = Tok_Assign then 1762 if Get_Kind (Inter) = Iir_Kind_Interface_File_Declaration then 1763 Error_Msg_Parse 1764 ("default expression not allowed for an interface file"); 1765 end if; 1766 1767 -- Skip ':=' 1768 if Flag_Elocations then 1769 Set_Assign_Location (First, Get_Token_Location); 1770 end if; 1771 Scan; 1772 1773 Default_Value := Parse_Expression; 1774 else 1775 Default_Value := Null_Iir; 1776 end if; 1777 1778 -- Subtype_Indication and Default_Value are set only on the first 1779 -- interface. 1780 Set_Subtype_Indication (First, Interface_Type); 1781 if Get_Kind (First) /= Iir_Kind_Interface_File_Declaration then 1782 Set_Default_Value (First, Default_Value); 1783 end if; 1784 1785 Inter := First; 1786 while Inter /= Null_Iir loop 1787 Set_Mode (Inter, Interface_Mode); 1788 Set_Is_Ref (Inter, Inter /= First); 1789 Set_Has_Mode (Inter, Has_Mode); 1790 Set_Has_Class (Inter, Has_Class); 1791 Set_Has_Identifier_List (Inter, Inter /= Last); 1792 if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration then 1793 Set_Guarded_Signal_Flag (Inter, Is_Guarded); 1794 Set_Signal_Kind (Inter, Signal_Kind); 1795 end if; 1796 Inter := Get_Chain (Inter); 1797 end loop; 1798 1799 return First; 1800 end Parse_Interface_Object_Declaration; 1801 1802 -- [ AMS-LRM17 6.5.2 ] 1803 -- interface_terminal_declaration ::= 1804 -- TERMINAL identifier_list : subnature_indication 1805 -- 1806 -- The default kind of interface declaration is DEFAULT. 1807 function Parse_Interface_Terminal_Declaration (Ctxt : Interface_Kind_Type) 1808 return Iir 1809 is 1810 Last : Iir; 1811 First : Iir; 1812 Inter: Iir; 1813 Interface_Nature: Iir; 1814 Default_Value: Iir; 1815 begin 1816 pragma Assert (Current_Token = Tok_Terminal); 1817 1818 -- LRM08 6.5.2 Interface object declarations 1819 -- Interface obejcts include interface constants that appear as 1820 -- generics of a design entity, a component, a block, a package or 1821 -- a subprogram, or as constant parameter of subprograms; interface 1822 -- signals that appear as ports of a design entity, component or 1823 -- block, or as signal parameters of subprograms; interface variables 1824 -- that appear as variable parameter subprograms; interface files 1825 -- that appear as file parameters of subrograms. 1826 if Ctxt = Generic_Interface_List then 1827 Error_Msg_Parse ("terminal interface not allowed in generic clause"); 1828 end if; 1829 1830 First := Create_Iir (Iir_Kind_Interface_Terminal_Declaration); 1831 1832 if Flag_Elocations then 1833 Create_Elocations (First); 1834 Set_Start_Location (First, Get_Token_Location); 1835 end if; 1836 1837 -- Skip 'terminal'. 1838 Scan; 1839 1840 -- Parse list of identifiers. 1841 Inter := First; 1842 Last := First; 1843 loop 1844 Scan_Identifier (Inter); 1845 1846 exit when Current_Token /= Tok_Comma; 1847 1848 -- Skip ',' 1849 Scan; 1850 1851 Inter := Create_Iir (Iir_Kind_Interface_Terminal_Declaration); 1852 1853 if Flag_Elocations then 1854 Create_Elocations (Inter); 1855 Set_Start_Location (Inter, Get_Start_Location (First)); 1856 end if; 1857 1858 Set_Chain (Last, Inter); 1859 Last := Inter; 1860 end loop; 1861 1862 if Flag_Elocations then 1863 Set_Colon_Location (First, Get_Token_Location); 1864 end if; 1865 1866 -- Skip ':' 1867 Expect_Scan (Tok_Colon, "':' expected after interface identifier"); 1868 1869 case Current_Token is 1870 when Tok_In 1871 | Tok_Out 1872 | Tok_Inout 1873 | Tok_Linkage 1874 | Tok_Buffer => 1875 Error_Msg_Parse ("mode not allowed for terminal interface"); 1876 1877 -- Skip mode. 1878 Scan; 1879 when others => 1880 null; 1881 end case; 1882 1883 Interface_Nature := Parse_Subnature_Indication; 1884 -- Subnature_Indication is set only on the first interface. 1885 Set_Subnature_Indication (First, Interface_Nature); 1886 1887 if Current_Token = Tok_Assign then 1888 Error_Msg_Parse 1889 ("default expression not allowed for an interface terminal"); 1890 1891 -- Skip ':=' 1892 Scan; 1893 1894 Default_Value := Parse_Expression; 1895 pragma Unreferenced (Default_Value); 1896 end if; 1897 1898 Inter := First; 1899 while Inter /= Null_Iir loop 1900 Set_Is_Ref (Inter, Inter /= First); 1901 Set_Has_Mode (Inter, False); 1902 Set_Has_Class (Inter, True); 1903 Set_Has_Identifier_List (Inter, Inter /= Last); 1904 Inter := Get_Chain (Inter); 1905 end loop; 1906 1907 return First; 1908 end Parse_Interface_Terminal_Declaration; 1909 1910 -- Precond : 'package' 1911 -- Postcond: next token 1912 -- 1913 -- LRM08 6.5.5 Interface package declarations 1914 -- interface_package_declaration ::= 1915 -- PACKAGE identifier IS NEW uninstantiated_package name 1916 -- interface_package_generic_map_aspect 1917 -- 1918 -- interface_package_generic_map_aspect ::= 1919 -- generic_map_aspect 1920 -- | GENERIC MAP ( <> ) 1921 -- | GENERIC MAP ( DEFAULT ) 1922 function Parse_Interface_Package_Declaration return Iir 1923 is 1924 Inter : Iir; 1925 Map : Iir; 1926 begin 1927 Inter := Create_Iir (Iir_Kind_Interface_Package_Declaration); 1928 1929 -- Skip 'package'. 1930 Scan; 1931 1932 Scan_Identifier (Inter); 1933 1934 -- Skip 'is'. 1935 Expect_Scan (Tok_Is); 1936 1937 -- Skip 'new'. 1938 Expect_Scan (Tok_New); 1939 1940 Set_Uninstantiated_Package_Name (Inter, Parse_Name (False)); 1941 1942 -- Skip 'generic' 1943 Expect_Scan (Tok_Generic); 1944 1945 -- Skip 'map' 1946 Expect_Scan (Tok_Map); 1947 1948 -- Skip '(' 1949 Expect_Scan (Tok_Left_Paren); 1950 1951 case Current_Token is 1952 when Tok_Box => 1953 Map := Null_Iir; 1954 -- Skip '<>' 1955 Scan; 1956 when others => 1957 Map := Parse_Association_List; 1958 end case; 1959 Set_Generic_Map_Aspect_Chain (Inter, Map); 1960 1961 -- Skip ')' 1962 Expect_Scan (Tok_Right_Paren); 1963 1964 return Inter; 1965 end Parse_Interface_Package_Declaration; 1966 1967 -- Precond: identifier or string 1968 -- Postcond: next token 1969 -- 1970 -- [ 2.1 ] 1971 -- designator ::= identifier | operator_symbol 1972 procedure Parse_Subprogram_Designator (Subprg : Iir) is 1973 begin 1974 if Current_Token = Tok_Identifier then 1975 -- Skip identifier. 1976 Scan_Identifier (Subprg); 1977 elsif Current_Token = Tok_String then 1978 if Kind_In (Subprg, Iir_Kind_Procedure_Declaration, 1979 Iir_Kind_Interface_Procedure_Declaration) 1980 then 1981 -- LRM93 2.1 1982 -- A procedure designator is always an identifier. 1983 Error_Msg_Parse ("a procedure name must be an identifier"); 1984 end if; 1985 -- LRM93 2.1 1986 -- A function designator is either an identifier or an operator 1987 -- symbol. 1988 Set_Identifier (Subprg, Scan_To_Operator_Name (Get_Token_Location)); 1989 Set_Location (Subprg); 1990 1991 -- Skip string. 1992 Scan; 1993 else 1994 -- Just to display a parse error. 1995 Expect (Tok_Identifier); 1996 end if; 1997 end Parse_Subprogram_Designator; 1998 1999 -- Emit an error message is function declaration SUBPRG has no return 2000 -- type mark. 2001 procedure Check_Function_Specification (Subprg : Iir) is 2002 begin 2003 if Get_Return_Type_Mark (Subprg) = Null_Iir then 2004 Error_Msg_Parse ("'return' expected"); 2005 Set_Return_Type_Mark (Subprg, Create_Error_Node); 2006 end if; 2007 end Check_Function_Specification; 2008 2009 -- Precond: '(' or return or any 2010 -- Postcond: next token 2011 procedure Parse_Subprogram_Parameters_And_Return 2012 (Subprg : Iir; Is_Func : Boolean; Required : Boolean) 2013 is 2014 Old : Iir; 2015 pragma Unreferenced (Old); 2016 Inters : Iir; 2017 begin 2018 if Current_Token = Tok_Parameter then 2019 Set_Has_Parameter (Subprg, True); 2020 2021 -- Eat 'parameter' 2022 Scan; 2023 2024 if Current_Token /= Tok_Left_Paren then 2025 Error_Msg_Parse 2026 ("'parameter' must be followed by a list of parameters"); 2027 end if; 2028 end if; 2029 2030 if Current_Token = Tok_Left_Paren then 2031 -- Parse the interface declaration. 2032 if Is_Func then 2033 Inters := Parse_Interface_List 2034 (Function_Parameter_Interface_List, Subprg); 2035 else 2036 Inters := Parse_Interface_List 2037 (Procedure_Parameter_Interface_List, Subprg); 2038 end if; 2039 Set_Interface_Declaration_Chain (Subprg, Inters); 2040 end if; 2041 2042 if Current_Token = Tok_Return then 2043 if not Is_Func then 2044 Report_Start_Group; 2045 Error_Msg_Parse ("'return' not allowed for a procedure"); 2046 Error_Msg_Parse ("(remove return part or declare a function)"); 2047 Report_End_Group; 2048 2049 -- Skip 'return' 2050 Scan; 2051 2052 Old := Parse_Type_Mark; 2053 else 2054 -- Skip 'return' 2055 Scan; 2056 2057 Set_Return_Type_Mark 2058 (Subprg, Parse_Type_Mark (Check_Paren => True)); 2059 end if; 2060 else 2061 if Is_Func and Required then 2062 Check_Function_Specification (Subprg); 2063 end if; 2064 end if; 2065 end Parse_Subprogram_Parameters_And_Return; 2066 2067 -- Precond: PROCEDURE, FUNCTION, PURE, IMPURE 2068 -- Postcond: next token 2069 -- 2070 -- LRM08 6.5.4 Interface subrpogram declarations 2071 -- interface_subprogram_declaration ::= 2072 -- interface_subprogram_specification 2073 -- [ IS interface_subprogram_default ] 2074 -- 2075 -- interface_subrpogram_specification ::= 2076 -- interface_procedure_specification | interface_function_specification 2077 -- 2078 -- interface_procedure_specification ::= 2079 -- PROCEDURE designator 2080 -- [ [ PARAMETER ] ( formal_parameter_list ) ] 2081 -- 2082 -- interface_function_specification ::= 2083 -- [ PURE | IMPURE ] FUNCTION designator 2084 -- [ [ PARAMETER ] ( formal_parameter_list ) ] RETURN type_mark 2085 -- 2086 -- interface_subprogram_default ::= 2087 -- /subprogram/_name | <> 2088 function Parse_Interface_Subprogram_Declaration return Iir 2089 is 2090 Kind : Iir_Kind; 2091 Subprg: Iir; 2092 Old : Iir; 2093 pragma Unreferenced (Old); 2094 begin 2095 -- Create the node. 2096 case Current_Token is 2097 when Tok_Procedure => 2098 Kind := Iir_Kind_Interface_Procedure_Declaration; 2099 when Tok_Function 2100 | Tok_Pure 2101 | Tok_Impure => 2102 Kind := Iir_Kind_Interface_Function_Declaration; 2103 when others => 2104 raise Internal_Error; 2105 end case; 2106 Subprg := Create_Iir (Kind); 2107 Set_Location (Subprg); 2108 2109 case Current_Token is 2110 when Tok_Procedure => 2111 -- Skip 'procedure'. 2112 Scan; 2113 when Tok_Function => 2114 -- LRM93 2.1 2115 -- A function is impure if its specification contains the 2116 -- reserved word IMPURE; otherwise it is said to be pure. 2117 Set_Pure_Flag (Subprg, True); 2118 2119 -- Skip 'function'. 2120 Scan; 2121 when Tok_Pure 2122 | Tok_Impure => 2123 Set_Pure_Flag (Subprg, Current_Token = Tok_Pure); 2124 Set_Has_Pure (Subprg, True); 2125 2126 -- Eat 'pure' or 'impure'. 2127 Scan; 2128 2129 Expect_Scan 2130 (Tok_Function, "'function' must follow 'pure' or 'impure'"); 2131 when others => 2132 raise Internal_Error; 2133 end case; 2134 2135 -- Designator. 2136 Parse_Subprogram_Designator (Subprg); 2137 2138 Parse_Subprogram_Parameters_And_Return 2139 (Subprg, Kind = Iir_Kind_Interface_Function_Declaration, True); 2140 2141 -- TODO: interface_subprogram_default 2142 2143 return Subprg; 2144 end Parse_Interface_Subprogram_Declaration; 2145 2146 -- Precond : '(' 2147 -- Postcond: next token 2148 -- 2149 -- LRM08 6.5.6 Interface lists 2150 -- interface_list ::= interface_element { ';' interface_element } 2151 -- 2152 -- interface_element ::= interface_declaration 2153 function Parse_Interface_List (Ctxt : Interface_Kind_Type; Parent : Iir) 2154 return Iir 2155 is 2156 Res, Last : Iir; 2157 Inters : Iir; 2158 Next : Iir; 2159 Prev_Loc : Location_Type; 2160 begin 2161 Prev_Loc := Get_Token_Location; 2162 2163 -- Skip '('. 2164 Expect_Scan (Tok_Left_Paren); 2165 2166 Res := Null_Iir; 2167 Last := Null_Iir; 2168 loop 2169 case Current_Token is 2170 when Tok_Identifier 2171 | Tok_Signal 2172 | Tok_Variable 2173 | Tok_Constant 2174 | Tok_File 2175 | Tok_Quantity => 2176 -- An interface object. 2177 Inters := Parse_Interface_Object_Declaration (Ctxt); 2178 when Tok_Terminal => 2179 Inters := Parse_Interface_Terminal_Declaration (Ctxt); 2180 when Tok_Package => 2181 if Ctxt /= Generic_Interface_List then 2182 Error_Msg_Parse 2183 ("package interface only allowed in generic interface"); 2184 elsif Flags.Vhdl_Std < Vhdl_08 then 2185 Error_Msg_Parse 2186 ("package interface not allowed before vhdl 08"); 2187 end if; 2188 Inters := Parse_Interface_Package_Declaration; 2189 when Tok_Type => 2190 if Ctxt /= Generic_Interface_List then 2191 Error_Msg_Parse 2192 ("type interface only allowed in generic interface"); 2193 elsif Flags.Vhdl_Std < Vhdl_08 then 2194 Error_Msg_Parse 2195 ("type interface not allowed before vhdl 08"); 2196 end if; 2197 Inters := Create_Iir (Iir_Kind_Interface_Type_Declaration); 2198 2199 -- Skip 'type'. 2200 Scan; 2201 2202 Scan_Identifier (Inters); 2203 when Tok_Procedure 2204 | Tok_Pure 2205 | Tok_Impure 2206 | Tok_Function => 2207 if Ctxt /= Generic_Interface_List then 2208 Error_Msg_Parse 2209 ("subprogram interface only allowed in generic interface"); 2210 elsif Flags.Vhdl_Std < Vhdl_08 then 2211 Error_Msg_Parse 2212 ("subprogram interface not allowed before vhdl 08"); 2213 end if; 2214 Inters := Parse_Interface_Subprogram_Declaration; 2215 when Tok_Right_Paren => 2216 if Res = Null_Iir then 2217 Error_Msg_Parse 2218 (Prev_Loc, "empty interface list not allowed"); 2219 else 2220 Error_Msg_Parse 2221 (Prev_Loc, "extra ';' at end of interface list"); 2222 end if; 2223 2224 -- Skip ')'. 2225 Scan; 2226 2227 exit; 2228 when others => 2229 Error_Msg_Parse ("interface declaration expected"); 2230 -- Use a variable interface as a fall-back. 2231 Inters := Parse_Interface_Object_Declaration (Ctxt); 2232 end case; 2233 2234 -- Chain 2235 if Last = Null_Iir then 2236 Res := Inters; 2237 else 2238 Set_Chain (Last, Inters); 2239 end if; 2240 2241 -- Set parent and set Last to the last interface. 2242 Last := Inters; 2243 loop 2244 Set_Parent (Last, Parent); 2245 Next := Get_Chain (Last); 2246 exit when Next = Null_Iir; 2247 Last := Next; 2248 end loop; 2249 2250 Prev_Loc := Get_Token_Location; 2251 2252 case Current_Token is 2253 when Tok_Comma => 2254 Error_Msg_Parse 2255 ("interfaces must be separated by ';' (found ',')"); 2256 2257 -- Skip ','. 2258 Scan; 2259 when Tok_Semi_Colon => 2260 -- Skip ';'. 2261 Scan; 2262 when Tok_Right_Paren => 2263 -- Skip ')'. 2264 Scan; 2265 2266 exit; 2267 when others => 2268 -- Try to resync; skip tokens until ';', ')'. Handled nested 2269 -- parenthesis. 2270 Error_Msg_Parse ("';' or ')' expected after interface"); 2271 2272 if Resync_To_End_Of_Interface then 2273 exit; 2274 end if; 2275 end case; 2276 end loop; 2277 2278 return Res; 2279 end Parse_Interface_List; 2280 2281 -- precond : PORT 2282 -- postcond: next token 2283 -- 2284 -- [ LRM93 1.1.1 ] 2285 -- port_clause ::= PORT ( port_list ) ; 2286 -- 2287 -- [ LRM93 1.1.1.2 ] 2288 -- port_list ::= PORT_interface_list 2289 procedure Parse_Port_Clause (Parent : Iir) 2290 is 2291 Res: Iir; 2292 El : Iir; 2293 begin 2294 -- Skip 'port' 2295 pragma Assert (Current_Token = Tok_Port); 2296 Scan; 2297 2298 Res := Parse_Interface_List (Port_Interface_List, Parent); 2299 2300 -- Check the interface are signal interfaces. 2301 El := Res; 2302 while El /= Null_Iir loop 2303 case Get_Kind (El) is 2304 when Iir_Kind_Interface_Signal_Declaration 2305 | Iir_Kind_Interface_Terminal_Declaration 2306 | Iir_Kind_Interface_Quantity_Declaration => 2307 null; 2308 when others => 2309 if AMS_Vhdl then 2310 Error_Msg_Parse 2311 (+El, "port must be a signal, a terminal or a quantity"); 2312 else 2313 Error_Msg_Parse (+El, "port must be a signal"); 2314 end if; 2315 end case; 2316 El := Get_Chain (El); 2317 end loop; 2318 2319 Scan_Semi_Colon ("port clause"); 2320 Set_Port_Chain (Parent, Res); 2321 end Parse_Port_Clause; 2322 2323 -- precond : GENERIC 2324 -- postcond: next token 2325 -- 2326 -- [ LRM93 1.1.1, LRM08 6.5.6.2 ] 2327 -- generic_clause ::= GENERIC ( generic_list ) ; 2328 -- 2329 -- [ LRM93 1.1.1.1, LRM08 6.5.6.2] 2330 -- generic_list ::= GENERIC_interface_list 2331 procedure Parse_Generic_Clause (Parent : Iir) 2332 is 2333 Res: Iir; 2334 begin 2335 -- Skip 'generic' 2336 pragma Assert (Current_Token = Tok_Generic); 2337 Scan; 2338 2339 Res := Parse_Interface_List (Generic_Interface_List, Parent); 2340 Set_Generic_Chain (Parent, Res); 2341 2342 Scan_Semi_Colon ("generic clause"); 2343 end Parse_Generic_Clause; 2344 2345 -- precond : a token. 2346 -- postcond: next token 2347 -- 2348 -- [ LRM93 1.1.1 ] 2349 -- entity_header ::= 2350 -- [ FORMAL_generic_clause ] 2351 -- [ FORMAL_port_clause ] 2352 -- 2353 -- [ LRM93 4.5 ] 2354 -- [ LOCAL_generic_clause ] 2355 -- [ LOCAL_port_clause ] 2356 procedure Parse_Generic_Port_Clauses (Parent : Iir) 2357 is 2358 Has_Port, Has_Generic : Boolean; 2359 begin 2360 Has_Port := False; 2361 Has_Generic := False; 2362 loop 2363 if Current_Token = Tok_Generic then 2364 if Has_Generic then 2365 Error_Msg_Parse ("at most one generic clause is allowed"); 2366 end if; 2367 if Has_Port then 2368 Error_Msg_Parse ("generic clause must precede port clause"); 2369 end if; 2370 2371 if Flag_Elocations then 2372 Set_Generic_Location (Parent, Get_Token_Location); 2373 end if; 2374 2375 Has_Generic := True; 2376 Parse_Generic_Clause (Parent); 2377 elsif Current_Token = Tok_Port then 2378 if Has_Port then 2379 Error_Msg_Parse ("at most one port clause is allowed"); 2380 end if; 2381 2382 if Flag_Elocations then 2383 Set_Port_Location (Parent, Get_Token_Location); 2384 end if; 2385 2386 Has_Port := True; 2387 Parse_Port_Clause (Parent); 2388 else 2389 exit; 2390 end if; 2391 end loop; 2392 end Parse_Generic_Port_Clauses; 2393 2394 -- precond : a token 2395 -- postcond: next token 2396 -- 2397 -- [ LRM93 3.1.1 ] 2398 -- enumeration_type_definition ::= 2399 -- ( enumeration_literal { , enumeration_literal } ) 2400 -- 2401 -- [ LRM93 3.1.1 ] 2402 -- enumeration_literal ::= identifier | character_literal 2403 function Parse_Enumeration_Type_Definition (Parent : Iir) 2404 return Iir_Enumeration_Type_Definition 2405 is 2406 Pos: Iir_Int32; 2407 Enum_Lit: Iir_Enumeration_Literal; 2408 Enum_Type: Iir_Enumeration_Type_Definition; 2409 Enum_List : Iir_List; 2410 begin 2411 -- This is an enumeration. 2412 Enum_Type := Create_Iir (Iir_Kind_Enumeration_Type_Definition); 2413 Set_Location (Enum_Type); 2414 Enum_List := Create_Iir_List; 2415 2416 -- LRM93 3.1.1 2417 -- The position number of the first listed enumeration literal is zero. 2418 Pos := 0; 2419 2420 -- Eat '('. 2421 Scan; 2422 2423 if Current_Token = Tok_Right_Paren then 2424 Error_Msg_Parse ("at least one literal must be declared"); 2425 else 2426 loop 2427 if Current_Token = Tok_Identifier 2428 or Current_Token = Tok_Character 2429 then 2430 Enum_Lit := Create_Iir (Iir_Kind_Enumeration_Literal); 2431 Set_Identifier (Enum_Lit, Current_Identifier); 2432 Set_Parent (Enum_Lit, Parent); 2433 Set_Location (Enum_Lit); 2434 Set_Enum_Pos (Enum_Lit, Pos); 2435 2436 -- LRM93 3.1.1 2437 -- the position number for each additional enumeration literal 2438 -- is one more than that if its predecessor in the list. 2439 Pos := Pos + 1; 2440 2441 Append_Element (Enum_List, Enum_Lit); 2442 2443 -- Skip identifier or character. 2444 Scan; 2445 else 2446 Error_Msg_Parse ("identifier or character expected"); 2447 end if; 2448 2449 exit when Current_Token /= Tok_Comma; 2450 2451 -- Skip ','. 2452 Scan; 2453 2454 if Current_Token = Tok_Right_Paren then 2455 Error_Msg_Parse ("extra ',' ignored"); 2456 exit; 2457 end if; 2458 end loop; 2459 end if; 2460 2461 -- Skip ')'. 2462 Expect_Scan (Tok_Right_Paren, "')' expected at end of enumeration type"); 2463 2464 Set_Enumeration_Literal_List (Enum_Type, List_To_Flist (Enum_List)); 2465 2466 return Enum_Type; 2467 end Parse_Enumeration_Type_Definition; 2468 2469 -- Parse: 2470 -- ARRAY ( index_subtype_definition { , index_subtype_definition } ) OF 2471 -- | ARRAY index_constraint OF 2472 -- 2473 -- index_subtype_definition ::= type_mark RANGE <> 2474 -- 2475 -- index_constraint ::= ( discrete_range { , discrete_range } ) 2476 -- 2477 -- discrete_range ::= discrete_subtype_indication | range 2478 procedure Parse_Array_Indexes 2479 (Indexes : out Iir_Flist; Constrained : out Boolean) 2480 is 2481 First : Boolean; 2482 Index_List : Iir_List; 2483 Index_Constrained : Boolean; 2484 Array_Constrained : Boolean; 2485 Type_Mark : Iir; 2486 Def : Iir; 2487 begin 2488 -- Skip 'array'. 2489 Scan; 2490 2491 -- Skip '('. 2492 Expect_Scan (Tok_Left_Paren); 2493 2494 First := True; 2495 Index_List := Create_Iir_List; 2496 2497 loop 2498 -- The accepted syntax can be one of: 2499 -- * index_subtype_definition, which is: 2500 -- * type_mark RANGE <> 2501 -- * discrete_range, which is either: 2502 -- * /discrete/_subtype_indication 2503 -- * [ resolution_indication ] type_mark [ range_constraint ] 2504 -- * range_constraint ::= RANGE range 2505 -- * range 2506 -- * /range/_attribute_name 2507 -- * simple_expression direction simple_expression 2508 2509 -- Parse a simple expression (for the range), which can also parse a 2510 -- name. 2511 Type_Mark := Parse_Expression (Prio_Simple); 2512 2513 case Current_Token is 2514 when Tok_Range => 2515 -- Skip 'range' 2516 Scan; 2517 2518 if Current_Token = Tok_Box then 2519 -- Parsed 'RANGE <>': this is an index_subtype_definition. 2520 Index_Constrained := False; 2521 Scan; 2522 Def := Type_Mark; 2523 else 2524 -- This is a /discrete/_subtype_indication 2525 Index_Constrained := True; 2526 Def := 2527 Parse_Range_Constraint_Of_Subtype_Indication (Type_Mark); 2528 end if; 2529 when Tok_To 2530 | Tok_Downto => 2531 -- A range 2532 Index_Constrained := True; 2533 Def := Parse_Range_Expression (Type_Mark); 2534 when others => 2535 -- For a /range/_attribute_name 2536 Index_Constrained := True; 2537 Def := Type_Mark; 2538 end case; 2539 2540 if First then 2541 Array_Constrained := Index_Constrained; 2542 First := False; 2543 else 2544 if Array_Constrained /= Index_Constrained then 2545 Error_Msg_Parse 2546 ("cannot mix constrained and unconstrained index"); 2547 Def := Create_Error_Node (Def); 2548 end if; 2549 end if; 2550 2551 Append_Element (Index_List, Def); 2552 2553 exit when Current_Token /= Tok_Comma; 2554 2555 -- Skip ','. 2556 Scan; 2557 end loop; 2558 2559 -- Skip ')' and 'of' 2560 Expect_Scan (Tok_Right_Paren); 2561 Expect_Scan (Tok_Of); 2562 2563 Indexes := List_To_Flist (Index_List); 2564 Constrained := Array_Constrained; 2565 end Parse_Array_Indexes; 2566 2567 -- precond : ARRAY 2568 -- postcond: ?? 2569 -- 2570 -- [ LRM93 3.2.1 ] 2571 -- array_type_definition ::= unconstrained_array_definition 2572 -- | constrained_array_definition 2573 -- 2574 -- unconstrained_array_definition ::= 2575 -- ARRAY ( index_subtype_definition { , index_subtype_definition } ) 2576 -- OF element_subtype_indication 2577 -- 2578 -- constrained_array_definition ::= 2579 -- ARRAY index_constraint OF element_subtype_indication 2580 -- 2581 -- [ LRM08 5.3.2.1 ] 2582 -- array_type_definition ::= unbounded_array_definition 2583 -- | constrained_array_definition 2584 -- 2585 -- unbounded_array_definition ::= 2586 -- ARRAY ( index_subtype_definition { , index_subtype_definition } ) 2587 -- OF element_subtype_indication 2588 function Parse_Array_Type_Definition return Iir 2589 is 2590 Array_Constrained : Boolean; 2591 Res_Type: Iir; 2592 Index_Flist : Iir_Flist; 2593 2594 Loc : Location_Type; 2595 Element_Subtype : Iir; 2596 begin 2597 Loc := Get_Token_Location; 2598 2599 Parse_Array_Indexes (Index_Flist, Array_Constrained); 2600 2601 Element_Subtype := Parse_Subtype_Indication; 2602 2603 if Array_Constrained then 2604 -- Sem_Type will create the array type. 2605 Res_Type := Create_Iir (Iir_Kind_Array_Subtype_Definition); 2606 Set_Array_Element_Constraint (Res_Type, Element_Subtype); 2607 Set_Index_Constraint_List (Res_Type, Index_Flist); 2608 Set_Index_Constraint_Flag (Res_Type, True); 2609 else 2610 Res_Type := Create_Iir (Iir_Kind_Array_Type_Definition); 2611 Set_Element_Subtype_Indication (Res_Type, Element_Subtype); 2612 Set_Index_Subtype_Definition_List (Res_Type, Index_Flist); 2613 end if; 2614 Set_Location (Res_Type, Loc); 2615 2616 return Res_Type; 2617 end Parse_Array_Type_Definition; 2618 2619 -- precond : UNITS 2620 -- postcond: next token 2621 -- 2622 -- [ LRM93 3.1.3 ] 2623 -- physical_type_definition ::= 2624 -- range_constraint 2625 -- UNITS 2626 -- base_unit_declaration 2627 -- { secondary_unit_declaration } 2628 -- END UNITS [ PHYSICAL_TYPE_simple_name ] 2629 -- 2630 -- [ LRM93 3.1.3 ] 2631 -- base_unit_declaration ::= identifier ; 2632 -- 2633 -- [ LRM93 3.1.3 ] 2634 -- secondary_unit_declaration ::= identifier = physical_literal ; 2635 function Parse_Physical_Type_Definition (Parent : Iir) 2636 return Iir_Physical_Type_Definition 2637 is 2638 Res: Iir_Physical_Type_Definition; 2639 Unit: Iir_Unit_Declaration; 2640 Last : Iir_Unit_Declaration; 2641 Multiplier : Iir; 2642 begin 2643 Res := Create_Iir (Iir_Kind_Physical_Type_Definition); 2644 Set_Location (Res); 2645 2646 -- Skip 'units' 2647 Expect_Scan (Tok_Units); 2648 2649 -- Parse primary unit. 2650 Unit := Create_Iir (Iir_Kind_Unit_Declaration); 2651 Set_Parent (Unit, Parent); 2652 2653 Scan_Identifier (Unit); 2654 2655 Scan_Semi_Colon ("primary physical unit"); 2656 2657 Set_Unit_Chain (Res, Unit); 2658 Last := Unit; 2659 2660 -- Parse secondary units. 2661 while Current_Token = Tok_Identifier loop 2662 Unit := Create_Iir (Iir_Kind_Unit_Declaration); 2663 Set_Parent (Unit, Parent); 2664 2665 Scan_Identifier (Unit); 2666 2667 -- Skip '='. 2668 Expect_Scan (Tok_Equal); 2669 2670 case Current_Token is 2671 when Tok_Integer 2672 | Tok_Identifier 2673 | Tok_Real => 2674 Multiplier := Parse_Primary; 2675 when others => 2676 Error_Msg_Parse 2677 ("physical literal expected to define a secondary unit"); 2678 Skip_Until_Semi_Colon; 2679 Multiplier := Null_Iir; 2680 end case; 2681 2682 if Multiplier /= Null_Iir then 2683 Set_Physical_Literal (Unit, Multiplier); 2684 2685 case Get_Kind (Multiplier) is 2686 when Iir_Kind_Simple_Name 2687 | Iir_Kind_Selected_Name 2688 | Iir_Kind_Physical_Int_Literal => 2689 null; 2690 when Iir_Kind_Physical_Fp_Literal => 2691 Error_Msg_Parse 2692 ("secondary units may only be defined by an integer"); 2693 when others => 2694 Error_Msg_Parse ("a physical literal is expected here"); 2695 Skip_Until_Semi_Colon; 2696 end case; 2697 end if; 2698 Set_Chain (Last, Unit); 2699 Last := Unit; 2700 2701 Scan_Semi_Colon ("secondary physical unit"); 2702 end loop; 2703 2704 -- Skip 'end'. 2705 Expect_Scan (Tok_End); 2706 2707 -- Skip 'units'. 2708 Expect_Scan (Tok_Units); 2709 Set_End_Has_Reserved_Id (Res, True); 2710 2711 return Res; 2712 end Parse_Physical_Type_Definition; 2713 2714 -- precond : RECORD 2715 -- postcond: next token 2716 -- 2717 -- [ LRM93 3.2.2 ] 2718 -- record_type_definition ::= 2719 -- RECORD 2720 -- element_declaration 2721 -- { element_declaration } 2722 -- END RECORD [ RECORD_TYPE_simple_name ] 2723 -- 2724 -- element_declaration ::= 2725 -- identifier_list : element_subtype_definition 2726 -- 2727 -- element_subtype_definition ::= subtype_indication 2728 function Parse_Record_Type_Definition return Iir_Record_Type_Definition 2729 is 2730 Res: Iir_Record_Type_Definition; 2731 El_List : Iir_List; 2732 El: Iir_Element_Declaration; 2733 First : Iir; 2734 Pos: Iir_Index32; 2735 Subtype_Indication: Iir; 2736 begin 2737 Res := Create_Iir (Iir_Kind_Record_Type_Definition); 2738 Set_Location (Res); 2739 El_List := Create_Iir_List; 2740 2741 -- Skip 'record' 2742 Scan; 2743 2744 Pos := 0; 2745 First := Null_Iir; 2746 loop 2747 pragma Assert (First = Null_Iir); 2748 -- Parse identifier_list 2749 loop 2750 El := Create_Iir (Iir_Kind_Element_Declaration); 2751 Scan_Identifier (El); 2752 2753 Set_Parent (El, Res); 2754 if First = Null_Iir then 2755 First := El; 2756 end if; 2757 2758 Append_Element (El_List, El); 2759 Set_Element_Position (El, Pos); 2760 Pos := Pos + 1; 2761 2762 exit when Current_Token /= Tok_Comma; 2763 2764 Set_Has_Identifier_List (El, True); 2765 2766 -- Skip ',' 2767 Scan; 2768 end loop; 2769 2770 -- Scan ':'. 2771 Expect_Scan (Tok_Colon); 2772 2773 -- Parse element subtype indication. 2774 Subtype_Indication := Parse_Subtype_Indication; 2775 Set_Subtype_Indication (First, Subtype_Indication); 2776 2777 First := Null_Iir; 2778 Scan_Semi_Colon_Declaration ("element declaration"); 2779 exit when Current_Token /= Tok_Identifier; 2780 end loop; 2781 2782 Set_Elements_Declaration_List (Res, List_To_Flist (El_List)); 2783 2784 if Flag_Elocations then 2785 Create_Elocations (Res); 2786 Set_End_Location (Res, Get_Token_Location); 2787 end if; 2788 2789 -- Skip 'end' 2790 Expect_Scan (Tok_End); 2791 Expect_Scan (Tok_Record); 2792 Set_End_Has_Reserved_Id (Res, True); 2793 2794 return Res; 2795 end Parse_Record_Type_Definition; 2796 2797 -- precond : ACCESS 2798 -- postcond: ? 2799 -- 2800 -- [ LRM93 3.3] 2801 -- access_type_definition ::= ACCESS subtype_indication. 2802 function Parse_Access_Type_Definition return Iir_Access_Type_Definition 2803 is 2804 Res : Iir_Access_Type_Definition; 2805 begin 2806 Res := Create_Iir (Iir_Kind_Access_Type_Definition); 2807 Set_Location (Res); 2808 2809 -- Skip 'access' 2810 Expect (Tok_Access); 2811 Scan; 2812 2813 Set_Designated_Subtype_Indication (Res, Parse_Subtype_Indication); 2814 2815 return Res; 2816 end Parse_Access_Type_Definition; 2817 2818 -- precond : FILE 2819 -- postcond: next token 2820 -- 2821 -- [ LRM93 3.4 ] 2822 -- file_type_definition ::= FILE OF type_mark 2823 function Parse_File_Type_Definition return Iir_File_Type_Definition 2824 is 2825 Res : Iir_File_Type_Definition; 2826 Type_Mark: Iir; 2827 begin 2828 Res := Create_Iir (Iir_Kind_File_Type_Definition); 2829 Set_Location (Res); 2830 -- Accept token 'file'. 2831 Scan; 2832 Expect_Scan (Tok_Of); 2833 2834 Type_Mark := Parse_Type_Mark (Check_Paren => True); 2835 if Type_Mark = Null_Iir 2836 or else Get_Kind (Type_Mark) not in Iir_Kinds_Denoting_Name 2837 then 2838 Error_Msg_Parse ("type mark expected"); 2839 else 2840 Set_File_Type_Mark (Res, Type_Mark); 2841 end if; 2842 return Res; 2843 end Parse_File_Type_Definition; 2844 2845 -- precond : PROTECTED 2846 -- postcond: ';' 2847 -- 2848 -- [ 3.5 ] 2849 -- protected_type_definition ::= protected_type_declaration 2850 -- | protected_type_body 2851 -- 2852 -- [ 3.5.1 ] 2853 -- protected_type_declaration ::= PROTECTED 2854 -- protected_type_declarative_part 2855 -- END PROTECTED [ simple_name ] 2856 -- 2857 -- protected_type_declarative_part ::= 2858 -- { protected_type_declarative_item } 2859 -- 2860 -- protected_type_declarative_item ::= 2861 -- subprogram_declaration 2862 -- | attribute_specification 2863 -- | use_clause 2864 -- 2865 -- [ 3.5.2 ] 2866 -- protected_type_body ::= PROTECTED BODY 2867 -- protected_type_body_declarative_part 2868 -- END PROTECTED BODY [ simple_name ] 2869 -- 2870 -- protected_type_body_declarative_part ::= 2871 -- { protected_type_body_declarative_item } 2872 function Parse_Protected_Type_Definition 2873 (Ident : Name_Id; Loc : Location_Type) return Iir 2874 is 2875 Res : Iir; 2876 Decl : Iir; 2877 begin 2878 -- Skip 'protected'. 2879 Scan; 2880 2881 if Current_Token = Tok_Body then 2882 Res := Create_Iir (Iir_Kind_Protected_Type_Body); 2883 2884 -- Skip 'body'. 2885 Scan; 2886 2887 Decl := Res; 2888 else 2889 Decl := Create_Iir (Iir_Kind_Type_Declaration); 2890 Res := Create_Iir (Iir_Kind_Protected_Type_Declaration); 2891 Set_Location (Res, Loc); 2892 Set_Type_Definition (Decl, Res); 2893 Set_Type_Declarator (Res, Decl); 2894 end if; 2895 Set_Identifier (Decl, Ident); 2896 Set_Location (Decl, Loc); 2897 2898 Parse_Declarative_Part (Res, Res); 2899 2900 -- Eat 'end'. 2901 Expect_Scan (Tok_End); 2902 2903 if Flags.Vhdl_Std >= Vhdl_00 then 2904 Expect_Scan (Tok_Protected); 2905 else 2906 -- Avoid weird message: 'protected' expected instead of 'protected'. 2907 Expect_Scan (Tok_Identifier); 2908 end if; 2909 Set_End_Has_Reserved_Id (Res, True); 2910 if Get_Kind (Res) = Iir_Kind_Protected_Type_Body then 2911 Expect_Scan (Tok_Body); 2912 end if; 2913 Check_End_Name (Ident, Res); 2914 return Decl; 2915 end Parse_Protected_Type_Definition; 2916 2917 -- precond : TYPE 2918 -- postcond: a token 2919 -- 2920 -- [ LRM93 4.1 ] 2921 -- type_definition ::= scalar_type_definition 2922 -- | composite_type_definition 2923 -- | access_type_definition 2924 -- | file_type_definition 2925 -- | protected_type_definition 2926 -- 2927 -- [ LRM93 3.1 ] 2928 -- scalar_type_definition ::= enumeration_type_definition 2929 -- | integer_type_definition 2930 -- | floating_type_definition 2931 -- | physical_type_definition 2932 -- 2933 -- [ LRM93 3.2 ] 2934 -- composite_type_definition ::= array_type_definition 2935 -- | record_type_definition 2936 -- 2937 -- [ LRM93 3.1.2 ] 2938 -- integer_type_definition ::= range_constraint 2939 -- 2940 -- [ LRM93 3.1.4 ] 2941 -- floating_type_definition ::= range_constraint 2942 function Parse_Type_Declaration (Parent : Iir) return Iir 2943 is 2944 Def : Iir; 2945 Loc : Location_Type; 2946 Ident : Name_Id; 2947 Decl : Iir; 2948 Start_Loc : Location_Type; 2949 begin 2950 -- The current token must be type. 2951 pragma Assert (Current_Token = Tok_Type); 2952 Start_Loc := Get_Token_Location; 2953 2954 -- Skip 'type'. 2955 Scan; 2956 2957 -- Get the identifier 2958 Loc := Get_Token_Location; 2959 if Current_Token = Tok_Identifier then 2960 Ident := Current_Identifier; 2961 2962 -- Skip identifier. 2963 Scan; 2964 else 2965 Expect (Tok_Identifier, "identifier is expected after 'type'"); 2966 Ident := Null_Identifier; 2967 end if; 2968 2969 2970 if Current_Token = Tok_Semi_Colon then 2971 -- If there is a ';', this is an incomplete type declaration. 2972 Scan; 2973 2974 Decl := Create_Iir (Iir_Kind_Type_Declaration); 2975 Set_Identifier (Decl, Ident); 2976 Set_Location (Decl, Loc); 2977 2978 if Flag_Elocations then 2979 Create_Elocations (Decl); 2980 Set_Start_Location (Decl, Start_Loc); 2981 end if; 2982 2983 return Decl; 2984 end if; 2985 2986 Expect_Scan (Tok_Is, "'is' expected here"); 2987 2988 case Current_Token is 2989 when Tok_Left_Paren => 2990 -- This is an enumeration. 2991 Def := Parse_Enumeration_Type_Definition (Parent); 2992 Decl := Null_Iir; 2993 2994 when Tok_Range => 2995 -- This is a range definition. 2996 Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration); 2997 Set_Identifier (Decl, Ident); 2998 Set_Location (Decl, Loc); 2999 3000 -- Skip 'range' 3001 Scan; 3002 3003 Def := Parse_Range_Constraint; 3004 Set_Type_Definition (Decl, Def); 3005 3006 if Current_Token = Tok_Units then 3007 -- A physical type definition. 3008 declare 3009 Phys_Def : Iir; 3010 begin 3011 Phys_Def := Parse_Physical_Type_Definition (Parent); 3012 if Current_Token = Tok_Identifier then 3013 if Flags.Vhdl_Std = Vhdl_87 then 3014 Error_Msg_Parse 3015 ("simple_name not allowed here in vhdl87"); 3016 end if; 3017 Check_End_Name (Get_Identifier (Decl), Phys_Def); 3018 end if; 3019 Set_Range_Constraint (Phys_Def, Def); 3020 Set_Type_Definition (Decl, Phys_Def); 3021 Set_Type_Declarator (Phys_Def, Decl); 3022 end; 3023 end if; 3024 3025 when Tok_Array => 3026 Def := Parse_Array_Type_Definition; 3027 Decl := Null_Iir; 3028 3029 when Tok_Record => 3030 Decl := Create_Iir (Iir_Kind_Type_Declaration); 3031 Set_Identifier (Decl, Ident); 3032 Set_Location (Decl, Loc); 3033 Def := Parse_Record_Type_Definition; 3034 Set_Type_Definition (Decl, Def); 3035 Set_Type_Declarator (Def, Decl); 3036 if Current_Token = Tok_Identifier then 3037 if Flags.Vhdl_Std = Vhdl_87 then 3038 Error_Msg_Parse ("simple_name not allowed here in vhdl87"); 3039 end if; 3040 Check_End_Name (Get_Identifier (Decl), Def); 3041 end if; 3042 3043 when Tok_Access => 3044 Def := Parse_Access_Type_Definition; 3045 Decl := Null_Iir; 3046 3047 when Tok_File => 3048 Def := Parse_File_Type_Definition; 3049 Decl := Null_Iir; 3050 3051 when Tok_Identifier => 3052 if Current_Identifier = Name_Protected then 3053 Error_Msg_Parse ("protected type not allowed in vhdl87/93"); 3054 Decl := Parse_Protected_Type_Definition (Ident, Loc); 3055 else 3056 Report_Start_Group; 3057 Error_Msg_Parse ("type %i cannot be defined from another type", 3058 +Ident); 3059 Error_Msg_Parse ("(you should declare a subtype)"); 3060 Report_End_Group; 3061 Decl := Create_Iir (Iir_Kind_Type_Declaration); 3062 end if; 3063 3064 when Tok_Protected => 3065 if Flags.Vhdl_Std < Vhdl_00 then 3066 Error_Msg_Parse ("protected type not allowed in vhdl87/93"); 3067 end if; 3068 Decl := Parse_Protected_Type_Definition (Ident, Loc); 3069 3070 when others => 3071 Error_Msg_Parse ("missing type definition after 'is'"); 3072 Decl := Create_Iir (Iir_Kind_Type_Declaration); 3073 end case; 3074 3075 if Decl = Null_Iir then 3076 case Get_Kind (Def) is 3077 when Iir_Kind_Enumeration_Type_Definition 3078 | Iir_Kind_Access_Type_Definition 3079 | Iir_Kind_Array_Type_Definition 3080 | Iir_Kind_File_Type_Definition => 3081 Decl := Create_Iir (Iir_Kind_Type_Declaration); 3082 when Iir_Kind_Array_Subtype_Definition => 3083 Decl := Create_Iir (Iir_Kind_Anonymous_Type_Declaration); 3084 when others => 3085 Error_Kind ("parse_type_declaration", Def); 3086 end case; 3087 Set_Type_Definition (Decl, Def); 3088 end if; 3089 Set_Identifier (Decl, Ident); 3090 Set_Location (Decl, Loc); 3091 3092 -- ';' is expected after end of type declaration 3093 Scan_Semi_Colon_Declaration ("type declaration"); 3094 3095 if Flag_Elocations then 3096 Create_Elocations (Decl); 3097 Set_Start_Location (Decl, Start_Loc); 3098 end if; 3099 3100 return Decl; 3101 end Parse_Type_Declaration; 3102 3103 -- precond: '(' or identifier 3104 -- postcond: next token 3105 -- 3106 -- [ LRM08 6.3 ] 3107 -- 3108 -- resolution_indication ::= 3109 -- resolution_function_name | ( element_resolution ) 3110 -- 3111 -- element_resolution ::= 3112 -- array_element_resolution | record_resolution 3113 -- 3114 -- array_element_resolution ::= resolution_indication 3115 -- 3116 -- record_resolution ::= 3117 -- record_element_resolution { , record_element_resolution } 3118 -- 3119 -- record_element_resolution ::= 3120 -- record_element_simple_name resolution_indication 3121 function Parse_Resolution_Indication return Iir 3122 is 3123 Ind : Iir; 3124 Def : Iir; 3125 Loc : Location_Type; 3126 begin 3127 if Current_Token = Tok_Identifier then 3128 -- Resolution function name. 3129 return Parse_Name (Allow_Indexes => False); 3130 elsif Current_Token = Tok_Left_Paren then 3131 -- Element resolution. 3132 Loc := Get_Token_Location; 3133 3134 -- Eat '(' 3135 Scan; 3136 3137 Ind := Parse_Resolution_Indication; 3138 if Current_Token = Tok_Identifier 3139 or else Current_Token = Tok_Left_Paren 3140 then 3141 declare 3142 Id : Name_Id; 3143 El : Iir; 3144 First, Last : Iir; 3145 begin 3146 -- This was in fact a record_resolution. 3147 if Get_Kind (Ind) = Iir_Kind_Simple_Name then 3148 Id := Get_Identifier (Ind); 3149 else 3150 Error_Msg_Parse (+Ind, "element name expected"); 3151 Id := Null_Identifier; 3152 end if; 3153 Free_Iir (Ind); 3154 3155 Def := Create_Iir (Iir_Kind_Record_Resolution); 3156 Set_Location (Def, Loc); 3157 Chain_Init (First, Last); 3158 loop 3159 El := Create_Iir (Iir_Kind_Record_Element_Resolution); 3160 Set_Location (El, Loc); 3161 Set_Identifier (El, Id); 3162 Set_Resolution_Indication (El, Parse_Resolution_Indication); 3163 Chain_Append (First, Last, El); 3164 exit when Current_Token /= Tok_Comma; 3165 3166 -- Eat ',' 3167 Scan; 3168 3169 if Current_Token /= Tok_Identifier then 3170 Error_Msg_Parse ("record element identifier expected"); 3171 exit; 3172 end if; 3173 Id := Current_Identifier; 3174 Loc := Get_Token_Location; 3175 3176 -- Eat identifier 3177 Scan; 3178 end loop; 3179 Set_Record_Element_Resolution_Chain (Def, First); 3180 end; 3181 else 3182 Def := Create_Iir (Iir_Kind_Array_Element_Resolution); 3183 Set_Location (Def, Loc); 3184 Set_Resolution_Indication (Def, Ind); 3185 end if; 3186 3187 -- Eat ')' 3188 Expect_Scan (Tok_Right_Paren); 3189 3190 return Def; 3191 else 3192 Error_Msg_Parse ("resolution indication expected"); 3193 return Null_Iir; 3194 end if; 3195 end Parse_Resolution_Indication; 3196 3197 -- precond : '(' 3198 -- postcond: next token 3199 -- 3200 -- [ LRM08 6.3 Subtype declarations ] 3201 -- element_constraint ::= 3202 -- array_constraint | record_constraint 3203 -- 3204 -- [ LRM08 5.3.2.1 Array types ] 3205 -- array_constraint ::= 3206 -- index_constraint [ array_element_constraint ] 3207 -- | ( open ) [ array_element_constraint ] 3208 -- 3209 -- array_element_constraint ::= element_constraint 3210 -- 3211 -- RES is the resolution_indication of the subtype indication. 3212 procedure Parse_Element_Constraint (Def : Iir) 3213 is 3214 El_Def : Iir; 3215 El : Iir; 3216 Index_List : Iir_List; 3217 begin 3218 -- Index_constraint. 3219 Set_Location (Def); 3220 Set_Index_Constraint_Flag (Def, True); 3221 Set_Has_Array_Constraint_Flag (Def, True); 3222 3223 -- Eat '('. 3224 Scan; 3225 3226 if Current_Token = Tok_Open then 3227 -- Eat 'open'. 3228 Scan; 3229 else 3230 Index_List := Create_Iir_List; 3231 -- index_constraint ::= (discrete_range {, discrete_range} ) 3232 loop 3233 El := Parse_Discrete_Range; 3234 Append_Element (Index_List, El); 3235 3236 exit when Current_Token /= Tok_Comma; 3237 3238 -- Eat ',' 3239 Scan; 3240 end loop; 3241 Set_Index_Constraint_List (Def, List_To_Flist (Index_List)); 3242 end if; 3243 3244 -- Eat ')' 3245 Expect_Scan (Tok_Right_Paren); 3246 3247 if Current_Token = Tok_Left_Paren then 3248 El_Def := Create_Iir (Iir_Kind_Array_Subtype_Definition); 3249 Parse_Element_Constraint (El_Def); 3250 Set_Array_Element_Constraint (Def, El_Def); 3251 Set_Has_Element_Constraint_Flag (Def, True); 3252 end if; 3253 end Parse_Element_Constraint; 3254 3255 -- precond : tolerance 3256 -- postcond: next token 3257 -- 3258 -- [ LRM93 4.2 ] 3259 -- tolerance_aspect ::= TOLERANCE string_expression 3260 function Parse_Tolerance_Aspect_Opt return Iir is 3261 begin 3262 if AMS_Vhdl 3263 and then Current_Token = Tok_Tolerance 3264 then 3265 Scan; 3266 return Parse_Expression; 3267 else 3268 return Null_Iir; 3269 end if; 3270 end Parse_Tolerance_Aspect_Opt; 3271 3272 -- precond : identifier or '(' 3273 -- postcond: next token 3274 -- 3275 -- [ LRM93 4.2 ] 3276 -- subtype_indication ::= 3277 -- [ RESOLUTION_FUNCTION_name ] type_mark [ constraint ] 3278 -- 3279 -- constraint ::= range_constraint | index_constraint 3280 -- 3281 -- [ LRM08 6.3 ] 3282 -- subtype_indication ::= 3283 -- [ resolution_indication ] type_mark [ constraint ] 3284 -- 3285 -- constraint ::= 3286 -- range_constraint | array_constraint | record_constraint 3287 -- 3288 -- NAME is the type_mark when already parsed (in range expression or 3289 -- allocator by type). 3290 function Parse_Subtype_Indication (Name : Iir := Null_Iir) return Iir 3291 is 3292 Type_Mark : Iir; 3293 Def: Iir; 3294 Resolution_Indication: Iir; 3295 Tolerance : Iir; 3296 begin 3297 -- FIXME: location. 3298 Resolution_Indication := Null_Iir; 3299 Def := Null_Iir; 3300 3301 if Name /= Null_Iir then 3302 -- The type_mark was already parsed. 3303 if Check_Type_Mark (Name) then 3304 Type_Mark := Name; 3305 else 3306 -- Not a type mark. Ignore it. 3307 Type_Mark := Null_Iir; 3308 end if; 3309 else 3310 if Current_Token = Tok_Left_Paren then 3311 if Vhdl_Std < Vhdl_08 then 3312 Error_Msg_Parse 3313 ("resolution_indication not allowed before vhdl08"); 3314 end if; 3315 Resolution_Indication := Parse_Resolution_Indication; 3316 end if; 3317 if Current_Token /= Tok_Identifier then 3318 Error_Msg_Parse ("type mark expected in a subtype indication"); 3319 return Create_Error_Node; 3320 end if; 3321 Type_Mark := Parse_Type_Mark (Check_Paren => False); 3322 end if; 3323 3324 if Current_Token = Tok_Identifier then 3325 if Resolution_Indication /= Null_Iir then 3326 Error_Msg_Parse ("resolution function already indicated"); 3327 end if; 3328 Resolution_Indication := Type_Mark; 3329 Type_Mark := Parse_Type_Mark (Check_Paren => False); 3330 end if; 3331 3332 case Current_Token is 3333 when Tok_Left_Paren => 3334 -- element_constraint. 3335 Def := Create_Iir (Iir_Kind_Array_Subtype_Definition); 3336 Parse_Element_Constraint (Def); 3337 Set_Subtype_Type_Mark (Def, Type_Mark); 3338 Set_Resolution_Indication (Def, Resolution_Indication); 3339 Set_Tolerance (Def, Parse_Tolerance_Aspect_Opt); 3340 3341 when Tok_Range => 3342 -- range_constraint. 3343 -- Skip 'range' 3344 Scan; 3345 3346 Def := Parse_Range_Constraint_Of_Subtype_Indication 3347 (Type_Mark, Resolution_Indication); 3348 3349 when others => 3350 Tolerance := Parse_Tolerance_Aspect_Opt; 3351 if Resolution_Indication /= Null_Iir 3352 or else Tolerance /= Null_Iir 3353 then 3354 -- A subtype needs to be created. 3355 Def := Create_Iir (Iir_Kind_Subtype_Definition); 3356 if Type_Mark /= Null_Iir then 3357 Location_Copy (Def, Type_Mark); 3358 Set_Subtype_Type_Mark (Def, Type_Mark); 3359 end if; 3360 Set_Resolution_Indication (Def, Resolution_Indication); 3361 Set_Tolerance (Def, Tolerance); 3362 else 3363 -- This is just an alias. 3364 Def := Type_Mark; 3365 end if; 3366 end case; 3367 return Def; 3368 end Parse_Subtype_Indication; 3369 3370 -- precond : SUBTYPE 3371 -- postcond: next token 3372 -- 3373 -- [ LRM93 4.2 ] 3374 -- subtype_declaration ::= SUBTYPE identifier IS subtype_indication ; 3375 function Parse_Subtype_Declaration (Parent : Iir) 3376 return Iir_Subtype_Declaration 3377 is 3378 Decl: Iir_Subtype_Declaration; 3379 Def: Iir; 3380 Start_Loc : Location_Type; 3381 begin 3382 Decl := Create_Iir (Iir_Kind_Subtype_Declaration); 3383 Set_Parent (Decl, Parent); 3384 Start_Loc := Get_Token_Location; 3385 3386 -- Eat 'subtype'. 3387 Scan; 3388 3389 Scan_Identifier (Decl); 3390 3391 -- Skip 'is'. 3392 Expect_Scan (Tok_Is); 3393 3394 Def := Parse_Subtype_Indication; 3395 Set_Subtype_Indication (Decl, Def); 3396 3397 -- Skip ';'. 3398 Scan_Semi_Colon_Declaration ("subtype decalaration"); 3399 3400 if Flag_Elocations then 3401 Create_Elocations (Decl); 3402 Set_Start_Location (Decl, Start_Loc); 3403 end if; 3404 3405 return Decl; 3406 end Parse_Subtype_Declaration; 3407 3408 -- [ LRM93 3.5.1 ] 3409 -- scalar_nature_definition ::= type_mark ACROSS 3410 -- type_mark THROUGH 3411 -- identifier REFERENCE 3412 -- 3413 function Parse_Scalar_Nature_Definition return Iir 3414 is 3415 Def : Iir; 3416 Ref : Iir; 3417 begin 3418 Def := Create_Iir (Iir_Kind_Scalar_Nature_Definition); 3419 Set_Across_Type_Mark (Def, Parse_Type_Mark); 3420 Expect_Scan (Tok_Across, "'across' expected after type mark"); 3421 Set_Through_Type_Mark (Def, Parse_Type_Mark); 3422 Expect_Scan (Tok_Through, "'through' expected after type mark"); 3423 if Current_Token = Tok_Identifier then 3424 Ref := Create_Iir (Iir_Kind_Terminal_Declaration); 3425 Scan_Identifier (Ref); 3426 Set_Reference (Def, Ref); 3427 if Current_Token = Tok_Reference then 3428 Scan; 3429 else 3430 Expect (Tok_Reference, "'reference' expected"); 3431 Skip_Until_Semi_Colon; 3432 end if; 3433 else 3434 Error_Msg_Parse ("reference identifier expected"); 3435 Skip_Until_Semi_Colon; 3436 end if; 3437 3438 return Def; 3439 end Parse_Scalar_Nature_Definition; 3440 3441 -- precond : identifier 3442 -- postcond: next token 3443 -- 3444 -- LRM 4.8 Nature declaration 3445 -- 3446 -- subnature_indication ::= 3447 -- nature_mark [ index_constraint ] 3448 -- [ TOLERANCE string_expression ACROSS string_expression THROUGH ] 3449 -- 3450 -- nature_mark ::= 3451 -- nature_name | subnature_name 3452 function Parse_Subnature_Indication return Iir 3453 is 3454 Nature_Mark : Iir; 3455 Expr : Iir; 3456 Res : Iir; 3457 begin 3458 if Current_Token /= Tok_Identifier then 3459 Error_Msg_Parse ("nature mark expected in a subnature indication"); 3460 return Null_Iir; 3461 end if; 3462 Res := Parse_Name (Allow_Indexes => False); 3463 3464 if Current_Token = Tok_Left_Paren then 3465 Nature_Mark := Res; 3466 Res := Create_Iir (Iir_Kind_Array_Subnature_Definition); 3467 Parse_Element_Constraint (Res); 3468 Set_Subnature_Nature_Mark (Res, Nature_Mark); 3469 end if; 3470 3471 if Current_Token = Tok_Tolerance then 3472 -- Skip 'tolerance'. 3473 Scan; 3474 3475 Expr := Parse_Expression; 3476 3477 Expect_Scan (Tok_Across, "'across' required after tolerance"); 3478 3479 Expr := Parse_Expression; 3480 3481 Expect_Scan (Tok_Through, "'through' required after tolerance"); 3482 pragma Unreferenced (Expr); 3483 end if; 3484 return Res; 3485 end Parse_Subnature_Indication; 3486 3487 function Parse_Array_Nature_Definition return Iir 3488 is 3489 Loc : Location_Type; 3490 Index_Flist : Iir_Flist; 3491 Array_Constrained : Boolean; 3492 Element_Subnature : Iir; 3493 Res_Type : Iir; 3494 begin 3495 Loc := Get_Token_Location; 3496 3497 Parse_Array_Indexes (Index_Flist, Array_Constrained); 3498 3499 Element_Subnature := Parse_Subnature_Indication; 3500 3501 if Array_Constrained then 3502 -- Sem_Type will create the array type. 3503 Res_Type := Create_Iir (Iir_Kind_Array_Subnature_Definition); 3504 Set_Array_Element_Constraint (Res_Type, Element_Subnature); 3505 Set_Index_Constraint_List (Res_Type, Index_Flist); 3506 Set_Index_Constraint_Flag (Res_Type, True); 3507 else 3508 Res_Type := Create_Iir (Iir_Kind_Array_Nature_Definition); 3509 Set_Element_Subnature_Indication (Res_Type, Element_Subnature); 3510 Set_Index_Subtype_Definition_List (Res_Type, Index_Flist); 3511 end if; 3512 Set_Location (Res_Type, Loc); 3513 3514 return Res_Type; 3515 end Parse_Array_Nature_Definition; 3516 3517 -- record_nature_definition ::= 3518 -- RECORD 3519 -- nature_element_declaration 3520 -- { nature_element_declaration } 3521 -- END RECORD [ /record_nature/_simple_name ] 3522 -- 3523 function Parse_Record_Nature_Definition return Iir 3524 is 3525 Res : Iir; 3526 El_List : Iir_List; 3527 El : Iir; 3528 First : Iir; 3529 Pos: Iir_Index32; 3530 Subnature_Indication : Iir; 3531 begin 3532 Res := Create_Iir (Iir_Kind_Record_Nature_Definition); 3533 Set_Location (Res); 3534 El_List := Create_Iir_List; 3535 3536 -- Skip 'record' 3537 Scan; 3538 3539 Pos := 0; 3540 First := Null_Iir; 3541 loop 3542 pragma Assert (First = Null_Iir); 3543 -- Parse identifier_list 3544 loop 3545 El := Create_Iir (Iir_Kind_Nature_Element_Declaration); 3546 Scan_Identifier (El); 3547 3548 Set_Parent (El, Res); 3549 if First = Null_Iir then 3550 First := El; 3551 end if; 3552 3553 Append_Element (El_List, El); 3554 Set_Element_Position (El, Pos); 3555 Pos := Pos + 1; 3556 3557 exit when Current_Token /= Tok_Comma; 3558 3559 Set_Has_Identifier_List (El, True); 3560 3561 -- Skip ',' 3562 Scan; 3563 end loop; 3564 3565 -- Scan ':'. 3566 Expect_Scan (Tok_Colon); 3567 3568 -- Parse element subnature indication. 3569 Subnature_Indication := Parse_Subnature_Indication; 3570 Set_Subnature_Indication (First, Subnature_Indication); 3571 3572 First := Null_Iir; 3573 Scan_Semi_Colon_Declaration ("element declaration"); 3574 exit when Current_Token /= Tok_Identifier; 3575 end loop; 3576 3577 Set_Elements_Declaration_List (Res, List_To_Flist (El_List)); 3578 3579 if Flag_Elocations then 3580 Create_Elocations (Res); 3581 Set_End_Location (Res, Get_Token_Location); 3582 end if; 3583 3584 -- Skip 'end' 3585 Expect_Scan (Tok_End); 3586 Expect_Scan (Tok_Record); 3587 Set_End_Has_Reserved_Id (Res, True); 3588 3589 return Res; 3590 end Parse_Record_Nature_Definition; 3591 3592 -- precond : NATURE 3593 -- postcond: a token 3594 -- 3595 -- AMS-LRM17 6.11 Nature and subnature declarations 3596 -- nature_definition ::= scalar_nature_definition 3597 -- | composite_nature_definition 3598 -- 3599 -- [ LRM93 3.5.2 ] 3600 -- composite_nature_definition ::= array_nature_definition 3601 -- | record_nature_definition 3602 function Parse_Nature_Declaration return Iir 3603 is 3604 Def : Iir; 3605 Loc : Location_Type; 3606 Ident : Name_Id; 3607 Decl : Iir; 3608 begin 3609 -- Skip 'nature'. 3610 pragma Assert (Current_Token = Tok_Nature); 3611 Scan; 3612 3613 -- Get the identifier 3614 Expect (Tok_Identifier, "an identifier is expected after 'nature'"); 3615 Loc := Get_Token_Location; 3616 Ident := Current_Identifier; 3617 3618 Scan; 3619 3620 -- Skip 'is'. 3621 Expect_Scan (Tok_Is); 3622 3623 case Current_Token is 3624 when Tok_Array => 3625 Def := Parse_Array_Nature_Definition; 3626 Set_Location (Def, Loc); 3627 when Tok_Record => 3628 Def := Parse_Record_Nature_Definition; 3629 Set_Location (Def, Loc); 3630 if Current_Token = Tok_Identifier then 3631 Check_End_Name (Ident, Def); 3632 end if; 3633 when Tok_Identifier => 3634 Def := Parse_Scalar_Nature_Definition; 3635 Set_Location (Def, Loc); 3636 when others => 3637 Error_Msg_Parse ("nature definition expected here"); 3638 Skip_Until_Semi_Colon; 3639 end case; 3640 3641 Decl := Create_Iir (Iir_Kind_Nature_Declaration); 3642 Set_Nature (Decl, Def); 3643 Set_Identifier (Decl, Ident); 3644 Set_Location (Decl, Loc); 3645 3646 -- ';' is expected after end of type declaration 3647 Scan_Semi_Colon_Declaration ("nature declaration"); 3648 3649 return Decl; 3650 end Parse_Nature_Declaration; 3651 3652 -- AMS-LRM17 6.11 Nature and subnature declarations 3653 -- subnature_declaration ::= 3654 -- SUBNATURE identifier is subnature_indication ; 3655 function Parse_Subnature_Declaration return Iir 3656 is 3657 Res : Iir; 3658 begin 3659 Res := Create_Iir (Iir_Kind_Subnature_Declaration); 3660 Set_Location (Res); 3661 3662 -- Skip 'subnature'. 3663 Scan; 3664 3665 Scan_Identifier (Res); 3666 3667 -- Skip 'is'. 3668 Expect_Scan (Tok_Is); 3669 3670 Set_Subnature_Indication (Res, Parse_Subnature_Indication); 3671 3672 -- ';' is expected after end of type declaration 3673 Scan_Semi_Colon_Declaration ("subnature declaration"); 3674 3675 return Res; 3676 end Parse_Subnature_Declaration; 3677 3678 -- precond : TERMINAL 3679 -- postcond: next token. 3680 -- 3681 -- [ 4.3.1.5 Terminal declarations ] 3682 -- terminal_declaration ::= 3683 -- TERMINAL identifier_list : subnature_indication 3684 function Parse_Terminal_Declaration (Parent : Iir) return Iir 3685 is 3686 -- First and last element of the chain to be returned. 3687 First, Last : Iir; 3688 Terminal : Iir; 3689 Subnature : Iir; 3690 begin 3691 Chain_Init (First, Last); 3692 3693 -- Skip 'terminal'. 3694 Scan; 3695 3696 loop 3697 -- 'terminal' or "," was just scanned. 3698 Terminal := Create_Iir (Iir_Kind_Terminal_Declaration); 3699 3700 Scan_Identifier (Terminal); 3701 3702 Set_Parent (Terminal, Parent); 3703 3704 Chain_Append (First, Last, Terminal); 3705 3706 exit when Current_Token /= Tok_Comma; 3707 3708 Set_Has_Identifier_List (Terminal, True); 3709 3710 -- Skip ','. 3711 Scan; 3712 end loop; 3713 3714 -- Skip ':'. 3715 Expect_Scan (Tok_Colon); 3716 3717 Subnature := Parse_Subnature_Indication; 3718 3719 Terminal := First; 3720 while Terminal /= Null_Iir loop 3721 -- Type definitions are factorized. This is OK, but not done by 3722 -- sem. 3723 if Terminal = First then 3724 Set_Subnature_Indication (Terminal, Subnature); 3725 else 3726 Set_Subnature_Indication (Terminal, Null_Iir); 3727 end if; 3728 Terminal := Get_Chain (Terminal); 3729 end loop; 3730 3731 -- Skip ';'. 3732 Scan_Semi_Colon_Declaration ("terminal declaration"); 3733 3734 return First; 3735 end Parse_Terminal_Declaration; 3736 3737 -- precond : SPECTRUM 3738 -- 3739 -- AMS-LRM17 6.4.2.7 Quantity declarations 3740 -- source_aspect ::= 3741 -- SPECTRUM magnitude_simple_expression , phase_simple_expression 3742 -- | NOISE power_simple_expression 3743 function Parse_Source_Quantity_Declaration 3744 (Old : Iir; Parent : Iir; Kind : Iir_Kinds_Source_Quantity_Declaration) 3745 return Iir 3746 is 3747 Object : Iir; 3748 New_Object : Iir; 3749 First, Last : Iir; 3750 begin 3751 -- Change declarations 3752 Object := Old; 3753 Chain_Init (First, Last); 3754 while Object /= Null_Iir loop 3755 New_Object := Create_Iir (Kind); 3756 Location_Copy (New_Object, Object); 3757 Set_Identifier (New_Object, Get_Identifier (Object)); 3758 Set_Subtype_Indication (New_Object, Get_Subtype_Indication (Object)); 3759 Set_Parent (New_Object, Parent); 3760 Set_Has_Identifier_List 3761 (New_Object, Get_Has_Identifier_List (Object)); 3762 3763 Chain_Append (First, Last, New_Object); 3764 3765 New_Object := Get_Chain (Object); 3766 Free_Iir (Object); 3767 Object := New_Object; 3768 end loop; 3769 3770 -- Skip 'spectrum'/'noise' 3771 Scan; 3772 3773 case Kind is 3774 when Iir_Kind_Spectrum_Quantity_Declaration => 3775 Set_Magnitude_Expression (First, Parse_Expression); 3776 3777 Expect_Scan (Tok_Comma); 3778 3779 Set_Phase_Expression (First, Parse_Expression); 3780 when Iir_Kind_Noise_Quantity_Declaration => 3781 Set_Power_Expression (First, Parse_Expression); 3782 end case; 3783 3784 return First; 3785 end Parse_Source_Quantity_Declaration; 3786 3787 -- precond : QUANTITY 3788 -- postcond: next token. 3789 -- 3790 -- [ 4.3.1.6 Quantity declarations ] 3791 -- quantity_declaration ::= 3792 -- free_quantity_declaration 3793 -- | branch_quantity_declaration 3794 -- | source_quantity_declaration 3795 -- 3796 -- free_quantity_declaration ::= 3797 -- QUANTITY identifier_list : subtype_indication [ := expression ] ; 3798 -- 3799 -- branch_quantity_declaration ::= 3800 -- QUANTITY [ across_aspect ] [ through_aspect ] terminal_aspect ; 3801 -- 3802 -- source_quantity_declaration ::= 3803 -- QUANTITY identifier_list : subtype_indication source_aspect ; 3804 -- 3805 -- across_aspect ::= 3806 -- identifier_list [ tolerance_aspect ] [ := expression ] ACROSS 3807 -- 3808 -- through_aspect ::= 3809 -- identifier_list [ tolerance_aspect ] [ := expression ] THROUGH 3810 -- 3811 -- terminal_aspect ::= 3812 -- plus_terminal_name [ TO minus_terminal_name ] 3813 function Parse_Quantity_Declaration (Parent : Iir) return Iir 3814 is 3815 -- First and last element of the chain to be returned. 3816 First, Last : Iir; 3817 Object : Iir; 3818 New_Object : Iir; 3819 Tolerance : Iir; 3820 Default_Value : Iir; 3821 Kind : Iir_Kind; 3822 Plus_Terminal : Iir; 3823 begin 3824 Chain_Init (First, Last); 3825 3826 -- Eat 'quantity' 3827 Scan; 3828 3829 loop 3830 -- Quantity or "," was just scanned. We assume a free quantity 3831 -- declaration and will change to branch or source quantity if 3832 -- necessary. 3833 Object := Create_Iir (Iir_Kind_Free_Quantity_Declaration); 3834 3835 Scan_Identifier (Object); 3836 3837 Set_Parent (Object, Parent); 3838 3839 Chain_Append (First, Last, Object); 3840 3841 exit when Current_Token /= Tok_Comma; 3842 3843 -- Eat ',' 3844 Scan; 3845 3846 Set_Has_Identifier_List (Object, True); 3847 end loop; 3848 3849 case Current_Token is 3850 when Tok_Colon => 3851 -- Either a free quantity (or a source quantity) 3852 -- TODO 3853 3854 -- Skip ':'. 3855 Scan; 3856 3857 Set_Subtype_Indication (First, Parse_Subtype_Indication); 3858 3859 case Current_Token is 3860 when Tok_Spectrum => 3861 First := Parse_Source_Quantity_Declaration 3862 (First, Parent, Iir_Kind_Spectrum_Quantity_Declaration); 3863 when Tok_Noise => 3864 First := Parse_Source_Quantity_Declaration 3865 (First, Parent, Iir_Kind_Noise_Quantity_Declaration); 3866 when Tok_Assign => 3867 -- Skip ':='. 3868 Scan; 3869 3870 Set_Default_Value (First, Parse_Expression); 3871 when others => 3872 null; 3873 end case; 3874 when Tok_Tolerance 3875 | Tok_Assign 3876 | Tok_Across 3877 | Tok_Through => 3878 -- A branch quantity 3879 3880 -- Parse tolerance aspect 3881 Tolerance := Parse_Tolerance_Aspect_Opt; 3882 3883 -- Parse default value 3884 if Current_Token = Tok_Assign then 3885 Scan; 3886 Default_Value := Parse_Expression; 3887 else 3888 Default_Value := Null_Iir; 3889 end if; 3890 3891 case Current_Token is 3892 when Tok_Across => 3893 Kind := Iir_Kind_Across_Quantity_Declaration; 3894 when Tok_Through => 3895 Kind := Iir_Kind_Through_Quantity_Declaration; 3896 when others => 3897 Error_Msg_Parse ("'across' or 'through' expected here"); 3898 Skip_Until_Semi_Colon; 3899 return Null_Iir; 3900 end case; 3901 3902 -- Eat across/through 3903 Scan; 3904 3905 -- Change declarations 3906 Object := First; 3907 Chain_Init (First, Last); 3908 while Object /= Null_Iir loop 3909 New_Object := Create_Iir (Kind); 3910 Location_Copy (New_Object, Object); 3911 Set_Identifier (New_Object, Get_Identifier (Object)); 3912 Set_Parent (New_Object, Parent); 3913 Set_Tolerance (New_Object, Tolerance); 3914 Set_Default_Value (New_Object, Default_Value); 3915 Set_Has_Identifier_List 3916 (New_Object, Get_Has_Identifier_List (Object)); 3917 3918 Chain_Append (First, Last, New_Object); 3919 3920 if Object /= First then 3921 Set_Plus_Terminal (New_Object, Null_Iir); 3922 end if; 3923 New_Object := Get_Chain (Object); 3924 Free_Iir (Object); 3925 Object := New_Object; 3926 end loop; 3927 3928 -- Parse terminal (or first identifier of through declarations) 3929 Plus_Terminal := Parse_Name; 3930 3931 case Current_Token is 3932 when Tok_Comma 3933 | Tok_Tolerance 3934 | Tok_Assign 3935 | Tok_Through 3936 | Tok_Across => 3937 -- Through quantity declaration. Convert the Plus_Terminal 3938 -- to a declaration. 3939 if Get_Kind (First) = Iir_Kind_Through_Quantity_Declaration 3940 then 3941 Error_Msg_Parse ("terminal aspect expected"); 3942 end if; 3943 3944 Object := Create_Iir (Iir_Kind_Through_Quantity_Declaration); 3945 New_Object := Object; 3946 Location_Copy (Object, Plus_Terminal); 3947 if Get_Kind (Plus_Terminal) /= Iir_Kind_Simple_Name then 3948 Error_Msg_Parse 3949 ("identifier for quantity declaration expected"); 3950 else 3951 Set_Identifier (Object, Get_Identifier (Plus_Terminal)); 3952 end if; 3953 Set_Plus_Terminal (Object, Null_Iir); 3954 Free_Iir (Plus_Terminal); 3955 3956 loop 3957 Set_Parent (Object, Parent); 3958 Set_Has_Identifier_List (Last, True); 3959 Chain_Append (First, Last, Object); 3960 exit when Current_Token /= Tok_Comma; 3961 -- Skip ','. 3962 Scan; 3963 3964 Object := Create_Iir 3965 (Iir_Kind_Through_Quantity_Declaration); 3966 Scan_Identifier (Object); 3967 Set_Plus_Terminal (Object, Null_Iir); 3968 end loop; 3969 3970 -- Parse tolerance aspect 3971 Set_Tolerance (Object, Parse_Tolerance_Aspect_Opt); 3972 3973 -- Parse default value 3974 if Current_Token = Tok_Assign then 3975 Scan; 3976 Set_Default_Value (Object, Parse_Expression); 3977 end if; 3978 3979 -- Scan 'through' 3980 if Current_Token = Tok_Through then 3981 Scan; 3982 elsif Current_Token = Tok_Across then 3983 Error_Msg_Parse ("across quantity declaration must appear" 3984 & " before though declaration"); 3985 Scan; 3986 else 3987 Error_Msg_Parse ("'through' expected"); 3988 end if; 3989 3990 -- Parse plus terminal 3991 Plus_Terminal := Parse_Name; 3992 when others => 3993 null; 3994 end case; 3995 3996 Set_Plus_Terminal_Name (First, Plus_Terminal); 3997 3998 -- Parse minus terminal (if present) 3999 if Current_Token = Tok_To then 4000 -- Skip 'to'. 4001 Scan; 4002 4003 Set_Minus_Terminal_Name (First, Parse_Name); 4004 end if; 4005 when others => 4006 Error_Msg_Parse ("missing type or across/throught aspect " 4007 & "in quantity declaration"); 4008 Skip_Until_Semi_Colon; 4009 return Null_Iir; 4010 end case; 4011 4012 -- Skip ';'. 4013 Scan_Semi_Colon_Declaration ("quantity declaration"); 4014 4015 return First; 4016 end Parse_Quantity_Declaration; 4017 4018 -- precond : token (CONSTANT, SIGNAL, VARIABLE, FILE) 4019 -- postcond: next token. 4020 -- 4021 -- KIND can be iir_kind_constant_declaration, iir_kind_file_declaration 4022 -- or iir_kind_variable_declaration 4023 -- 4024 -- [ LRM93 4.3.1 ] 4025 -- object_declaration ::= constant_declaration 4026 -- | signal_declaration 4027 -- | variable_declaration 4028 -- | file_declaration 4029 -- 4030 -- [ LRM93 4.3.1.1 ] 4031 -- constant_declaration ::= 4032 -- CONSTANT identifier_list : subtype_indication [ := expression ] 4033 -- 4034 -- [ LRM87 4.3.2 ] 4035 -- file_declaration ::= 4036 -- FILE identifier : subtype_indication IS [ mode ] file_logical_name 4037 -- 4038 -- [ LRM93 4.3.1.4 ] 4039 -- file_declaration ::= 4040 -- FILE identifier_list : subtype_indication [ file_open_information ] 4041 -- 4042 -- [ LRM93 4.3.1.4 ] 4043 -- file_open_information ::= 4044 -- [ OPEN FILE_OPEN_KIND_expression ] IS file_logical_name 4045 -- 4046 -- [ LRM93 4.3.1.4 ] 4047 -- file_logical_name ::= STRING_expression 4048 -- 4049 -- [ LRM93 4.3.1.3 ] 4050 -- variable_declaration ::= 4051 -- [ SHARED ] VARIABLE identifier_list : subtype_indication 4052 -- [ := expression ] 4053 -- 4054 -- [ LRM93 4.3.1.2 ] 4055 -- signal_declaration ::= 4056 -- SIGNAL identifier_list : subtype_information [ signal_kind ] 4057 -- [ := expression ] 4058 -- 4059 -- [ LRM93 4.3.1.2 ] 4060 -- signal_kind ::= REGISTER | BUS 4061 -- 4062 -- FIXME: file_open_information. 4063 function Parse_Object_Declaration (Parent : Iir) return Iir 4064 is 4065 -- First and last element of the chain to be returned. 4066 First, Last : Iir; 4067 Object: Iir; 4068 Object_Type: Iir; 4069 Default_Value : Iir; 4070 Mode: Iir_Mode; 4071 Signal_Kind : Iir_Signal_Kind; 4072 Is_Guarded : Boolean; 4073 Open_Kind : Iir; 4074 Logical_Name : Iir; 4075 Kind: Iir_Kind; 4076 Shared : Boolean; 4077 Has_Mode : Boolean; 4078 Start_Loc : Location_Type; 4079 begin 4080 Chain_Init (First, Last); 4081 4082 -- Object keyword was just scanned. 4083 Start_Loc := Get_Token_Location; 4084 case Current_Token is 4085 when Tok_Signal => 4086 Kind := Iir_Kind_Signal_Declaration; 4087 4088 -- Skip 'signal'. 4089 Scan; 4090 4091 when Tok_Constant => 4092 Kind := Iir_Kind_Constant_Declaration; 4093 4094 -- Skip 'constant'. 4095 Scan; 4096 4097 when Tok_File => 4098 Kind := Iir_Kind_File_Declaration; 4099 4100 -- Skip 'file'. 4101 Scan; 4102 4103 when Tok_Variable => 4104 Kind := Iir_Kind_Variable_Declaration; 4105 Shared := False; 4106 4107 -- Skip 'variable'. 4108 Scan; 4109 4110 when Tok_Shared => 4111 Kind := Iir_Kind_Variable_Declaration; 4112 Shared := True; 4113 4114 -- Skip 'shared'. 4115 Scan; 4116 4117 Expect_Scan (Tok_Variable); 4118 when others => 4119 raise Internal_Error; 4120 end case; 4121 4122 loop 4123 -- Object or "," was just scanned. 4124 Object := Create_Iir (Kind); 4125 if Kind = Iir_Kind_Variable_Declaration then 4126 Set_Shared_Flag (Object, Shared); 4127 end if; 4128 4129 Scan_Identifier (Object); 4130 4131 Set_Parent (Object, Parent); 4132 4133 if Flag_Elocations then 4134 Create_Elocations (Object); 4135 Set_Start_Location (Object, Start_Loc); 4136 end if; 4137 4138 Chain_Append (First, Last, Object); 4139 4140 exit when Current_Token /= Tok_Comma; 4141 4142 -- Skip ','. 4143 Scan; 4144 Set_Has_Identifier_List (Object, True); 4145 end loop; 4146 4147 -- Skip ':'. 4148 Expect_Scan (Tok_Colon); 4149 4150 -- Skip unexpected mode, this could happen when the interface is 4151 -- copied. 4152 case Current_Token is 4153 when Tok_In | Tok_Out | Tok_Inout | Tok_Buffer | Tok_Linkage => 4154 Error_Msg_Parse ("mode not allowed in object declaration"); 4155 4156 -- Skip mode. 4157 Scan; 4158 when others => 4159 null; 4160 end case; 4161 4162 Object_Type := Parse_Subtype_Indication; 4163 4164 if Kind = Iir_Kind_Signal_Declaration then 4165 Parse_Signal_Kind (Is_Guarded, Signal_Kind); 4166 end if; 4167 4168 if Current_Token = Tok_Assign then 4169 if Kind = Iir_Kind_File_Declaration then 4170 Error_Msg_Parse 4171 ("default expression not allowed for a file declaration"); 4172 end if; 4173 4174 -- Skip ':='. 4175 Scan; 4176 4177 Default_Value := Parse_Expression; 4178 elsif Current_Token = Tok_Equal then 4179 Error_Msg_Parse ("= should be := for initial value"); 4180 4181 -- Skip '=' 4182 Scan; 4183 4184 Default_Value := Parse_Expression; 4185 else 4186 Default_Value := Null_Iir; 4187 end if; 4188 4189 if Kind = Iir_Kind_File_Declaration then 4190 if Current_Token = Tok_Open then 4191 if Flags.Vhdl_Std = Vhdl_87 then 4192 Error_Msg_Parse 4193 ("'open' and open kind expression not allowed in vhdl 87"); 4194 end if; 4195 Scan; 4196 Open_Kind := Parse_Expression; 4197 else 4198 Open_Kind := Null_Iir; 4199 end if; 4200 4201 -- LRM 4.3.1.4 4202 -- The default mode is IN, if no mode is specified. 4203 Mode := Iir_In_Mode; 4204 4205 Logical_Name := Null_Iir; 4206 Has_Mode := False; 4207 if Current_Token = Tok_Is then 4208 -- Skip 'is'. 4209 Scan; 4210 4211 case Current_Token is 4212 when Tok_In | Tok_Out | Tok_Inout => 4213 if Flags.Vhdl_Std /= Vhdl_87 4214 and then not Flags.Flag_Relaxed_Files87 4215 then 4216 Error_Msg_Parse ("mode allowed only in vhdl 87"); 4217 end if; 4218 Mode := Parse_Mode; 4219 if Mode = Iir_Inout_Mode then 4220 Error_Msg_Parse ("inout mode not allowed for file"); 4221 end if; 4222 Has_Mode := True; 4223 when others => 4224 null; 4225 end case; 4226 Logical_Name := Parse_Expression; 4227 elsif Flags.Vhdl_Std = Vhdl_87 then 4228 Error_Msg_Parse ("file name expected (vhdl 87)"); 4229 end if; 4230 end if; 4231 4232 Set_Subtype_Indication (First, Object_Type); 4233 if Kind /= Iir_Kind_File_Declaration then 4234 Set_Default_Value (First, Default_Value); 4235 end if; 4236 4237 Object := First; 4238 while Object /= Null_Iir loop 4239 case Kind is 4240 when Iir_Kind_File_Declaration => 4241 Set_Mode (Object, Mode); 4242 Set_File_Open_Kind (Object, Open_Kind); 4243 Set_File_Logical_Name (Object, Logical_Name); 4244 Set_Has_Mode (Object, Has_Mode); 4245 when Iir_Kind_Signal_Declaration => 4246 Set_Guarded_Signal_Flag (Object, Is_Guarded); 4247 Set_Signal_Kind (Object, Signal_Kind); 4248 when others => 4249 null; 4250 end case; 4251 Object := Get_Chain (Object); 4252 end loop; 4253 4254 -- Skip ';'. 4255 Scan_Semi_Colon_Declaration ("object declaration"); 4256 4257 return First; 4258 end Parse_Object_Declaration; 4259 4260 -- precond : COMPONENT 4261 -- postcond: next token. 4262 -- 4263 -- [ LRM93 4.5 ] 4264 -- component_declaration ::= 4265 -- COMPONENT identifier [ IS ] 4266 -- [ LOCAL_generic_clause ] 4267 -- [ LOCAL_port_clause ] 4268 -- END COMPONENT [ COMPONENT_simple_name ] ; 4269 function Parse_Component_Declaration return Iir_Component_Declaration 4270 is 4271 Component : Iir_Component_Declaration; 4272 begin 4273 Component := Create_Iir (Iir_Kind_Component_Declaration); 4274 if Flag_Elocations then 4275 Create_Elocations (Component); 4276 Set_Start_Location (Component, Get_Token_Location); 4277 end if; 4278 4279 -- Eat 'component'. 4280 pragma Assert (Current_Token = Tok_Component); 4281 Scan; 4282 4283 Scan_Identifier (Component); 4284 4285 if Current_Token = Tok_Is then 4286 if Flags.Vhdl_Std = Vhdl_87 then 4287 Error_Msg_Parse ("""is"" keyword is not allowed here by vhdl 87"); 4288 end if; 4289 Set_Has_Is (Component, True); 4290 4291 -- Eat 'is'. 4292 Scan; 4293 end if; 4294 Parse_Generic_Port_Clauses (Component); 4295 4296 if Flag_Elocations then 4297 Set_End_Location (Component, Get_Token_Location); 4298 end if; 4299 4300 Check_End_Name (Tok_Component, Component); 4301 4302 -- Skip ';'. 4303 Expect_Scan (Tok_Semi_Colon); 4304 4305 return Component; 4306 end Parse_Component_Declaration; 4307 4308 -- precond : '[' 4309 -- postcond: next token after ']' 4310 -- 4311 -- [ LRM93 2.3.2 ] 4312 -- signature ::= [ [ type_mark { , type_mark } ] [ RETURN type_mark ] ] 4313 function Parse_Signature return Iir_Signature 4314 is 4315 Res : Iir_Signature; 4316 List : Iir_List; 4317 begin 4318 Expect (Tok_Left_Bracket); 4319 Res := Create_Iir (Iir_Kind_Signature); 4320 Set_Location (Res); 4321 4322 -- Skip '[' 4323 Scan; 4324 4325 -- List of type_marks. 4326 if Current_Token = Tok_Identifier then 4327 List := Create_Iir_List; 4328 loop 4329 Append_Element (List, Parse_Type_Mark (Check_Paren => True)); 4330 exit when Current_Token /= Tok_Comma; 4331 4332 -- Skip ','. 4333 Scan; 4334 end loop; 4335 Set_Type_Marks_List (Res, List_To_Flist (List)); 4336 end if; 4337 4338 if Current_Token = Tok_Return then 4339 -- Skip 'return' 4340 Scan; 4341 4342 Set_Return_Type_Mark (Res, Parse_Name); 4343 end if; 4344 4345 -- Skip ']' 4346 Expect (Tok_Right_Bracket); 4347 Scan; 4348 4349 return Res; 4350 end Parse_Signature; 4351 4352 -- precond : ALIAS 4353 -- postcond: next token 4354 -- 4355 -- [ LRM93 4.3.3 ] 4356 -- alias_declaration ::= 4357 -- ALIAS alias_designator [ : subtype_indication ] 4358 -- IS name [ signature ] ; 4359 -- 4360 -- [ LRM93 4.3.3 ] 4361 -- alias_designator ::= identifier | character_literal | operator_symbol 4362 -- 4363 -- FIXME: signature is not part of the node. 4364 function Parse_Alias_Declaration return Iir 4365 is 4366 Res: Iir; 4367 Ident : Name_Id; 4368 Start_Loc : Location_Type; 4369 begin 4370 Start_Loc := Get_Token_Location; 4371 4372 -- Skip 'alias'. 4373 pragma Assert (Current_Token = Tok_Alias); 4374 Scan; 4375 4376 Res := Create_Iir (Iir_Kind_Object_Alias_Declaration); 4377 Set_Location (Res); 4378 4379 case Current_Token is 4380 when Tok_Identifier 4381 | Tok_Character => 4382 Ident := Current_Identifier; 4383 4384 -- Skip identifier/character. 4385 Scan; 4386 when Tok_String => 4387 Ident := Scan_To_Operator_Name (Get_Token_Location); 4388 4389 -- Skip operator. 4390 Scan; 4391 -- FIXME: vhdl87 4392 -- FIXME: operator symbol. 4393 when others => 4394 Error_Msg_Parse ("alias designator expected"); 4395 Ident := Null_Identifier; 4396 end case; 4397 Set_Identifier (Res, Ident); 4398 4399 if Current_Token = Tok_Colon then 4400 -- Skip ':'. 4401 Scan; 4402 Set_Subtype_Indication (Res, Parse_Subtype_Indication); 4403 end if; 4404 4405 -- FIXME: nice message if token is ':=' ? 4406 Expect_Scan (Tok_Is); 4407 Set_Name (Res, Parse_Signature_Name); 4408 4409 if Flag_Elocations then 4410 Create_Elocations (Res); 4411 Set_Start_Location (Res, Start_Loc); 4412 end if; 4413 4414 -- Skip ';'. 4415 Scan_Semi_Colon_Declaration ("alias declaration"); 4416 4417 return Res; 4418 end Parse_Alias_Declaration; 4419 4420 -- precond : FOR 4421 -- postcond: next token. 4422 -- 4423 -- [ LRM93 5.2 ] 4424 -- configuration_specification ::= 4425 -- FOR component_specification binding_indication ; 4426 function Parse_Configuration_Specification 4427 return Iir_Configuration_Specification 4428 is 4429 Res : Iir_Configuration_Specification; 4430 begin 4431 Res := Create_Iir (Iir_Kind_Configuration_Specification); 4432 Set_Location (Res); 4433 4434 -- Eat 'for'. 4435 Expect_Scan (Tok_For); 4436 4437 Parse_Component_Specification (Res); 4438 Set_Binding_Indication (Res, Parse_Binding_Indication); 4439 4440 -- Skip ';'. 4441 Scan_Semi_Colon_Declaration ("configuration specification"); 4442 4443 return Res; 4444 end Parse_Configuration_Specification; 4445 4446 -- precond : next token 4447 -- postcond: next token 4448 -- 4449 -- [ LRM93 5.2 ] 4450 -- entity_class := ENTITY | ARCHITECTURE | CONFIGURATION | PROCEDURE 4451 -- | FUNCTION | PACKAGE | TYPE | SUBTYPE | CONSTANT 4452 -- | SIGNAL | VARIABLE | COMPONENT | LABEL | LITERAL 4453 -- | UNITS | GROUP | FILE 4454 function Parse_Entity_Class return Token_Type 4455 is 4456 Res : Token_Type; 4457 begin 4458 case Current_Token is 4459 when Tok_Entity 4460 | Tok_Architecture 4461 | Tok_Configuration 4462 | Tok_Procedure 4463 | Tok_Function 4464 | Tok_Package 4465 | Tok_Type 4466 | Tok_Subtype 4467 | Tok_Constant 4468 | Tok_Signal 4469 | Tok_Variable 4470 | Tok_Component 4471 | Tok_Label => 4472 null; 4473 when Tok_Literal 4474 | Tok_Units 4475 | Tok_Group 4476 | Tok_File => 4477 null; 4478 when others => 4479 Error_Msg_Parse ("%t is not a entity class", +Current_Token); 4480 end case; 4481 Res := Current_Token; 4482 Scan; 4483 return Res; 4484 end Parse_Entity_Class; 4485 4486 function Parse_Entity_Class_Entry return Iir_Entity_Class 4487 is 4488 Res : Iir_Entity_Class; 4489 begin 4490 Res := Create_Iir (Iir_Kind_Entity_Class); 4491 Set_Location (Res); 4492 Set_Entity_Class (Res, Parse_Entity_Class); 4493 return Res; 4494 end Parse_Entity_Class_Entry; 4495 4496 -- precond : next token 4497 -- postcond: next token 4498 -- 4499 -- [ LRM93 5.1 ] 4500 -- entity_designator ::= entity_tag [ signature ] 4501 -- 4502 -- entity_tag ::= simple_name | character_literal | operator_symbol 4503 function Parse_Entity_Designator return Iir 4504 is 4505 Res : Iir; 4506 Name : Iir; 4507 begin 4508 case Current_Token is 4509 when Tok_Identifier => 4510 Res := Create_Iir (Iir_Kind_Simple_Name); 4511 Set_Location (Res); 4512 Set_Identifier (Res, Current_Identifier); 4513 when Tok_Character => 4514 Res := Create_Iir (Iir_Kind_Character_Literal); 4515 Set_Location (Res); 4516 Set_Identifier (Res, Current_Identifier); 4517 when Tok_String => 4518 Res := Create_Iir (Iir_Kind_Operator_Symbol); 4519 Set_Location (Res); 4520 Set_Identifier (Res, Scan_To_Operator_Name (Get_Token_Location)); 4521 when others => 4522 Error_Msg_Parse ("identifier, character or string expected"); 4523 return Create_Error_Node; 4524 end case; 4525 Scan; 4526 if Current_Token = Tok_Left_Bracket then 4527 Name := Res; 4528 Res := Parse_Signature; 4529 Set_Signature_Prefix (Res, Name); 4530 end if; 4531 return Res; 4532 end Parse_Entity_Designator; 4533 4534 -- precond : next token 4535 -- postcond: IS 4536 -- 4537 -- [ LRM93 5.1 ] 4538 -- entity_name_list ::= entity_designator { , entity_designator } 4539 -- | OTHERS 4540 -- | ALL 4541 procedure Parse_Entity_Name_List 4542 (Attribute : Iir_Attribute_Specification) 4543 is 4544 List : Iir_List; 4545 Flist : Iir_Flist; 4546 El : Iir; 4547 begin 4548 case Current_Token is 4549 when Tok_All => 4550 Flist := Iir_Flist_All; 4551 4552 -- Skip 'all'. 4553 Scan; 4554 4555 when Tok_Others => 4556 Flist := Iir_Flist_Others; 4557 4558 -- Skip 'others'. 4559 Scan; 4560 4561 when others => 4562 List := Create_Iir_List; 4563 loop 4564 El := Parse_Entity_Designator; 4565 Append_Element (List, El); 4566 exit when Current_Token /= Tok_Comma; 4567 Scan; 4568 end loop; 4569 Flist := List_To_Flist (List); 4570 end case; 4571 Set_Entity_Name_List (Attribute, Flist); 4572 if Current_Token = Tok_Colon then 4573 Scan; 4574 Set_Entity_Class (Attribute, Parse_Entity_Class); 4575 else 4576 Error_Msg_Parse 4577 ("missing ':' and entity kind in attribute specification"); 4578 end if; 4579 end Parse_Entity_Name_List; 4580 4581 -- precond : ATTRIBUTE 4582 -- postcond: next token 4583 -- 4584 -- [ 4.4 ] 4585 -- attribute_declaration ::= ATTRIBUTE identifier : type_mark ; 4586 -- 4587 -- [ 5.1 ] 4588 -- attribute_specification ::= 4589 -- ATTRIBUTE attribute_designator OF entity_specification 4590 -- IS expression ; 4591 -- 4592 -- entity_specification ::= entity_name_list : entity_class 4593 -- 4594 function Parse_Attribute return Iir 4595 is 4596 Ident : Name_Id; 4597 Res : Iir; 4598 Designator : Iir; 4599 Loc, Start_Loc : Location_Type; 4600 begin 4601 Start_Loc := Get_Token_Location; 4602 4603 -- Eat 'attribute'. 4604 pragma Assert (Current_Token = Tok_Attribute); 4605 Scan; 4606 4607 Loc := Get_Token_Location; 4608 if Current_Token = Tok_Identifier then 4609 Ident := Current_Identifier; 4610 4611 -- Skip identifier. 4612 Scan; 4613 else 4614 Expect (Tok_Identifier); 4615 Ident := Null_Identifier; 4616 end if; 4617 4618 case Current_Token is 4619 when Tok_Colon => 4620 Res := Create_Iir (Iir_Kind_Attribute_Declaration); 4621 Set_Location (Res, Loc); 4622 Set_Identifier (Res, Ident); 4623 4624 -- Skip ':'. 4625 Scan; 4626 4627 Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True)); 4628 Scan_Semi_Colon_Declaration ("attribute declaration"); 4629 4630 when Tok_Of => 4631 Res := Create_Iir (Iir_Kind_Attribute_Specification); 4632 Set_Location (Res, Loc); 4633 Designator := Create_Iir (Iir_Kind_Simple_Name); 4634 Set_Location (Designator, Loc); 4635 Set_Identifier (Designator, Ident); 4636 Set_Attribute_Designator (Res, Designator); 4637 4638 -- Skip 'of'. 4639 Scan; 4640 4641 Parse_Entity_Name_List (Res); 4642 4643 -- Skip 'is'. 4644 Expect_Scan (Tok_Is); 4645 4646 Set_Expression (Res, Parse_Expression); 4647 Scan_Semi_Colon_Declaration ("attribute specification"); 4648 4649 when others => 4650 Error_Msg_Parse ("':' or 'of' expected after identifier"); 4651 return Null_Iir; 4652 end case; 4653 4654 if Flag_Elocations then 4655 Create_Elocations (Res); 4656 Set_Start_Location (Res, Start_Loc); 4657 end if; 4658 4659 return Res; 4660 end Parse_Attribute; 4661 4662 -- precond : GROUP 4663 -- postcond: ';' 4664 -- 4665 -- [ LRM93 4.6 ] 4666 -- group_template_declaration ::= 4667 -- GROUP identifier IS (entity_class_entry_list) ; 4668 -- 4669 -- entity_class_entry_list ::= entity_class_entry { , entity_class_entry } 4670 -- 4671 -- entity_class_entry ::= entity_class [ <> ] 4672 function Parse_Group return Iir 4673 is 4674 Loc : Location_Type; 4675 Ident : Name_Id; 4676 begin 4677 -- Skip 'group'. 4678 pragma Assert (Current_Token = Tok_Group); 4679 Scan; 4680 4681 Loc := Get_Token_Location; 4682 if Current_Token = Tok_Identifier then 4683 Ident := Current_Identifier; 4684 4685 -- Skip 'group'. 4686 Scan; 4687 else 4688 Ident := Null_Identifier; 4689 Expect (Tok_Identifier); 4690 end if; 4691 4692 case Current_Token is 4693 when Tok_Is => 4694 declare 4695 Res : Iir_Group_Template_Declaration; 4696 El : Iir_Entity_Class; 4697 First, Last : Iir_Entity_Class; 4698 begin 4699 Res := Create_Iir (Iir_Kind_Group_Template_Declaration); 4700 Set_Location (Res, Loc); 4701 Set_Identifier (Res, Ident); 4702 4703 -- Skip 'is'. 4704 Scan; 4705 4706 -- Skip '('. 4707 Expect_Scan (Tok_Left_Paren); 4708 4709 Chain_Init (First, Last); 4710 loop 4711 Chain_Append (First, Last, Parse_Entity_Class_Entry); 4712 if Current_Token = Tok_Box then 4713 El := Create_Iir (Iir_Kind_Entity_Class); 4714 Set_Location (El); 4715 Set_Entity_Class (El, Tok_Box); 4716 Chain_Append (First, Last, El); 4717 4718 -- Skip '<>'. 4719 Scan; 4720 4721 if Current_Token = Tok_Comma then 4722 Error_Msg_Parse 4723 ("'<>' is allowed only for the last " 4724 & "entity class entry"); 4725 end if; 4726 end if; 4727 exit when Current_Token /= Tok_Comma; 4728 4729 -- Skip ','. 4730 Scan; 4731 end loop; 4732 Set_Entity_Class_Entry_Chain (Res, First); 4733 4734 -- Skip ')' ';' 4735 Expect_Scan (Tok_Right_Paren); 4736 Scan_Semi_Colon_Declaration ("group template"); 4737 4738 return Res; 4739 end; 4740 when Tok_Colon => 4741 declare 4742 Res : Iir_Group_Declaration; 4743 List : Iir_List; 4744 begin 4745 Res := Create_Iir (Iir_Kind_Group_Declaration); 4746 Set_Location (Res, Loc); 4747 Set_Identifier (Res, Ident); 4748 4749 -- Skip ':'. 4750 Scan; 4751 4752 Set_Group_Template_Name 4753 (Res, Parse_Name (Allow_Indexes => False)); 4754 4755 -- Skip '('. 4756 Expect_Scan (Tok_Left_Paren); 4757 4758 List := Create_Iir_List; 4759 loop 4760 Append_Element (List, Parse_Name (Allow_Indexes => False)); 4761 exit when Current_Token /= Tok_Comma; 4762 4763 -- Skip ','. 4764 Scan; 4765 end loop; 4766 4767 -- Skip ')' ';'. 4768 Expect_Scan (Tok_Right_Paren); 4769 Scan_Semi_Colon_Declaration ("group declaration"); 4770 4771 Set_Group_Constituent_List (Res, List_To_Flist (List)); 4772 return Res; 4773 end; 4774 when others => 4775 Error_Msg_Parse ("':' or 'is' expected here"); 4776 return Null_Iir; 4777 end case; 4778 end Parse_Group; 4779 4780 -- precond : next token 4781 -- postcond: ':' 4782 -- 4783 -- LRM93 5.4 4784 -- signal_list ::= signal_name { , signal_name } 4785 -- | OTHERS 4786 -- | ALL 4787 -- 4788 -- AMS-LRM17 7.5 Step limit specification 4789 -- quantity_list ::= 4790 -- quantity_name { , quantity_name } 4791 -- | others 4792 -- | all 4793 function Parse_Name_List return Iir_Flist 4794 is 4795 Res : Iir_List; 4796 begin 4797 case Current_Token is 4798 when Tok_Others => 4799 -- Skip 'others'. 4800 Scan; 4801 4802 return Iir_Flist_Others; 4803 4804 when Tok_All => 4805 -- Skip 'all'. 4806 Scan; 4807 4808 return Iir_Flist_All; 4809 4810 when others => 4811 Res := Create_Iir_List; 4812 loop 4813 Append_Element (Res, Parse_Name); 4814 exit when Current_Token /= Tok_Comma; 4815 4816 -- Skip ',' 4817 Scan; 4818 end loop; 4819 4820 return List_To_Flist (Res); 4821 end case; 4822 end Parse_Name_List; 4823 4824 -- precond : DISCONNECT 4825 -- postcond: next token. 4826 -- 4827 -- [ LRM93 5.4 ] 4828 -- disconnection_specification ::= 4829 -- DISCONNECT guarded_signal_specification AFTER time_expression ; 4830 function Parse_Disconnection_Specification 4831 return Iir_Disconnection_Specification 4832 is 4833 Res : Iir_Disconnection_Specification; 4834 begin 4835 pragma Assert (Current_Token = Tok_Disconnect); 4836 4837 Res := Create_Iir (Iir_Kind_Disconnection_Specification); 4838 Set_Location (Res); 4839 4840 -- Skip 'disconnect' 4841 Scan; 4842 4843 Set_Signal_List (Res, Parse_Name_List); 4844 4845 -- Skip ':' 4846 Expect_Scan (Tok_Colon); 4847 4848 Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True)); 4849 4850 -- Skip 'after' 4851 Expect_Scan (Tok_After); 4852 4853 Set_Expression (Res, Parse_Expression); 4854 4855 -- Skip ';'. 4856 Scan_Semi_Colon_Declaration ("disconnection specification"); 4857 4858 return Res; 4859 end Parse_Disconnection_Specification; 4860 4861 -- precond : LIMIT 4862 -- postcond: next token. 4863 -- 4864 -- AMS-LRM17 7.5 Step limit specification 4865 -- step_limit_specification ::= 4866 -- LIMIT quantity_specification WITH real_expression ; 4867 function Parse_Step_Limit_Specification return Iir 4868 is 4869 Res : Iir; 4870 begin 4871 pragma Assert (Current_Token = Tok_Limit); 4872 4873 Res := Create_Iir (Iir_Kind_Step_Limit_Specification); 4874 Set_Location (Res); 4875 4876 -- Skip 'limit' 4877 Scan; 4878 4879 Set_Quantity_List (Res, Parse_Name_List); 4880 4881 -- Skip ':' 4882 Expect_Scan (Tok_Colon); 4883 4884 Set_Type_Mark (Res, Parse_Type_Mark (Check_Paren => True)); 4885 4886 -- Skip 'with' 4887 Expect_Scan (Tok_With); 4888 4889 Set_Expression (Res, Parse_Expression); 4890 4891 -- Skip ';'. 4892 Scan_Semi_Colon_Declaration ("step limit specification"); 4893 4894 return Res; 4895 end Parse_Step_Limit_Specification; 4896 4897 -- Parse PSL clock_declaration at 'clock'. 4898 function Parse_Psl_Default_Clock_Cont 4899 (Loc : Location_Type; Flag_Psl : Boolean) return Iir 4900 is 4901 Res : Iir; 4902 begin 4903 Res := Create_Iir (Iir_Kind_Psl_Default_Clock); 4904 Set_Location (Res, Loc); 4905 Xrefs.Xref_Keyword (Get_Token_Location); 4906 4907 -- Recognize PSL keywords. 4908 Vhdl.Scanner.Flag_Psl := True; 4909 4910 -- Skip 'clock'. 4911 Expect_Scan (Tok_Psl_Clock); 4912 4913 -- Skip 'is'. 4914 Expect_Scan (Tok_Is); 4915 4916 Set_Psl_Boolean (Res, Parse_Psl.Parse_Psl_Boolean); 4917 4918 Vhdl.Scanner.Flag_Scan_In_Comment := False; 4919 Vhdl.Scanner.Flag_Psl := Flag_Psl; 4920 4921 Expect_Scan (Tok_Semi_Colon); 4922 4923 return Res; 4924 end Parse_Psl_Default_Clock_Cont; 4925 4926 -- 1850-2005 A.4.2 PSL declarations 4927 -- clock_declaration ::= DEFAULT CLOCK IS clock_expression ; 4928 function Parse_Psl_Default_Clock (Flag_Psl : Boolean) return Iir 4929 is 4930 Loc : Location_Type; 4931 begin 4932 Loc := Get_Token_Location; 4933 4934 -- Recognize PSL keywords. 4935 Vhdl.Scanner.Flag_Psl := True; 4936 4937 -- Skip 'default'. 4938 Scan; 4939 4940 return Parse_Psl_Default_Clock_Cont (Loc, Flag_Psl); 4941 end Parse_Psl_Default_Clock; 4942 4943 function Parse_Psl_Declaration return Iir 4944 is 4945 Tok : constant Token_Type := Current_Token; 4946 Loc : constant Location_Type := Get_Token_Location; 4947 Res : Iir; 4948 Decl : PSL_Node; 4949 Id : Name_Id; 4950 begin 4951 -- Skip 'property', 'sequence' or 'endpoint'. 4952 Scan; 4953 4954 if Current_Token /= Tok_Identifier then 4955 Error_Msg_Parse ("declaration name expected here"); 4956 Id := Null_Identifier; 4957 else 4958 Id := Current_Identifier; 4959 end if; 4960 4961 -- Parse PSL declaration. 4962 Vhdl.Scanner.Flag_Psl := True; 4963 Decl := Parse_Psl.Parse_Psl_Declaration (Tok); 4964 Vhdl.Scanner.Flag_Scan_In_Comment := False; 4965 Vhdl.Scanner.Flag_Psl := False; 4966 4967 Expect_Scan (Tok_Semi_Colon); 4968 4969 if Tok = Tok_Psl_Endpoint 4970 and then Parse_Psl.Is_Instantiated_Declaration (Decl) 4971 then 4972 -- Instantiated endpoint: make it visible from VHDL. 4973 Res := Create_Iir (Iir_Kind_Psl_Endpoint_Declaration); 4974 else 4975 -- Otherwise, it will be visible only from PSL. 4976 Res := Create_Iir (Iir_Kind_Psl_Declaration); 4977 end if; 4978 Set_Location (Res, Loc); 4979 Set_Identifier (Res, Id); 4980 Set_Psl_Declaration (Res, Decl); 4981 4982 return Res; 4983 end Parse_Psl_Declaration; 4984 4985 -- precond : next token 4986 -- postcond: next token 4987 -- 4988 -- [ LRM08 3.2.3 Entity declarative part ] 4989 -- entity_declarative_item ::= 4990 -- subprogram_declaration 4991 -- | subprogram_body 4992 -- | subprogram_instantiation_declaration 4993 -- | package_declaration 4994 -- | package_body 4995 -- | package_instantiation_declaration 4996 -- | type_declaration 4997 -- | subtype_declaration 4998 -- | constant_declaration 4999 -- | signal_declaration 5000 -- | shared_variable_declaration 5001 -- | file_declaration 5002 -- | alias_declaration 5003 -- | attribute_declaration 5004 -- | attribute_specification 5005 -- | disconnection_specification 5006 -- | use_clause 5007 -- | group_template_declaration 5008 -- | group_declaration 5009 -- | PSL_property_declaration 5010 -- | PSL_sequence_declaration 5011 -- | PSL_clock_declaration 5012 -- 5013 -- [ LRM08 3.3.2 Architecture declarative part ] 5014 -- block_declarative_item ::= 5015 -- subprogram_declaration 5016 -- | subprogram_body 5017 -- | subprogram_instantiation_declaration 5018 -- | package_declaration 5019 -- | package_body 5020 -- | package_instantiation_declaration 5021 -- | type_declaration 5022 -- | subtype_declaration 5023 -- | constant_declaration 5024 -- | signal_declaration 5025 -- | shared_variable_declaration 5026 -- | file_declaration 5027 -- | alias_declaration 5028 -- | component_declaration 5029 -- | attribute_declaration 5030 -- | attribute_specification 5031 -- | configuration_specification 5032 -- | disconnection_specification 5033 -- | use_clause 5034 -- | group_template_declaration 5035 -- | group_declaration 5036 -- | PSL_property_declaration 5037 -- | PSL_sequence_declaration 5038 -- | PSL_clock_declaration 5039 -- 5040 -- [ LRM08 4.3 Subprogram bodies ] 5041 -- subprogram_declarative_item ::= 5042 -- subprogram_declaration 5043 -- | subprogram_body 5044 -- | subprogram_instantiation_declaration 5045 -- | package_declaration 5046 -- | package_body 5047 -- | package_instantiation_declaration 5048 -- | type_declaration 5049 -- | subtype_declaration 5050 -- | constant_declaration 5051 -- | variable_declaration 5052 -- | file_declaration 5053 -- | alias_declaration 5054 -- | attribute_declaration 5055 -- | attribute_specification 5056 -- | use_clause 5057 -- | group_template_declaration 5058 -- | group_declaration 5059 -- 5060 -- [ LRM08 4.7 Package declarations ] 5061 -- package_declarative_item ::= 5062 -- subprogram_declaration 5063 -- | subprogram_instantiation_declaration 5064 -- | package_declaration 5065 -- | package_instantiation_declaration 5066 -- | type_declaration 5067 -- | subtype_declaration 5068 -- | constant_declaration 5069 -- | signal_declaration 5070 -- | variable_declaration 5071 -- | file_declaraton 5072 -- | alias_declaration 5073 -- | component_declaration 5074 -- | attribute_declaration 5075 -- | attribute_specification 5076 -- | disconnection_specification 5077 -- | use_clause 5078 -- | group_template_declaration 5079 -- | group_declaration 5080 -- | PSL_property_declaration 5081 -- | PSL_sequence_declaration 5082 -- 5083 -- [ LRM08 4.8 Package bodies ] 5084 -- package_body_declarative_item ::= 5085 -- subprogram_declaration 5086 -- | subprogram_body 5087 -- | subprogram_instantiation_declaration 5088 -- | package_declaration 5089 -- | package_body 5090 -- | package_instantiation_declaration 5091 -- | type_declaration 5092 -- | subtype_declaration 5093 -- | constant_declaration 5094 -- | variable_declaration 5095 -- | file_declaration 5096 -- | alias_declaration 5097 -- | attribute_declaration 5098 -- | attribute_specification 5099 -- | use_clause 5100 -- | group_template_declaration 5101 -- | group_declaration 5102 -- 5103 -- [ LRM08 5.6.2 Protected type declarations ] 5104 -- protected_type_declarative_item ::= 5105 -- subprogram_declaration 5106 -- | subprogram_instantiation_declaration 5107 -- | attribute_specification 5108 -- | use_clause 5109 -- 5110 -- [ LRM08 5.6.3 Protected type bodies ] 5111 -- protected_type_body_declarative_item ::= 5112 -- subprogram_declaration 5113 -- | subprogram_body 5114 -- | subprogram_instantiation_declaration 5115 -- | package_declaration 5116 -- | package_body 5117 -- | package_instantiation_declaration 5118 -- | type_declaration 5119 -- | subtype_declaration 5120 -- | constant_declaration 5121 -- | variable_declaration 5122 -- | file_declaration 5123 -- | alias_declaration 5124 -- | attribute_declaration 5125 -- | attribute_specification 5126 -- | use_clause 5127 -- | group_template_declaration 5128 -- | group_declaration 5129 -- 5130 -- [ LRM08 11.3 Process statement ] 5131 -- process_declarative_item ::= 5132 -- subprogram_declaration 5133 -- | subprogram_body 5134 -- | subprogram_instantiation_declaration 5135 -- | package_declaration 5136 -- | package_body 5137 -- | package_instantiation_declaration 5138 -- | type_declaration 5139 -- | subtype_declaration 5140 -- | constant_declaration 5141 -- | variable_declaration 5142 -- | file_declaration 5143 -- | alias_declaration 5144 -- | attribute_declaration 5145 -- | attribute_specification 5146 -- | use_clause 5147 -- | group_template_declaration 5148 -- | group_declaration 5149 -- 5150 -- Some declarations are not allowed in every declarative part: 5151 -- - subprogram_body, package_body: 5152 -- not in package_declaration 5153 -- - signal_declaration, disconnection_specification: 5154 -- not in process, protected_type_body, package_body, subprogram 5155 -- - variable_declaration: 5156 -- shared in entity, block (*) 5157 -- not shared in subprogram, protected_type_body, process 5158 -- depends on parent for package and package_body 5159 -- - component_declaration: 5160 -- not in entity, subprogram, package_body, protected_type_body, 5161 -- process 5162 -- depends on parent for package 5163 -- - configuration_specification: 5164 -- not in entity, subprogram, package, package_body, protected_type_body, 5165 -- process 5166 -- - PSL_property_declaration, PSL_sequence_declaration: 5167 -- in entity and block (*) 5168 -- depends on parent for package 5169 -- - PSL_clock_declaration: 5170 -- in block (*) 5171 -- 5172 -- Declarations for protected_type_declaration are handled in sem. 5173 -- 5174 -- (*): block means block_declarative_item, ie: block_statement, 5175 -- architecture_body and generate_statement) 5176 -- 5177 -- PACKAGE_PARENT is the parent for nested packages. 5178 function Parse_Declaration (Parent : Iir; Package_Parent : Iir) return Iir 5179 is 5180 Decl : Iir; 5181 begin 5182 Decl := Null_Iir; 5183 case Current_Token is 5184 when Tok_Invalid => 5185 raise Internal_Error; 5186 when Tok_Type => 5187 Decl := Parse_Type_Declaration (Parent); 5188 5189 -- LRM 2.5 Package declarations 5190 -- If a package declarative item is a type declaration that is 5191 -- a full type declaration whose type definition is a 5192 -- protected_type definition, then that protected type 5193 -- definition must not be a protected type body. 5194 if Decl /= Null_Iir 5195 and then Get_Kind (Decl) = Iir_Kind_Protected_Type_Body 5196 then 5197 case Get_Kind (Parent) is 5198 when Iir_Kind_Package_Declaration => 5199 Error_Msg_Parse (+Decl, "protected type body not " 5200 & "allowed in package declaration"); 5201 when others => 5202 null; 5203 end case; 5204 end if; 5205 when Tok_Subtype => 5206 Decl := Parse_Subtype_Declaration (Parent); 5207 when Tok_Nature => 5208 Decl := Parse_Nature_Declaration; 5209 when Tok_Subnature => 5210 Decl := Parse_Subnature_Declaration; 5211 when Tok_Terminal => 5212 Decl := Parse_Terminal_Declaration (Parent); 5213 when Tok_Quantity => 5214 Decl := Parse_Quantity_Declaration (Parent); 5215 when Tok_Signal => 5216 -- LRM08 4.7 Package declarations 5217 -- For package declaration that appears in a subprogram body, 5218 -- a process statement, or a protected type body, [...] 5219 -- Moreover, it is an eror if [...] a signal declaration [...] 5220 -- appears as a package declarative item of such a package 5221 -- declaration. 5222 case Get_Kind (Package_Parent) is 5223 when Iir_Kind_Function_Body 5224 | Iir_Kind_Procedure_Body => 5225 Error_Msg_Parse 5226 ("signal declaration not allowed in subprogram body"); 5227 when Iir_Kinds_Process_Statement => 5228 Error_Msg_Parse 5229 ("signal declaration not allowed in process"); 5230 when Iir_Kind_Protected_Type_Body 5231 | Iir_Kind_Protected_Type_Declaration => 5232 Error_Msg_Parse 5233 ("signal declaration not allowed in protected type"); 5234 when Iir_Kind_Entity_Declaration 5235 | Iir_Kind_Architecture_Body 5236 | Iir_Kind_Block_Statement 5237 | Iir_Kind_Generate_Statement_Body 5238 | Iir_Kind_Package_Declaration 5239 | Iir_Kind_Package_Body 5240 | Iir_Kind_Vunit_Declaration => 5241 if Get_Kind (Parent) = Iir_Kind_Package_Body then 5242 Error_Msg_Parse 5243 ("signal declaration not allowed in package body"); 5244 end if; 5245 when Iir_Kind_Simultaneous_Procedural_Statement => 5246 Error_Msg_Parse 5247 ("signal declaration not allowed in procedural statement"); 5248 when others => 5249 Error_Kind ("parse_declaration(1)", Package_Parent); 5250 end case; 5251 Decl := Parse_Object_Declaration (Parent); 5252 when Tok_Constant => 5253 Decl := Parse_Object_Declaration (Parent); 5254 when Tok_Variable => 5255 -- LRM93 4.3.1.3 Variable declarations 5256 -- Variable declared immediatly within entity declarations, 5257 -- architectures bodies, packages, packages bodies, and blocks 5258 -- must be shared variable. 5259 -- Variables declared immediatly within subprograms and 5260 -- processes must not be shared variables. 5261 -- Variables may appear in protected type bodies; such 5262 -- variables, which must not be shared variables, represent 5263 -- shared data. 5264 case Get_Kind (Package_Parent) is 5265 when Iir_Kind_Entity_Declaration 5266 | Iir_Kind_Architecture_Body 5267 | Iir_Kind_Block_Statement 5268 | Iir_Kind_Generate_Statement_Body 5269 | Iir_Kind_Package_Declaration 5270 | Iir_Kind_Package_Body 5271 | Iir_Kind_Protected_Type_Declaration => 5272 -- FIXME: replace HERE with the kind of declaration 5273 -- ie: "not allowed in a package" rather than "here". 5274 Error_Msg_Parse 5275 ("non-shared variable declaration not allowed here"); 5276 when Iir_Kind_Function_Body 5277 | Iir_Kind_Procedure_Body 5278 | Iir_Kinds_Process_Statement 5279 | Iir_Kind_Protected_Type_Body 5280 | Iir_Kind_Simultaneous_Procedural_Statement => 5281 null; 5282 when others => 5283 Error_Kind ("parse_declaration(2)", Package_Parent); 5284 end case; 5285 Decl := Parse_Object_Declaration (Parent); 5286 when Tok_Shared => 5287 if Flags.Vhdl_Std <= Vhdl_87 then 5288 Error_Msg_Parse ("shared variable not allowed in vhdl 87"); 5289 end if; 5290 -- LRM08 4.7 Package declarations 5291 -- For package declaration that appears in a subprogram body, 5292 -- a process statement, or a protected type body, it is an 5293 -- error if a variable declaration in the package declaratie 5294 -- part of the package declaration declares a shared variable. 5295 5296 -- LRM08 4.8 Package bodies 5297 -- For a package body that appears in a subprogram body, a 5298 -- process statement or a protected type body, it is an error 5299 -- if a variable declaration in the package body declarative 5300 -- part of the package body declares a shared variable. 5301 5302 -- LRM93 4.3.1.3 Variable declarations 5303 -- Variable declared immediatly within entity declarations, 5304 -- architectures bodies, packages, packages bodies, and blocks 5305 -- must be shared variable. 5306 -- Variables declared immediatly within subprograms and 5307 -- processes must not be shared variables. 5308 -- Variables may appear in proteted type bodies; such 5309 -- variables, which must not be shared variables, represent 5310 -- shared data. 5311 case Get_Kind (Package_Parent) is 5312 when Iir_Kind_Entity_Declaration 5313 | Iir_Kind_Architecture_Body 5314 | Iir_Kind_Block_Statement 5315 | Iir_Kind_Generate_Statement_Body 5316 | Iir_Kind_Package_Declaration 5317 | Iir_Kind_Package_Body 5318 | Iir_Kind_Protected_Type_Declaration => 5319 null; 5320 when Iir_Kind_Function_Body 5321 | Iir_Kind_Procedure_Body 5322 | Iir_Kinds_Process_Statement 5323 | Iir_Kind_Protected_Type_Body 5324 | Iir_Kind_Simultaneous_Procedural_Statement => 5325 Error_Msg_Parse 5326 ("shared variable declaration not allowed here"); 5327 when others => 5328 Error_Kind ("parse_declarative_part(3)", Package_Parent); 5329 end case; 5330 Decl := Parse_Object_Declaration (Parent); 5331 when Tok_File => 5332 Decl := Parse_Object_Declaration (Parent); 5333 when Tok_Function 5334 | Tok_Procedure 5335 | Tok_Pure 5336 | Tok_Impure => 5337 Decl := Parse_Subprogram_Declaration; 5338 if Decl /= Null_Iir 5339 and then Get_Kind (Decl) in Iir_Kinds_Subprogram_Declaration 5340 and then Get_Subprogram_Body (Decl) /= Null_Iir 5341 then 5342 if Get_Kind (Parent) = Iir_Kind_Package_Declaration then 5343 Error_Msg_Parse 5344 (+Decl, "subprogram body not allowed in a package"); 5345 end if; 5346 end if; 5347 when Tok_Alias => 5348 Decl := Parse_Alias_Declaration; 5349 when Tok_Component => 5350 case Get_Kind (Parent) is 5351 when Iir_Kind_Entity_Declaration 5352 | Iir_Kind_Procedure_Body 5353 | Iir_Kind_Function_Body 5354 | Iir_Kinds_Process_Statement 5355 | Iir_Kind_Package_Body 5356 | Iir_Kind_Protected_Type_Body 5357 | Iir_Kind_Protected_Type_Declaration 5358 | Iir_Kind_Simultaneous_Procedural_Statement => 5359 Error_Msg_Parse 5360 ("component declaration are not allowed here"); 5361 when Iir_Kind_Architecture_Body 5362 | Iir_Kind_Block_Statement 5363 | Iir_Kind_Generate_Statement_Body 5364 | Iir_Kind_Package_Declaration => 5365 null; 5366 when others => 5367 Error_Kind ("parse_declarative_part(4)", Parent); 5368 end case; 5369 Decl := Parse_Component_Declaration; 5370 when Tok_For => 5371 case Get_Kind (Parent) is 5372 when Iir_Kind_Entity_Declaration 5373 | Iir_Kind_Function_Body 5374 | Iir_Kind_Procedure_Body 5375 | Iir_Kinds_Process_Statement 5376 | Iir_Kind_Package_Declaration 5377 | Iir_Kind_Package_Body 5378 | Iir_Kind_Protected_Type_Body 5379 | Iir_Kind_Protected_Type_Declaration 5380 | Iir_Kind_Simultaneous_Procedural_Statement => 5381 Error_Msg_Parse 5382 ("configuration specification not allowed here"); 5383 when Iir_Kind_Architecture_Body 5384 | Iir_Kind_Block_Statement 5385 | Iir_Kind_Generate_Statement_Body => 5386 null; 5387 when others => 5388 Error_Kind ("parse_declarative_part(5)", Parent); 5389 end case; 5390 Decl := Parse_Configuration_Specification; 5391 when Tok_Attribute => 5392 Decl := Parse_Attribute; 5393 when Tok_Disconnect => 5394 -- LRM08 4.7 Package declarations 5395 -- For package declaration that appears in a subprogram body, 5396 -- a process statement, or a protected type body, [...] 5397 -- Moreover, it is an eror if [...] a disconnection 5398 -- specification [...] appears as a package declarative item 5399 -- of such a package declaration. 5400 case Get_Kind (Parent) is 5401 when Iir_Kind_Function_Body 5402 | Iir_Kind_Procedure_Body 5403 | Iir_Kinds_Process_Statement 5404 | Iir_Kind_Protected_Type_Body 5405 | Iir_Kind_Package_Body 5406 | Iir_Kind_Protected_Type_Declaration 5407 | Iir_Kind_Simultaneous_Procedural_Statement => 5408 Error_Msg_Parse 5409 ("disconnect specification not allowed here"); 5410 when Iir_Kind_Entity_Declaration 5411 | Iir_Kind_Architecture_Body 5412 | Iir_Kind_Block_Statement 5413 | Iir_Kind_Generate_Statement_Body 5414 | Iir_Kind_Package_Declaration => 5415 null; 5416 when others => 5417 Error_Kind ("parse_declaration(6)", Parent); 5418 end case; 5419 Decl := Parse_Disconnection_Specification; 5420 when Tok_Limit => 5421 Decl := Parse_Step_Limit_Specification; 5422 when Tok_Use => 5423 Decl := Parse_Use_Clause; 5424 when Tok_Group => 5425 Decl := Parse_Group; 5426 when Tok_Package => 5427 if Vhdl_Std < Vhdl_08 then 5428 Error_Msg_Parse ("nested package not allowed before vhdl 2008"); 5429 end if; 5430 Decl := Parse_Package (Parent); 5431 if Decl /= Null_Iir 5432 and then Get_Kind (Decl) = Iir_Kind_Package_Body 5433 then 5434 if Get_Kind (Parent) = Iir_Kind_Package_Declaration then 5435 Error_Msg_Parse 5436 (+Decl, "package body not allowed in a package"); 5437 end if; 5438 end if; 5439 5440 if Current_Token = Tok_Semi_Colon then 5441 -- Skip ';'. 5442 Scan; 5443 end if; 5444 when Tok_Default => 5445 -- This identifier is a PSL keyword. 5446 Xrefs.Xref_Keyword (Get_Token_Location); 5447 5448 -- Check whether default clock are allowed in this region. 5449 case Get_Kind (Parent) is 5450 when Iir_Kind_Function_Body 5451 | Iir_Kind_Procedure_Body 5452 | Iir_Kinds_Process_Statement 5453 | Iir_Kind_Protected_Type_Body 5454 | Iir_Kind_Package_Declaration 5455 | Iir_Kind_Package_Body 5456 | Iir_Kind_Protected_Type_Declaration 5457 | Iir_Kind_Simultaneous_Procedural_Statement => 5458 Error_Msg_Parse 5459 ("PSL default clock declaration not allowed here"); 5460 when Iir_Kind_Entity_Declaration 5461 | Iir_Kind_Architecture_Body 5462 | Iir_Kind_Block_Statement 5463 | Iir_Kind_Generate_Statement_Body 5464 | Iir_Kinds_Verification_Unit => 5465 null; 5466 when others => 5467 Error_Kind ("parse_declaration(7)", Parent); 5468 end case; 5469 Decl := Parse_Psl_Default_Clock (False); 5470 when Tok_Identifier => 5471 Error_Msg_Parse 5472 ("object class keyword such as 'variable' is expected"); 5473 Resync_To_End_Of_Declaration; 5474 when Tok_Semi_Colon => 5475 Error_Msg_Parse ("';' (semi colon) not allowed alone"); 5476 Scan; 5477 when Tok_Is => 5478 Error_Msg_Parse ("duplicate 'is' in declarative part"); 5479 Scan; 5480 when others => 5481 null; 5482 end case; 5483 return Decl; 5484 end Parse_Declaration; 5485 5486 procedure Parse_Declarative_Part (Parent : Iir; Package_Parent : Iir) 5487 is 5488 Last_Decl : Iir; 5489 Decl : Iir; 5490 begin 5491 Last_Decl := Null_Iir; 5492 loop 5493 Decl := Parse_Declaration (Parent, Package_Parent); 5494 exit when Decl = Null_Iir; 5495 loop 5496 Set_Parent (Decl, Parent); 5497 if Last_Decl = Null_Iir then 5498 Set_Declaration_Chain (Parent, Decl); 5499 else 5500 Set_Chain (Last_Decl, Decl); 5501 end if; 5502 Last_Decl := Decl; 5503 Decl := Get_Chain (Decl); 5504 exit when Decl = Null_Iir; 5505 end loop; 5506 end loop; 5507 end Parse_Declarative_Part; 5508 5509 -- precond : ENTITY 5510 -- postcond: next token. 5511 -- 5512 -- [ LRM93 1.1 ] 5513 -- entity_declaration ::= 5514 -- ENTITY identifier IS 5515 -- entiy_header 5516 -- entity_declarative_part 5517 -- [ BEGIN 5518 -- entity_statement_part ] 5519 -- END [ ENTITY ] [ ENTITY_simple_name ] 5520 -- 5521 -- [ LRM93 1.1.1 ] 5522 -- entity_header ::= 5523 -- [ FORMAL_generic_clause ] 5524 -- [ FORMAL_port_clause ] 5525 procedure Parse_Entity_Declaration (Unit : Iir_Design_Unit) 5526 is 5527 Res: Iir_Entity_Declaration; 5528 Start_Loc : Location_Type; 5529 Begin_Loc : Location_Type; 5530 End_Loc : Location_Type; 5531 begin 5532 Expect (Tok_Entity); 5533 Res := Create_Iir (Iir_Kind_Entity_Declaration); 5534 Start_Loc := Get_Token_Location; 5535 5536 if Flag_Elocations then 5537 Create_Elocations (Res); 5538 Set_Start_Location (Res, Start_Loc); 5539 end if; 5540 5541 -- Skip 'entity'. 5542 pragma Assert (Current_Token = Tok_Entity); 5543 Scan; 5544 5545 -- Get identifier. 5546 Scan_Identifier (Res); 5547 5548 -- Skip 'is'. 5549 Expect_Scan (Tok_Is); 5550 5551 Parse_Generic_Port_Clauses (Res); 5552 5553 Parse_Declarative_Part (Res, Res); 5554 5555 if Current_Token = Tok_Begin then 5556 Begin_Loc := Get_Token_Location; 5557 Set_Has_Begin (Res, True); 5558 5559 -- Skip 'begin'. 5560 Scan; 5561 5562 Parse_Concurrent_Statements (Res); 5563 else 5564 Begin_Loc := No_Location; 5565 end if; 5566 5567 -- end keyword is expected to finish an entity declaration 5568 End_Loc := Get_Token_Location; 5569 Expect_Scan (Tok_End); 5570 5571 if Current_Token = Tok_Entity then 5572 if Flags.Vhdl_Std = Vhdl_87 then 5573 Error_Msg_Parse ("'entity' keyword not allowed here by vhdl 87"); 5574 end if; 5575 Set_End_Has_Reserved_Id (Res, True); 5576 Scan; 5577 end if; 5578 Check_End_Name (Res); 5579 Scan_Semi_Colon_Unit ("entity"); 5580 5581 Set_Library_Unit (Unit, Res); 5582 5583 if Flag_Elocations then 5584 Set_Begin_Location (Res, Begin_Loc); 5585 Set_End_Location (Res, End_Loc); 5586 end if; 5587 end Parse_Entity_Declaration; 5588 5589 -- [ LRM93 7.3.2 ] 5590 -- choice ::= simple_expression 5591 -- | discrete_range 5592 -- | ELEMENT_simple_name 5593 -- | OTHERS 5594 function Parse_A_Choice (Expr: Iir; Loc : Location_Type) return Iir 5595 is 5596 A_Choice: Iir; 5597 Expr1: Iir; 5598 begin 5599 if Expr = Null_Iir then 5600 if Current_Token = Tok_Others then 5601 A_Choice := Create_Iir (Iir_Kind_Choice_By_Others); 5602 Set_Location (A_Choice, Loc); 5603 5604 -- Skip 'others' 5605 Scan; 5606 5607 return A_Choice; 5608 else 5609 Expr1 := Parse_Expression; 5610 5611 if Expr1 = Null_Iir then 5612 -- Handle parse error now. 5613 -- FIXME: skip until '=>'. 5614 A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression); 5615 Set_Location (A_Choice, Loc); 5616 return A_Choice; 5617 end if; 5618 end if; 5619 else 5620 Expr1 := Expr; 5621 end if; 5622 5623 if Is_Range_Attribute_Name (Expr1) then 5624 A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); 5625 Set_Choice_Range (A_Choice, Expr1); 5626 elsif Current_Token = Tok_To or else Current_Token = Tok_Downto then 5627 A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); 5628 Set_Choice_Range (A_Choice, Parse_Range_Expression (Expr1)); 5629 elsif Current_Token = Tok_Range then 5630 A_Choice := Create_Iir (Iir_Kind_Choice_By_Range); 5631 Set_Choice_Range (A_Choice, Parse_Subtype_Indication (Expr1)); 5632 else 5633 A_Choice := Create_Iir (Iir_Kind_Choice_By_Expression); 5634 Set_Choice_Expression (A_Choice, Expr1); 5635 end if; 5636 5637 Set_Location (A_Choice, Loc); 5638 return A_Choice; 5639 end Parse_A_Choice; 5640 5641 -- [ LRM93 7.3.2 ] 5642 -- choices ::= choice { | choice } 5643 -- 5644 -- Leave tok_double_arrow as current token. 5645 procedure Parse_Choices (Expr: Iir; 5646 First_Loc : Location_Type; 5647 Chain : out Iir) 5648 is 5649 First, Last : Iir; 5650 A_Choice: Iir; 5651 Expr1 : Iir; 5652 Loc : Location_Type; 5653 begin 5654 Chain_Init (First, Last); 5655 Expr1 := Expr; 5656 Loc := First_Loc; 5657 loop 5658 A_Choice := Parse_A_Choice (Expr1, Loc); 5659 if First /= Null_Iir then 5660 Set_Same_Alternative_Flag (A_Choice, True); 5661 if Get_Kind (A_Choice) = Iir_Kind_Choice_By_Others then 5662 Error_Msg_Parse ("'others' choice must be alone"); 5663 end if; 5664 end if; 5665 5666 Chain_Append (First, Last, A_Choice); 5667 5668 if Current_Token /= Tok_Bar then 5669 Chain := First; 5670 return; 5671 end if; 5672 Loc := Get_Token_Location; 5673 5674 -- Skip '|'. 5675 Scan; 5676 5677 Expr1 := Null_Iir; 5678 end loop; 5679 end Parse_Choices; 5680 5681 -- precond : '(' 5682 -- postcond: next token 5683 -- 5684 -- This can be an expression or an aggregate. 5685 -- 5686 -- [ LRM93 7.3.2 ] 5687 -- aggregate ::= ( element_association { , element_association } ) 5688 -- 5689 -- [ LRM93 7.3.2 ] 5690 -- element_association ::= [ choices => ] expression 5691 function Parse_Aggregate return Iir 5692 is 5693 Expr: Iir; 5694 Res: Iir; 5695 First, Last : Iir; 5696 Assoc: Iir; 5697 Loc, Right_Loc : Location_Type; 5698 begin 5699 Loc := Get_Token_Location; 5700 5701 -- Skip '(' 5702 Scan; 5703 5704 if Current_Token /= Tok_Others then 5705 Expr := Parse_Expression; 5706 case Current_Token is 5707 when Tok_Comma 5708 | Tok_Double_Arrow 5709 | Tok_Bar => 5710 -- This is really an aggregate 5711 null; 5712 when Tok_Right_Paren => 5713 -- This was just a braced expression. 5714 5715 Right_Loc := Get_Token_Location; 5716 5717 -- Skip ')'. 5718 Scan; 5719 5720 if Expr /= Null_Iir 5721 and then Get_Kind (Expr) = Iir_Kind_Aggregate 5722 then 5723 -- Parenthesis around aggregate is useless and change the 5724 -- context for array aggregate. 5725 Warning_Msg_Sem 5726 (Warnid_Parenthesis, +Expr, 5727 "suspicious parenthesis around aggregate"); 5728 elsif not Flag_Parse_Parenthesis then 5729 return Expr; 5730 end if; 5731 5732 -- Create a node for the parenthesis. 5733 Res := Create_Iir (Iir_Kind_Parenthesis_Expression); 5734 Set_Location (Res, Loc); 5735 Set_Expression (Res, Expr); 5736 5737 if Flag_Elocations then 5738 Create_Elocations (Res); 5739 Set_Right_Paren_Location (Res, Right_Loc); 5740 end if; 5741 5742 return Res; 5743 5744 when Tok_Semi_Colon 5745 | Tok_Then 5746 | Tok_Is 5747 | Tok_Generate 5748 | Tok_Loop => 5749 -- Surely a missing parenthesis. 5750 -- FIXME: in case of multiple missing parenthesises, several 5751 -- messages will be displayed 5752 Error_Msg_Parse 5753 ("missing ')' for opening parenthesis at %l", +Loc); 5754 return Expr; 5755 5756 when others => 5757 -- Surely a parse error... 5758 null; 5759 end case; 5760 else 5761 Expr := Null_Iir; 5762 end if; 5763 Res := Create_Iir (Iir_Kind_Aggregate); 5764 Set_Location (Res, Loc); 5765 Chain_Init (First, Last); 5766 loop 5767 if Current_Token = Tok_Others and then Expr = Null_Iir then 5768 Assoc := Parse_A_Choice (Null_Iir, Loc); 5769 Expect (Tok_Double_Arrow); 5770 5771 -- Eat '=>' 5772 Scan; 5773 5774 Expr := Parse_Expression; 5775 else 5776 -- Not others: an expression (or a range). 5777 if Expr = Null_Iir then 5778 Expr := Parse_Expression; 5779 end if; 5780 if Expr = Null_Iir then 5781 return Null_Iir; 5782 end if; 5783 5784 case Current_Token is 5785 when Tok_Comma 5786 | Tok_Right_Paren => 5787 Assoc := Create_Iir (Iir_Kind_Choice_By_None); 5788 Set_Location (Assoc, Loc); 5789 when others => 5790 Parse_Choices (Expr, Loc, Assoc); 5791 Expect (Tok_Double_Arrow); 5792 5793 -- Eat '=>'. 5794 Scan; 5795 5796 Expr := Parse_Expression; 5797 end case; 5798 end if; 5799 Set_Associated_Expr (Assoc, Expr); 5800 Chain_Append_Subchain (First, Last, Assoc); 5801 exit when Current_Token /= Tok_Comma; 5802 5803 Loc := Get_Token_Location; 5804 5805 -- Eat ',' 5806 Scan; 5807 5808 Expr := Null_Iir; 5809 end loop; 5810 Set_Association_Choices_Chain (Res, First); 5811 5812 -- Eat ')'. 5813 Expect_Scan (Tok_Right_Paren); 5814 return Res; 5815 end Parse_Aggregate; 5816 5817 -- precond : NEW 5818 -- postcond: next token 5819 -- 5820 -- [LRM93 7.3.6] 5821 -- allocator ::= NEW subtype_indication 5822 -- | NEW qualified_expression 5823 function Parse_Allocator return Iir 5824 is 5825 Loc: Location_Type; 5826 Res : Iir; 5827 Expr: Iir; 5828 begin 5829 Loc := Get_Token_Location; 5830 5831 -- Accept 'new'. 5832 Scan; 5833 Expr := Parse_Name (Allow_Indexes => False); 5834 if Expr /= Null_Iir 5835 and then Get_Kind (Expr) /= Iir_Kind_Qualified_Expression 5836 then 5837 -- This is a subtype_indication. 5838 Res := Create_Iir (Iir_Kind_Allocator_By_Subtype); 5839 Expr := Parse_Subtype_Indication (Expr); 5840 Set_Subtype_Indication (Res, Expr); 5841 else 5842 Res := Create_Iir (Iir_Kind_Allocator_By_Expression); 5843 Set_Expression (Res, Expr); 5844 end if; 5845 5846 Set_Location (Res, Loc); 5847 return Res; 5848 end Parse_Allocator; 5849 5850 -- precond : tok_bit_string 5851 -- postcond: tok_bit_string 5852 -- 5853 -- Simply create the node for a bit string. 5854 function Parse_Bit_String (Len : Int32) return Iir 5855 is 5856 Res : Iir; 5857 B : Number_Base_Type; 5858 begin 5859 Res := Create_Iir (Iir_Kind_String_Literal8); 5860 Set_Location (Res); 5861 Set_String8_Id (Res, Current_String_Id); 5862 Set_String_Length (Res, Current_String_Length); 5863 Set_Literal_Length (Res, Len + Get_Token_Length); 5864 case Get_Bit_String_Sign is 5865 when 's' => 5866 Set_Has_Sign (Res, True); 5867 Set_Has_Signed (Res, True); 5868 when 'u' => 5869 Set_Has_Sign (Res, True); 5870 Set_Has_Signed (Res, False); 5871 when others => 5872 Set_Has_Sign (Res, False); 5873 Set_Has_Signed (Res, False); 5874 end case; 5875 5876 case Get_Bit_String_Base is 5877 when 'b' => 5878 B := Base_2; 5879 when 'o' => 5880 B := Base_8; 5881 when 'd' => 5882 B := Base_10; 5883 when 'x' => 5884 B := Base_16; 5885 when others => 5886 raise Internal_Error; 5887 end case; 5888 Set_Bit_String_Base (Res, B); 5889 5890 return Res; 5891 end Parse_Bit_String; 5892 5893 -- Scan returns an expanded bit value. Adjust the expanded bit value as 5894 -- required by the length. 5895 procedure Resize_Bit_String (Lit : Iir; Nlen : Nat32) 5896 is 5897 use Str_Table; 5898 5899 Old_Len : constant Nat32 := Get_String_Length (Lit); 5900 Is_Signed : constant Boolean := Get_Has_Signed (Lit); 5901 Id : constant String8_Id := Get_String8_Id (Lit); 5902 C : Nat8; 5903 begin 5904 if Nlen > Old_Len then 5905 -- Extend. 5906 5907 -- LRM08 15.8 5908 -- -- If the length is greater than the number of characters in the 5909 -- expanded bit value and the base specifier is B, UB, O, UO, X, 5910 -- UX or D, the bit string value is obtained by concatenating a 5911 -- string of 0 digits to the left of the expanded bit value. The 5912 -- number of 0 digits in the string is such that the number of 5913 -- characters in the result of the concatenation is the length of 5914 -- the bit string literal. 5915 -- 5916 -- -- If the length is greater than the number of characters in the 5917 -- expanded bit value and the base specifier is SB, SO or SX, the 5918 -- bit string value is obtained by concatenating the the left of 5919 -- the expanded bit value a string, each of whose characters is 5920 -- the leftmost character of the expanded bit value. The number 5921 -- of characters in the string is such that the number of 5922 -- characters in the result of the concatenation is the length of 5923 -- the bit string literal. 5924 if Is_Signed then 5925 if Old_Len = 0 then 5926 Error_Msg_Parse 5927 (+Lit, "cannot expand an empty signed bit string"); 5928 C := Character'Pos ('0'); 5929 else 5930 C := Element_String8 (Id, 1); 5931 end if; 5932 else 5933 C := Character'Pos ('0'); 5934 end if; 5935 Resize_String8 (Nlen); 5936 -- Shift (position 1 is the MSB). 5937 for I in reverse 1 .. Old_Len loop 5938 Set_Element_String8 (Id, I + Nlen - Old_Len, 5939 Element_String8 (Id, I)); 5940 end loop; 5941 for I in 1 .. Nlen - Old_Len loop 5942 Set_Element_String8 (Id, I, C); 5943 end loop; 5944 Set_String_Length (Lit, Nlen); 5945 5946 elsif Nlen < Old_Len then 5947 -- Reduce. 5948 5949 -- LRM08 15.8 5950 -- -- If the length is less than the number of characters in the 5951 -- expanded bit value and the base specifier is B, UB, O, UO, X, 5952 -- UX or D, the bit string value is obtained by deleting 5953 -- sufficient characters from the left of the expanded bit value 5954 -- to yield a string whose length is the length of the bit string 5955 -- literal. It is an error if any of the character so deleted is 5956 -- other than the digit 0. 5957 -- 5958 -- -- If the length is less than the number of characters in the 5959 -- expanded bit value and the base specifier is SB, SO or SX, the 5960 -- bit string value is obtained by deleting sufficient characters 5961 -- from the left of the expanded bit value to yield a string whose 5962 -- length is the length of the bit string literal. It is an error 5963 -- if any of the characters so deleted differs from the leftmost 5964 -- remaining character. 5965 if Is_Signed then 5966 C := Element_String8 (Id, 1 + Old_Len - Nlen); 5967 else 5968 C := Character'Pos ('0'); 5969 end if; 5970 for I in 1 .. Old_Len - Nlen loop 5971 if Element_String8 (Id, I) /= C then 5972 Error_Msg_Parse 5973 (+Lit, "truncation of bit string changes the value"); 5974 -- Avoid error storm. 5975 exit; 5976 end if; 5977 end loop; 5978 -- Shift (position 1 is the MSB). 5979 for I in 1 .. Nlen loop 5980 Set_Element_String8 (Id, I, 5981 Element_String8 (Id, I + Old_Len - Nlen)); 5982 end loop; 5983 Resize_String8 (Nlen); 5984 Set_String_Length (Lit, Nlen); 5985 5986 else 5987 -- LRM08 15.8 5988 -- -- If the length is equal to the number of characters in the 5989 -- expanded bit value, the string literal value is the expanded 5990 -- bit value itself. 5991 null; 5992 end if; 5993 end Resize_Bit_String; 5994 5995 -- LRM93 3.1.3 5996 -- /unit/_name 5997 -- 5998 -- A unit name is a name, but it must designate a unit declaration. As 5999 -- a consequence, it can only be a simple_name or a selected name. 6000 function Parse_Unit_Name return Iir 6001 is 6002 Res : Iir; 6003 begin 6004 Res := Parse_Name (Allow_Indexes => False); 6005 case Get_Kind (Res) is 6006 when Iir_Kind_Simple_Name 6007 | Iir_Kind_Selected_Name => 6008 null; 6009 when others => 6010 Error_Msg_Parse ("invalid unit name"); 6011 end case; 6012 return Res; 6013 end Parse_Unit_Name; 6014 6015 -- Precond : next token after tok_integer 6016 -- postcond: likewise 6017 -- 6018 -- Return an integer_literal or a physical_literal. 6019 function Parse_Integer_Literal (Val : Int64; Len : Int32) return Iir 6020 is 6021 Res : Iir; 6022 begin 6023 if Current_Token = Tok_Identifier then 6024 -- physical literal 6025 Res := Create_Iir (Iir_Kind_Physical_Int_Literal); 6026 Set_Unit_Name (Res, Parse_Unit_Name); 6027 else 6028 -- integer literal 6029 Res := Create_Iir (Iir_Kind_Integer_Literal); 6030 end if; 6031 Set_Value (Res, Val); 6032 Set_Literal_Length (Res, Len); 6033 return Res; 6034 end Parse_Integer_Literal; 6035 6036 function Parse_PSL_Builtin_Call (Kind : Iir_Kinds_Psl_Builtin) return Iir 6037 is 6038 Res : Iir; 6039 Expr : Iir; 6040 begin 6041 Res := Create_Iir (Kind); 6042 Set_Location (Res); 6043 6044 -- Skip builtin. 6045 Scan; 6046 6047 Expect_Scan (Tok_Left_Paren); 6048 6049 Set_Expression (Res, Parse_Expression); 6050 6051 if Current_Token = Tok_Comma then 6052 -- Skip ','. 6053 Scan; 6054 6055 Expr := Parse_Expression; 6056 case Kind is 6057 when Iir_Kind_Psl_Fell 6058 | Iir_Kind_Psl_Rose 6059 | Iir_Kind_Psl_Stable => 6060 Set_Clock_Expression (Res, Expr); 6061 when Iir_Kind_Psl_Prev => 6062 Set_Count_Expression (Res, Expr); 6063 end case; 6064 end if; 6065 6066 if Current_Token = Tok_Comma then 6067 -- Skip ','. 6068 Scan; 6069 6070 case Kind is 6071 when Iir_Kind_Psl_Prev => 6072 Set_Clock_Expression (Res, Parse_Expression); 6073 when others => 6074 Error_Msg_Parse ("too many parameter for PSL builtin"); 6075 end case; 6076 end if; 6077 6078 Expect_Scan (Tok_Right_Paren); 6079 6080 return Res; 6081 end Parse_PSL_Builtin_Call; 6082 6083 -- precond : next token 6084 -- postcond: next token 6085 -- 6086 -- [ LRM93 7.1 ] 6087 -- primary ::= name 6088 -- | literal 6089 -- | aggregate 6090 -- | function_call 6091 -- | qualified_expression 6092 -- | type_conversion 6093 -- | allocator 6094 -- | ( expression ) 6095 -- 6096 -- [ LRM93 7.3.1 ] 6097 -- literal ::= numeric_literal 6098 -- | enumeration_literal 6099 -- | string_literal 6100 -- | bit_string_literal 6101 -- | NULL 6102 -- 6103 -- [ LRM93 7.3.1 ] 6104 -- numeric_literal ::= abstract_literal 6105 -- | physical_literal 6106 -- 6107 -- [ LRM93 13.4 ] 6108 -- abstract_literal ::= decimal_literal | based_literal 6109 -- 6110 -- [ LRM93 3.1.3 ] 6111 -- physical_literal ::= [ abstract_literal ] UNIT_name 6112 function Parse_Primary return Iir_Expression 6113 is 6114 Res: Iir_Expression; 6115 Int: Int64; 6116 Fp: Fp64; 6117 Loc: Location_Type; 6118 Len : Int32; 6119 begin 6120 case Current_Token is 6121 when Tok_Integer => 6122 Int := Current_Iir_Int64; 6123 Loc := Get_Token_Location; 6124 Len := Get_Token_Length; 6125 6126 -- Skip integer 6127 Scan; 6128 6129 Res := Parse_Integer_Literal (Int, Len); 6130 Set_Location (Res, Loc); 6131 return Res; 6132 6133 when Tok_Real => 6134 Fp := Current_Iir_Fp64; 6135 Loc := Get_Token_Location; 6136 Len := Get_Token_Length; 6137 6138 -- Skip real 6139 Scan; 6140 6141 if Current_Token = Tok_Identifier then 6142 -- physical literal 6143 Res := Create_Iir (Iir_Kind_Physical_Fp_Literal); 6144 Set_Unit_Name (Res, Parse_Unit_Name); 6145 else 6146 -- real literal 6147 Res := Create_Iir (Iir_Kind_Floating_Point_Literal); 6148 end if; 6149 Set_Location (Res, Loc); 6150 Set_Fp_Value (Res, Fp); 6151 Set_Literal_Length (Res, Len); 6152 return Res; 6153 6154 when Tok_Identifier 6155 | Tok_Double_Less => 6156 Res := Parse_Name (Allow_Indexes => True); 6157 if Res /= Null_Iir 6158 and then Get_Kind (Res) = Iir_Kind_Signature then 6159 Error_Msg_Parse (+Res, "signature not allowed in expression"); 6160 return Get_Signature_Prefix (Res); 6161 else 6162 return Res; 6163 end if; 6164 6165 when Tok_Character => 6166 Res := Create_Iir (Iir_Kind_Character_Literal); 6167 Set_Identifier (Res, Current_Identifier); 6168 Set_Location (Res); 6169 6170 -- Skip character. 6171 Scan; 6172 6173 if Current_Token = Tok_Tick then 6174 Error_Msg_Parse 6175 ("prefix of an attribute can't be a character literal"); 6176 -- skip tick. 6177 Scan; 6178 -- skip attribute designator 6179 Scan; 6180 end if; 6181 return Res; 6182 when Tok_Left_Paren => 6183 if Parenthesis_Depth = Max_Parenthesis_Depth then 6184 Error_Msg_Parse 6185 ("too many open parenthesis, skip to the matching one"); 6186 Skip_Until_Closing_Parenthesis; 6187 return Null_Iir; 6188 else 6189 Parenthesis_Depth := Parenthesis_Depth + 1; 6190 Res := Parse_Aggregate; 6191 Parenthesis_Depth := Parenthesis_Depth - 1; 6192 return Res; 6193 end if; 6194 when Tok_String => 6195 return Parse_Name; 6196 when Tok_Null => 6197 Res := Create_Iir (Iir_Kind_Null_Literal); 6198 Set_Location (Res); 6199 Scan; 6200 return Res; 6201 when Tok_New => 6202 return Parse_Allocator; 6203 6204 when Tok_Integer_Letter => 6205 Int := Current_Iir_Int64; 6206 Loc := Get_Token_Location; 6207 Len := Get_Token_Length; 6208 6209 -- Skip integer 6210 Scan; 6211 6212 if Current_Token = Tok_Bit_String then 6213 Res := Parse_Bit_String (Len); 6214 Set_Has_Length (Res, True); 6215 6216 -- Skip bit string 6217 Scan; 6218 6219 -- Resize. 6220 Resize_Bit_String (Res, Nat32 (Int)); 6221 else 6222 Error_Msg_Parse 6223 (Get_Token_Location, 6224 "space is required between number and unit name"); 6225 Res := Parse_Integer_Literal (Int, Len); 6226 end if; 6227 Set_Location (Res, Loc); 6228 return Res; 6229 6230 when Tok_Bit_String => 6231 Res := Parse_Bit_String (0); 6232 6233 -- Skip bit string 6234 Scan; 6235 6236 return Res; 6237 6238 when Tok_Prev => 6239 return Parse_PSL_Builtin_Call (Iir_Kind_Psl_Prev); 6240 when Tok_Stable => 6241 return Parse_PSL_Builtin_Call (Iir_Kind_Psl_Stable); 6242 when Tok_Rose => 6243 return Parse_PSL_Builtin_Call (Iir_Kind_Psl_Rose); 6244 when Tok_Fell => 6245 return Parse_PSL_Builtin_Call (Iir_Kind_Psl_Fell); 6246 6247 when Tok_Minus 6248 | Tok_Plus => 6249 Error_Msg_Parse 6250 ("'-' and '+' are not allowed in primary, use parenthesis"); 6251 return Parse_Expression (Prio_Simple); 6252 6253 when Tok_Comma 6254 | Tok_Semi_Colon 6255 | Tok_Right_Paren 6256 | Tok_Eof 6257 | Tok_End => 6258 -- Token not to be skipped 6259 Error_Msg_Parse ("primary expression expected"); 6260 return Create_Error_Node; 6261 6262 when others => 6263 Unexpected ("primary"); 6264 return Create_Error_Node; 6265 end case; 6266 end Parse_Primary; 6267 6268 -- [ LRM08 9 Expressions ] 6269 -- 6270 -- expression ::= 6271 -- condition_operator primary 6272 -- | logical_expression 6273 -- 6274 -- logical_expression ::= 6275 -- relation { and relation } 6276 -- | relation { or relation } 6277 -- | relation { xor relation } 6278 -- | relation [ nand relation ] 6279 -- | relation [ nor relation ] 6280 -- | relation { xnor relation } 6281 -- 6282 -- relation ::= 6283 -- shift_expression [ relational_operator shift_expression ] 6284 -- 6285 -- shift_expression ::= 6286 -- simple_expression [ shift_operator simple_expression ] 6287 -- 6288 -- simple_expression ::= 6289 -- [ sign ] term { adding_operator term } 6290 -- 6291 -- term ::= 6292 -- factor { multiplying_operator factor } 6293 -- 6294 -- factor ::= 6295 -- primary [ ** primary ] 6296 -- | abs primary 6297 -- | not primary 6298 -- | logical_operator primary 6299 function Build_Unary_Factor (Op : Iir_Kind) return Iir 6300 is 6301 Res : Iir; 6302 begin 6303 Res := Create_Iir (Op); 6304 Set_Location (Res); 6305 6306 -- Skip operator. 6307 Scan; 6308 6309 Set_Operand (Res, Parse_Primary); 6310 6311 return Res; 6312 end Build_Unary_Factor; 6313 6314 function Build_Unary_Simple (Op : Iir_Kind) return Iir 6315 is 6316 Res : Iir; 6317 begin 6318 Res := Create_Iir (Op); 6319 Set_Location (Res); 6320 6321 -- Skip operator. 6322 Scan; 6323 6324 Set_Operand (Res, Parse_Expression (Prio_Term)); 6325 6326 return Res; 6327 end Build_Unary_Simple; 6328 6329 function Build_Unary_Factor_08 (Op : Iir_Kind) return Iir is 6330 begin 6331 if Flags.Vhdl_Std < Vhdl_08 then 6332 Error_Msg_Parse ("missing left operand of logical expression"); 6333 6334 -- Skip operator 6335 Scan; 6336 6337 return Parse_Primary; 6338 else 6339 return Build_Unary_Factor (Op); 6340 end if; 6341 end Build_Unary_Factor_08; 6342 6343 function Parse_Unary_Expression return Iir 6344 is 6345 Res, Left : Iir_Expression; 6346 begin 6347 case Current_Token is 6348 when Tok_Plus => 6349 return Build_Unary_Simple (Iir_Kind_Identity_Operator); 6350 when Tok_Minus => 6351 return Build_Unary_Simple (Iir_Kind_Negation_Operator); 6352 6353 when Tok_Abs => 6354 return Build_Unary_Factor (Iir_Kind_Absolute_Operator); 6355 when Tok_Not => 6356 return Build_Unary_Factor (Iir_Kind_Not_Operator); 6357 6358 when Tok_And => 6359 return Build_Unary_Factor_08 (Iir_Kind_Reduction_And_Operator); 6360 when Tok_Or => 6361 return Build_Unary_Factor_08 (Iir_Kind_Reduction_Or_Operator); 6362 when Tok_Nand => 6363 return Build_Unary_Factor_08 (Iir_Kind_Reduction_Nand_Operator); 6364 when Tok_Nor => 6365 return Build_Unary_Factor_08 (Iir_Kind_Reduction_Nor_Operator); 6366 when Tok_Xor => 6367 return Build_Unary_Factor_08 (Iir_Kind_Reduction_Xor_Operator); 6368 when Tok_Xnor => 6369 return Build_Unary_Factor_08 (Iir_Kind_Reduction_Xnor_Operator); 6370 6371 when Tok_Exclam_Mark => 6372 Error_Msg_Parse ("'!' is not allowed here, replaced by 'not'"); 6373 return Build_Unary_Factor (Iir_Kind_Not_Operator); 6374 6375 when others => 6376 Left := Parse_Primary; 6377 if Current_Token = Tok_Double_Star then 6378 Res := Create_Iir (Iir_Kind_Exponentiation_Operator); 6379 Set_Location (Res); 6380 6381 -- Skip '**'. 6382 Scan; 6383 6384 Set_Left (Res, Left); 6385 Set_Right (Res, Parse_Primary); 6386 return Res; 6387 else 6388 return Left; 6389 end if; 6390 end case; 6391 end Parse_Unary_Expression; 6392 6393 -- Example: When PRIO is Prio_Simple, a simple expression will be returned. 6394 function Parse_Binary_Expression (Left : Iir; Prio : Prio_Type) return Iir 6395 is 6396 Res : Iir; 6397 Expr : Iir; 6398 Op : Iir_Kind; 6399 Op_Prio : Prio_Type; 6400 Op_Tok : Token_Type; 6401 begin 6402 Res := Left; 6403 loop 6404 Op_Tok := Current_Token; 6405 case Op_Tok is 6406 when Tok_Star => 6407 Op := Iir_Kind_Multiplication_Operator; 6408 Op_Prio := Prio_Term; 6409 when Tok_Slash => 6410 Op := Iir_Kind_Division_Operator; 6411 Op_Prio := Prio_Term; 6412 when Tok_Mod => 6413 Op := Iir_Kind_Modulus_Operator; 6414 Op_Prio := Prio_Term; 6415 when Tok_Rem => 6416 Op := Iir_Kind_Remainder_Operator; 6417 Op_Prio := Prio_Term; 6418 6419 when Tok_Plus => 6420 Op := Iir_Kind_Addition_Operator; 6421 Op_Prio := Prio_Simple; 6422 when Tok_Minus => 6423 Op := Iir_Kind_Substraction_Operator; 6424 Op_Prio := Prio_Simple; 6425 when Tok_Ampersand => 6426 Op := Iir_Kind_Concatenation_Operator; 6427 Op_Prio := Prio_Simple; 6428 6429 when Tok_Sll => 6430 Op := Iir_Kind_Sll_Operator; 6431 Op_Prio := Prio_Shift; 6432 when Tok_Sla => 6433 Op := Iir_Kind_Sla_Operator; 6434 Op_Prio := Prio_Shift; 6435 when Tok_Srl => 6436 Op := Iir_Kind_Srl_Operator; 6437 Op_Prio := Prio_Shift; 6438 when Tok_Sra => 6439 Op := Iir_Kind_Sra_Operator; 6440 Op_Prio := Prio_Shift; 6441 when Tok_Rol => 6442 Op := Iir_Kind_Rol_Operator; 6443 Op_Prio := Prio_Shift; 6444 when Tok_Ror => 6445 Op := Iir_Kind_Ror_Operator; 6446 Op_Prio := Prio_Shift; 6447 6448 when Tok_Equal => 6449 Op := Iir_Kind_Equality_Operator; 6450 Op_Prio := Prio_Relation; 6451 when Tok_Not_Equal => 6452 Op := Iir_Kind_Inequality_Operator; 6453 Op_Prio := Prio_Relation; 6454 when Tok_Less => 6455 Op := Iir_Kind_Less_Than_Operator; 6456 Op_Prio := Prio_Relation; 6457 when Tok_Less_Equal => 6458 Op := Iir_Kind_Less_Than_Or_Equal_Operator; 6459 Op_Prio := Prio_Relation; 6460 when Tok_Greater => 6461 Op := Iir_Kind_Greater_Than_Operator; 6462 Op_Prio := Prio_Relation; 6463 when Tok_Greater_Equal => 6464 Op := Iir_Kind_Greater_Than_Or_Equal_Operator; 6465 Op_Prio := Prio_Relation; 6466 when Tok_Match_Equal => 6467 Op := Iir_Kind_Match_Equality_Operator; 6468 Op_Prio := Prio_Relation; 6469 when Tok_Match_Not_Equal => 6470 Op := Iir_Kind_Match_Inequality_Operator; 6471 Op_Prio := Prio_Relation; 6472 when Tok_Match_Less => 6473 Op := Iir_Kind_Match_Less_Than_Operator; 6474 Op_Prio := Prio_Relation; 6475 when Tok_Match_Less_Equal => 6476 Op := Iir_Kind_Match_Less_Than_Or_Equal_Operator; 6477 Op_Prio := Prio_Relation; 6478 when Tok_Match_Greater => 6479 Op := Iir_Kind_Match_Greater_Than_Operator; 6480 Op_Prio := Prio_Relation; 6481 when Tok_Match_Greater_Equal => 6482 Op := Iir_Kind_Match_Greater_Than_Or_Equal_Operator; 6483 Op_Prio := Prio_Relation; 6484 6485 when Tok_And => 6486 Op := Iir_Kind_And_Operator; 6487 Op_Prio := Prio_Logical; 6488 when Tok_Or => 6489 Op := Iir_Kind_Or_Operator; 6490 Op_Prio := Prio_Logical; 6491 when Tok_Xor => 6492 Op := Iir_Kind_Xor_Operator; 6493 Op_Prio := Prio_Logical; 6494 when Tok_Nand => 6495 Op := Iir_Kind_Nand_Operator; 6496 Op_Prio := Prio_Logical; 6497 when Tok_Nor => 6498 Op := Iir_Kind_Nor_Operator; 6499 Op_Prio := Prio_Logical; 6500 when Tok_Xnor => 6501 Op := Iir_Kind_Xnor_Operator; 6502 Op_Prio := Prio_Logical; 6503 6504 when others => 6505 return Res; 6506 end case; 6507 6508 -- If the OP_PRIO is less than PRIO, the binary operator will apply 6509 -- to the whole expression. 6510 -- eg: A * B + C 6511 if Op_Prio < Prio then 6512 return Res; 6513 end if; 6514 6515 Expr := Create_Iir (Op); 6516 Set_Location (Expr); 6517 Set_Left (Expr, Res); 6518 6519 -- Skip operator. 6520 Scan; 6521 6522 -- Catch errors for Ada programmers. 6523 if Current_Token = Tok_Then or Current_Token = Tok_Else then 6524 Report_Start_Group; 6525 Error_Msg_Parse ("""or else"" and ""and then"" sequences " 6526 & "are not allowed in vhdl"); 6527 Error_Msg_Parse ("""and"" and ""or"" are short-circuit " 6528 & "operators for BIT and BOOLEAN types"); 6529 Report_End_Group; 6530 Scan; 6531 end if; 6532 6533 if Op_Prio >= Prio_Simple and then Current_Token in Token_Sign_Type 6534 then 6535 Error_Msg_Parse ("'-'/'+' can only appear before the first term"); 6536 end if; 6537 6538 -- Left association: A + B + C is (A + B) + C 6539 Set_Right (Expr, Parse_Expression (Prio_Type'Succ (Op_Prio))); 6540 Res := Expr; 6541 6542 -- Only one relational_operator or shift_operator. 6543 if Op_Prio = Prio_Relation then 6544 if Current_Token in Token_Relational_Operator_Type then 6545 Error_Msg_Parse 6546 ("use parenthesis for consecutive relational expressions"); 6547 end if; 6548 elsif Op_Prio = Prio_Shift then 6549 -- Only one shift_operator. 6550 if Current_Token in Token_Shift_Operator_Type then 6551 Error_Msg_Parse 6552 ("use parenthesis for consecutive shift expressions"); 6553 end if; 6554 elsif Op_Prio = Prio_Logical then 6555 if Current_Token = Op_Tok then 6556 if Op_Tok = Tok_Nand or Op_Tok = Tok_Nor then 6557 Report_Start_Group; 6558 Error_Msg_Parse ("sequence of 'nor' or 'nand' not allowed"); 6559 Error_Msg_Parse ("('nor' and 'nand' are not associative)"); 6560 Report_End_Group; 6561 end if; 6562 elsif Current_Token in Token_Logical_Type then 6563 -- Expression is a sequence of relations, with the same 6564 -- operator. 6565 Error_Msg_Parse ("only one type of logical operators may be " 6566 & "used to combine relation"); 6567 end if; 6568 end if; 6569 end loop; 6570 end Parse_Binary_Expression; 6571 6572 function Parse_Expression (Prio : Prio_Type := Prio_Expression) return Iir 6573 is 6574 Left : Iir; 6575 Res : Iir; 6576 begin 6577 if Current_Token = Tok_Condition then 6578 if Prio /= Prio_Expression then 6579 Error_Msg_Parse 6580 ("'??' must be the first operator of an expression"); 6581 end if; 6582 Res := Create_Iir (Iir_Kind_Condition_Operator); 6583 Set_Location (Res); 6584 6585 -- Skip '??' 6586 Scan; 6587 6588 Set_Operand (Res, Parse_Primary); 6589 6590 -- Improve error message for expressions like '?? a and b'; in 6591 -- particular it avoids cascaded errors. 6592 case Current_Token is 6593 when Token_Logical_Type 6594 | Token_Relational_Operator_Type 6595 | Token_Shift_Operator_Type 6596 | Token_Adding_Operator_Type => 6597 Error_Msg_Parse 6598 ("'??' cannot be followed by a binary expression"); 6599 Res := Parse_Binary_Expression (Res, Prio); 6600 when others => 6601 null; 6602 end case; 6603 else 6604 Left := Parse_Unary_Expression; 6605 Res := Parse_Binary_Expression (Left, Prio); 6606 end if; 6607 6608 return Res; 6609 end Parse_Expression; 6610 6611 -- Like Parse_Expression, but assumed the expression is followed by a 6612 -- reserved identifier. As a result, it will diagnoses extra parentheses. 6613 function Parse_Expression_Keyword return Iir 6614 is 6615 Res : Iir; 6616 begin 6617 Res := Parse_Expression; 6618 6619 if Current_Token = Tok_Right_Paren then 6620 Error_Msg_Parse ("extra ')' ignored"); 6621 6622 -- Skip ')'. 6623 Scan; 6624 end if; 6625 6626 return Res; 6627 end Parse_Expression_Keyword; 6628 6629 -- precond : next token 6630 -- postcond: next token. 6631 -- 6632 -- [ 8.4 ] 6633 -- waveform ::= waveform_element { , waveform_element } 6634 -- | UNAFFECTED 6635 -- 6636 -- [ 8.4.1 ] 6637 -- waveform_element ::= VALUE_expression [ AFTER TIME_expression ] 6638 -- | NULL [ AFTER TIME_expression ] 6639 function Parse_Waveform return Iir_Waveform_Element 6640 is 6641 Res: Iir_Waveform_Element; 6642 We, Last_We : Iir_Waveform_Element; 6643 begin 6644 if Current_Token = Tok_Unaffected then 6645 if Flags.Vhdl_Std = Vhdl_87 then 6646 Error_Msg_Parse ("'unaffected' is not allowed in vhdl87"); 6647 end if; 6648 6649 Res := Create_Iir (Iir_Kind_Unaffected_Waveform); 6650 Set_Location (Res); 6651 6652 -- Skip 'unaffected'. 6653 Scan; 6654 else 6655 Chain_Init (Res, Last_We); 6656 loop 6657 We := Create_Iir (Iir_Kind_Waveform_Element); 6658 Chain_Append (Res, Last_We, We); 6659 Set_Location (We); 6660 6661 -- Note: NULL is handled as a null_literal. 6662 Set_We_Value (We, Parse_Expression); 6663 6664 if Current_Token = Tok_After then 6665 -- Skip 'after'. 6666 Scan; 6667 6668 Set_Time (We, Parse_Expression); 6669 end if; 6670 6671 exit when Current_Token /= Tok_Comma; 6672 6673 -- Skip ','. 6674 Scan; 6675 end loop; 6676 end if; 6677 6678 return Res; 6679 end Parse_Waveform; 6680 6681 -- precond : next token 6682 -- postcond: next token 6683 -- 6684 -- [ 8.4 ] 6685 -- delay_mechanism ::= TRANSPORT 6686 -- | [ REJECT TIME_expression ] INERTIAL 6687 procedure Parse_Delay_Mechanism (Assign: Iir) is 6688 begin 6689 if Current_Token = Tok_Transport then 6690 Set_Delay_Mechanism (Assign, Iir_Transport_Delay); 6691 Set_Has_Delay_Mechanism (Assign, True); 6692 6693 -- Skip 'transport'. 6694 Scan; 6695 else 6696 Set_Delay_Mechanism (Assign, Iir_Inertial_Delay); 6697 if Current_Token = Tok_Reject then 6698 if Flags.Vhdl_Std = Vhdl_87 then 6699 Error_Msg_Parse 6700 ("'reject' delay mechanism not allowed in vhdl 87"); 6701 end if; 6702 Set_Has_Delay_Mechanism (Assign, True); 6703 6704 -- Skip 'reject'. 6705 Scan; 6706 6707 Set_Reject_Time_Expression (Assign, Parse_Expression); 6708 6709 -- Skip 'inertial'. 6710 Expect_Scan (Tok_Inertial); 6711 elsif Current_Token = Tok_Inertial then 6712 if Flags.Vhdl_Std = Vhdl_87 then 6713 Error_Msg_Parse 6714 ("'inertial' keyword not allowed in vhdl 87"); 6715 end if; 6716 Set_Has_Delay_Mechanism (Assign, True); 6717 6718 -- Skip 'inertial'. 6719 Scan; 6720 end if; 6721 end if; 6722 end Parse_Delay_Mechanism; 6723 6724 -- precond : next token 6725 -- postcond: next token 6726 -- 6727 -- [ LRM93 9.5 ] 6728 -- options ::= [ GUARDED ] [ delay_mechanism ] 6729 procedure Parse_Options (Stmt : Iir) is 6730 begin 6731 if Current_Token = Tok_Guarded then 6732 Set_Guard (Stmt, Stmt); 6733 Scan; 6734 end if; 6735 Parse_Delay_Mechanism (Stmt); 6736 end Parse_Options; 6737 6738 -- precond : next tkoen 6739 -- postcond: next token (';') 6740 -- 6741 -- [ LRM93 9.5.1 ] 6742 -- conditional_waveforms ::= 6743 -- { waveform WHEN condition ELSE } 6744 -- waveform [ WHEN condition ] 6745 function Parse_Conditional_Waveforms return Iir 6746 is 6747 Wf : Iir; 6748 Res : Iir; 6749 Cond_Wf, N_Cond_Wf : Iir_Conditional_Waveform; 6750 begin 6751 Wf := Parse_Waveform; 6752 if Current_Token /= Tok_When then 6753 return Wf; 6754 else 6755 Res := Create_Iir (Iir_Kind_Conditional_Waveform); 6756 Set_Location (Res); 6757 Set_Waveform_Chain (Res, Wf); 6758 6759 Cond_Wf := Res; 6760 loop 6761 -- Skip 'when'. 6762 Scan; 6763 6764 Set_Condition (Cond_Wf, Parse_Expression); 6765 6766 if Current_Token /= Tok_Else then 6767 if Flags.Vhdl_Std = Vhdl_87 then 6768 Error_Msg_Parse ("else missing in vhdl 87"); 6769 end if; 6770 exit; 6771 end if; 6772 6773 N_Cond_Wf := Create_Iir (Iir_Kind_Conditional_Waveform); 6774 Set_Location (N_Cond_Wf); 6775 Set_Chain (Cond_Wf, N_Cond_Wf); 6776 Cond_Wf := N_Cond_Wf; 6777 6778 -- Eat 'else' 6779 Scan; 6780 6781 Set_Waveform_Chain (Cond_Wf, Parse_Waveform); 6782 6783 exit when Current_Token /= Tok_When; 6784 end loop; 6785 return Res; 6786 end if; 6787 end Parse_Conditional_Waveforms; 6788 6789 -- precond : '<=' (or ':=') 6790 -- postcond: next token (after ';') 6791 -- 6792 -- [ LRM93 9.5.1 ] 6793 -- concurrent_conditional_signal_assignment ::= 6794 -- target <= [ GUARDED ] [ delay_mechanism ] conditional_waveforms ; 6795 -- 6796 -- [ LRM08 10.5.2.1 ] 6797 -- concurrent_simple_waveform_assignment ::= 6798 -- target <= [ GUARDED ] [ delay_mechanism ] waveform ; 6799 function Parse_Concurrent_Conditional_Signal_Assignment (Target: Iir) 6800 return Iir 6801 is 6802 Res: Iir; 6803 Loc : Location_Type; 6804 N_Res : Iir; 6805 Wf : Iir; 6806 begin 6807 Loc := Get_Token_Location; 6808 case Current_Token is 6809 when Tok_Less_Equal => 6810 -- Skip '<='. 6811 Scan; 6812 when Tok_Assign => 6813 Error_Msg_Parse ("':=' not allowed in concurrent statement, " 6814 & "replaced by '<='"); 6815 -- Skip ':='. 6816 Scan; 6817 when others => 6818 Expect (Tok_Less_Equal); 6819 end case; 6820 6821 -- Assume simple signal assignment. 6822 Res := Create_Iir (Iir_Kind_Concurrent_Simple_Signal_Assignment); 6823 Parse_Options (Res); 6824 6825 Wf := Parse_Conditional_Waveforms; 6826 if Wf /= Null_Iir 6827 and then Get_Kind (Wf) = Iir_Kind_Conditional_Waveform 6828 then 6829 N_Res := 6830 Create_Iir (Iir_Kind_Concurrent_Conditional_Signal_Assignment); 6831 if Get_Guard (Res) /= Null_Iir then 6832 Set_Guard (N_Res, N_Res); 6833 end if; 6834 Set_Delay_Mechanism (N_Res, Get_Delay_Mechanism (Res)); 6835 Set_Reject_Time_Expression (N_Res, Get_Reject_Time_Expression (Res)); 6836 Free_Iir (Res); 6837 Res := N_Res; 6838 Set_Conditional_Waveform_Chain (Res, Wf); 6839 else 6840 Set_Waveform_Chain (Res, Wf); 6841 end if; 6842 Set_Location (Res, Loc); 6843 Set_Target (Res, Target); 6844 Expect_Scan (Tok_Semi_Colon, "';' expected at end of signal assignment"); 6845 6846 return Res; 6847 end Parse_Concurrent_Conditional_Signal_Assignment; 6848 6849 -- Like Parse_Expression, but keep parentheses. 6850 -- Parentheses are significant in case expressions, because of 6851 -- LRM02 8.8 Case Statement. 6852 function Parse_Case_Expression return Iir 6853 is 6854 Prev_Flag : constant Boolean := Flag_Parse_Parenthesis; 6855 Res : Iir; 6856 begin 6857 Flag_Parse_Parenthesis := True; 6858 Res := Parse_Expression_Keyword; 6859 Flag_Parse_Parenthesis := Prev_Flag; 6860 6861 return Res; 6862 end Parse_Case_Expression; 6863 6864 -- precond : WITH 6865 -- postcond: next token 6866 -- 6867 -- [ LRM93 9.5.2 ] 6868 -- selected_signal_assignment ::= 6869 -- WITH expresion SELECT 6870 -- target <= options selected_waveforms ; 6871 -- 6872 -- [ LRM93 9.5.2 ] 6873 -- selected_waveforms ::= 6874 -- { waveform WHEN choices , } 6875 -- waveform WHEN choices 6876 function Parse_Selected_Signal_Assignment return Iir 6877 is 6878 Res : Iir; 6879 Assoc : Iir; 6880 Wf_Chain : Iir_Waveform_Element; 6881 Target : Iir; 6882 First, Last : Iir; 6883 When_Loc : Location_Type; 6884 begin 6885 -- Skip 'with'. 6886 Scan; 6887 6888 Res := Create_Iir (Iir_Kind_Concurrent_Selected_Signal_Assignment); 6889 Set_Location (Res); 6890 Set_Expression (Res, Parse_Case_Expression); 6891 6892 Expect_Scan (Tok_Select, "'select' expected after expression"); 6893 6894 if Current_Token = Tok_Left_Paren then 6895 Target := Parse_Aggregate; 6896 else 6897 Target := Parse_Name (Allow_Indexes => True); 6898 end if; 6899 Set_Target (Res, Target); 6900 Expect_Scan (Tok_Less_Equal); 6901 6902 Parse_Options (Res); 6903 6904 Chain_Init (First, Last); 6905 loop 6906 Wf_Chain := Parse_Waveform; 6907 Expect (Tok_When, "'when' expected after waveform"); 6908 When_Loc := Get_Token_Location; 6909 6910 -- Eat 'when'. 6911 Scan; 6912 6913 Parse_Choices (Null_Iir, When_Loc, Assoc); 6914 Set_Associated_Chain (Assoc, Wf_Chain); 6915 Chain_Append_Subchain (First, Last, Assoc); 6916 exit when Current_Token /= Tok_Comma; 6917 -- Skip ','. 6918 Scan; 6919 end loop; 6920 Set_Selected_Waveform_Chain (Res, First); 6921 6922 Expect_Scan (Tok_Semi_Colon, "';' expected at end of signal assignment"); 6923 6924 return Res; 6925 end Parse_Selected_Signal_Assignment; 6926 6927 -- precond : next token 6928 -- postcond: next token. 6929 -- 6930 -- [ LRM93 8.1 ] 6931 -- sensitivity_list ::= SIGNAL_name { , SIGNAL_name } 6932 function Parse_Sensitivity_List return Iir_List 6933 is 6934 List : Iir_List; 6935 El : Iir; 6936 begin 6937 List := Create_Iir_List; 6938 6939 loop 6940 El := Parse_Name (Allow_Indexes => True); 6941 if El /= Null_Iir then 6942 case Get_Kind (El) is 6943 when Iir_Kind_Simple_Name 6944 | Iir_Kind_Parenthesis_Name 6945 | Iir_Kind_Selected_Name 6946 | Iir_Kind_Slice_Name 6947 | Iir_Kind_Attribute_Name 6948 | Iir_Kind_Selected_By_All_Name 6949 | Iir_Kind_Indexed_Name => 6950 null; 6951 when others => 6952 Error_Msg_Parse 6953 ("only names are allowed in a sensitivity list"); 6954 El := Create_Error_Node (El); 6955 end case; 6956 Append_Element (List, El); 6957 end if; 6958 6959 exit when Current_Token /= Tok_Comma; 6960 6961 -- Skip ','. 6962 Scan; 6963 end loop; 6964 6965 return List; 6966 end Parse_Sensitivity_List; 6967 6968 -- precond : ASSERT 6969 -- postcond: next token 6970 -- Note: this fill an sequential or a concurrent statement. 6971 -- 6972 -- [ LRM93 9.4 ] 6973 -- concurrent_assertion_statement ::= 6974 -- [ label : ] [ POSTPONED ] assertion ; 6975 -- 6976 -- [ LRM93 8.2 ] 6977 -- assertion ::= ASSERT condition 6978 -- [ REPORT expression ] [ SEVERITY expression ] 6979 procedure Parse_Assertion (Stmt: Iir) is 6980 begin 6981 Set_Location (Stmt); 6982 6983 -- Skip 'assert'. 6984 Scan; 6985 6986 Set_Assertion_Condition (Stmt, Parse_Expression); 6987 6988 if Current_Token = Tok_Report then 6989 -- Skip 'report'. 6990 Scan; 6991 6992 Set_Report_Expression (Stmt, Parse_Expression); 6993 end if; 6994 6995 if Current_Token = Tok_Severity then 6996 -- Skip 'severity'. 6997 Scan; 6998 6999 Set_Severity_Expression (Stmt, Parse_Expression); 7000 if Current_Token = Tok_Report then 7001 -- Nice message in case of inversion. 7002 Error_Msg_Parse 7003 ("report expression must precede severity expression"); 7004 Scan; 7005 Set_Report_Expression (Stmt, Parse_Expression); 7006 end if; 7007 end if; 7008 end Parse_Assertion; 7009 7010 -- precond : REPORT 7011 -- postcond: next token 7012 -- 7013 -- [ 8.3 ] 7014 -- report_statement ::= REPORT expression [ SEVERITY expression ] 7015 function Parse_Report_Statement return Iir_Report_Statement 7016 is 7017 Res : Iir_Report_Statement; 7018 begin 7019 Res := Create_Iir (Iir_Kind_Report_Statement); 7020 Set_Location (Res); 7021 if Flags.Vhdl_Std = Vhdl_87 then 7022 Error_Msg_Parse ("report statement not allowed in vhdl87"); 7023 end if; 7024 7025 -- Skip 'report'. 7026 Scan; 7027 7028 Set_Report_Expression (Res, Parse_Expression); 7029 7030 if Current_Token = Tok_Severity then 7031 -- Skip 'severity'. 7032 Scan; 7033 7034 Set_Severity_Expression (Res, Parse_Expression); 7035 end if; 7036 return Res; 7037 end Parse_Report_Statement; 7038 7039 -- precond : WAIT 7040 -- postcond: ';' 7041 -- 7042 -- [ LRM93 8.1 ] 7043 -- wait_statement ::= 7044 -- [ label : ] WAIT [ sensitivity_clause ] [ condition_clause ] 7045 -- [ timeout_clause ] ; 7046 -- 7047 -- [ LRM93 8.1 ] 7048 -- sensitivity_clause ::= ON sensitivity_list 7049 -- 7050 -- [ LRM93 8.1 ] 7051 -- condition_clause ::= UNTIL conditiion 7052 -- 7053 -- [ LRM93 8.1 ] 7054 -- timeout_clause ::= FOR TIME_expression 7055 function Parse_Wait_Statement return Iir_Wait_Statement 7056 is 7057 Res: Iir_Wait_Statement; 7058 List: Iir_List; 7059 begin 7060 Res := Create_Iir (Iir_Kind_Wait_Statement); 7061 Set_Location (Res); 7062 7063 -- Skip 'wait'. 7064 Scan; 7065 7066 -- Sensitivity clause. 7067 case Current_Token is 7068 when Tok_On => 7069 -- Skip 'on'. 7070 Scan; 7071 7072 List := Parse_Sensitivity_List; 7073 Set_Sensitivity_List (Res, List); 7074 when Tok_Until => 7075 null; 7076 when Tok_For => 7077 null; 7078 when Tok_Semi_Colon => 7079 return Res; 7080 when others => 7081 Error_Msg_Parse ("'on', 'until', 'for' or ';' expected"); 7082 Resync_To_End_Of_Statement; 7083 return Res; 7084 end case; 7085 7086 -- Condition clause. 7087 case Current_Token is 7088 when Tok_On => 7089 Error_Msg_Parse ("only one sensitivity is allowed"); 7090 Resync_To_End_Of_Statement; 7091 return Res; 7092 when Tok_Until => 7093 Scan; 7094 Set_Condition_Clause (Res, Parse_Expression); 7095 when Tok_For => 7096 null; 7097 when Tok_Semi_Colon => 7098 return Res; 7099 when others => 7100 Error_Msg_Parse ("'until', 'for' or ';' expected"); 7101 Resync_To_End_Of_Statement; 7102 return Res; 7103 end case; 7104 7105 -- Timeout clause. 7106 case Current_Token is 7107 when Tok_On => 7108 Error_Msg_Parse ("only one sensitivity clause is allowed"); 7109 Resync_To_End_Of_Statement; 7110 return Res; 7111 when Tok_Until => 7112 Error_Msg_Parse ("only one condition clause is allowed"); 7113 Resync_To_End_Of_Statement; 7114 return Res; 7115 when Tok_For => 7116 Scan; 7117 Set_Timeout_Clause (Res, Parse_Expression); 7118 return Res; 7119 when Tok_Semi_Colon => 7120 return Res; 7121 when others => 7122 Error_Msg_Parse ("'for' or ';' expected"); 7123 Resync_To_End_Of_Statement; 7124 return Res; 7125 end case; 7126 end Parse_Wait_Statement; 7127 7128 -- precond : IF 7129 -- postcond: next token. 7130 -- 7131 -- [ LRM93 8.7 ] 7132 -- if_statement ::= 7133 -- [ IF_label : ] 7134 -- IF condition THEN 7135 -- sequence_of_statements 7136 -- { ELSIF condition THEN 7137 -- sequence_of_statements } 7138 -- [ ELSE 7139 -- sequence_of_statements ] 7140 -- END IF [ IF_label ] ; 7141 -- 7142 -- FIXME: end label. 7143 function Parse_If_Statement (Parent : Iir) return Iir_If_Statement 7144 is 7145 Res: Iir_If_Statement; 7146 Clause: Iir; 7147 N_Clause: Iir; 7148 Start_Loc, Then_Loc, End_Loc : Location_Type; 7149 begin 7150 Res := Create_Iir (Iir_Kind_If_Statement); 7151 Start_Loc := Get_Token_Location; 7152 Set_Location (Res, Start_Loc); 7153 Set_Parent (Res, Parent); 7154 7155 -- Eat 'if'. 7156 Scan; 7157 7158 Clause := Res; 7159 loop 7160 Set_Condition (Clause, Parse_Expression_Keyword); 7161 Then_Loc := Get_Token_Location; 7162 -- Eat 'then'. 7163 Expect_Scan (Tok_Then, "'then' is expected here"); 7164 7165 Set_Sequential_Statement_Chain 7166 (Clause, Parse_Sequential_Statements (Res)); 7167 7168 End_Loc := Get_Token_Location; 7169 7170 if Flag_Elocations then 7171 Create_Elocations (Clause); 7172 Set_Start_Location (Clause, Start_Loc); 7173 Set_Then_Location (Clause, Then_Loc); 7174 Set_End_Location (Clause, End_Loc); 7175 end if; 7176 7177 exit when Current_Token /= Tok_Else and Current_Token /= Tok_Elsif; 7178 7179 N_Clause := Create_Iir (Iir_Kind_Elsif); 7180 Start_Loc := Get_Token_Location; 7181 Set_Location (N_Clause, Start_Loc); 7182 Set_Else_Clause (Clause, N_Clause); 7183 Clause := N_Clause; 7184 if Current_Token = Tok_Else then 7185 7186 -- Skip 'else'. 7187 Scan; 7188 7189 Set_Sequential_Statement_Chain 7190 (Clause, Parse_Sequential_Statements (Res)); 7191 7192 if Flag_Elocations then 7193 Create_Elocations (Clause); 7194 Set_Start_Location (Clause, Start_Loc); 7195 Set_End_Location (Clause, Get_Token_Location); 7196 end if; 7197 7198 exit; 7199 else 7200 pragma Assert (Current_Token = Tok_Elsif); 7201 -- Skip 'elsif'. 7202 Scan; 7203 end if; 7204 end loop; 7205 7206 -- Skip 'end' 'if' 7207 Expect_Scan (Tok_End); 7208 Expect_Scan (Tok_If); 7209 7210 return Res; 7211 end Parse_If_Statement; 7212 7213 function Parenthesis_Name_To_Procedure_Call (Name: Iir; Kind : Iir_Kind) 7214 return Iir 7215 is 7216 Res: Iir; 7217 Call : Iir_Procedure_Call; 7218 Prefix : Iir; 7219 begin 7220 Res := Create_Iir (Kind); 7221 if Name = Null_Iir then 7222 Set_Location (Res); 7223 return Res; 7224 end if; 7225 7226 Location_Copy (Res, Name); 7227 Call := Create_Iir (Iir_Kind_Procedure_Call); 7228 Location_Copy (Call, Name); 7229 Set_Procedure_Call (Res, Call); 7230 case Get_Kind (Name) is 7231 when Iir_Kind_Parenthesis_Name => 7232 Prefix := Get_Prefix (Name); 7233 if Get_Kind (Prefix) = Iir_Kind_Operator_Symbol then 7234 Error_Msg_Parse 7235 (+Prefix, "operator cannot be used as procedure call"); 7236 end if; 7237 Set_Prefix (Call, Prefix); 7238 Set_Parameter_Association_Chain 7239 (Call, Get_Association_Chain (Name)); 7240 Free_Iir (Name); 7241 when Iir_Kind_Simple_Name 7242 | Iir_Kind_Selected_Name => 7243 Set_Prefix (Call, Name); 7244 when Iir_Kind_String_Literal8 => 7245 Error_Msg_Parse 7246 ("string or operator cannot be used as procedure call"); 7247 when Iir_Kind_Selected_By_All_Name 7248 | Iir_Kind_Qualified_Expression 7249 | Iir_Kind_Attribute_Name 7250 | Iir_Kind_Operator_Symbol 7251 | Iir_Kind_Signature => 7252 Error_Msg_Parse 7253 ("invalid name for a procedure call or missing assignment"); 7254 when others => 7255 Error_Kind ("parenthesis_name_to_procedure_call", Name); 7256 end case; 7257 return Res; 7258 end Parenthesis_Name_To_Procedure_Call; 7259 7260 -- precond : identifier 7261 -- postcond: next token 7262 -- 7263 -- [ LRM93 8.9 ] 7264 -- parameter_specification ::= identifier IN discrete_range 7265 function Parse_Parameter_Specification (Parent : Iir) 7266 return Iir_Iterator_Declaration 7267 is 7268 Decl : Iir_Iterator_Declaration; 7269 begin 7270 Decl := Create_Iir (Iir_Kind_Iterator_Declaration); 7271 Set_Parent (Decl, Parent); 7272 7273 -- Skip identifier 7274 Scan_Identifier (Decl); 7275 7276 -- Skip 'in' 7277 Expect_Scan (Tok_In); 7278 7279 Set_Discrete_Range (Decl, Parse_Discrete_Range); 7280 return Decl; 7281 end Parse_Parameter_Specification; 7282 7283 -- precond: delay_mechanism or waveform 7284 -- postcond: next token 7285 -- 7286 -- [ LRM93 8.4 ] 7287 -- signal_assignment_statement ::= 7288 -- [ label : ] target <= [ delay_mechanism ] waveform ; 7289 -- 7290 -- [ LRM08 10.5 Signal assignment statement ] 7291 -- simple_waveform_assignment ::= 7292 -- target <= [ delay_mechanism ] waveform ; 7293 function Parse_Signal_Waveform_Assignment 7294 (Target : Iir; Loc : Location_Type) return Iir 7295 is 7296 Stmt : Iir; 7297 N_Stmt : Iir; 7298 Wave_Chain : Iir; 7299 begin 7300 Stmt := Create_Iir (Iir_Kind_Simple_Signal_Assignment_Statement); 7301 Set_Location (Stmt, Loc); 7302 Set_Target (Stmt, Target); 7303 7304 Parse_Delay_Mechanism (Stmt); 7305 7306 Wave_Chain := Parse_Conditional_Waveforms; 7307 7308 -- LRM 8.4 Signal assignment statement 7309 -- It is an error is the reserved word UNAFFECTED appears as a 7310 -- waveform in a (sequential) signal assignment statement. 7311 if Get_Kind (Wave_Chain) = Iir_Kind_Unaffected_Waveform then 7312 if Flags.Vhdl_Std < Vhdl_08 then 7313 Error_Msg_Parse 7314 ("'unaffected' is not allowed in a sequential statement"); 7315 end if; 7316 Set_Waveform_Chain (Stmt, Wave_Chain); 7317 elsif Get_Kind (Wave_Chain) = Iir_Kind_Conditional_Waveform then 7318 if Flags.Vhdl_Std < Vhdl_08 then 7319 Error_Msg_Parse 7320 ("conditional signal assignment not allowed in before vhdl08"); 7321 end if; 7322 N_Stmt := 7323 Create_Iir (Iir_Kind_Conditional_Signal_Assignment_Statement); 7324 Location_Copy (N_Stmt, Stmt); 7325 Set_Target (N_Stmt, Target); 7326 Set_Delay_Mechanism (N_Stmt, Get_Delay_Mechanism (Stmt)); 7327 Set_Reject_Time_Expression 7328 (N_Stmt, Get_Reject_Time_Expression (Stmt)); 7329 Set_Conditional_Waveform_Chain (N_Stmt, Wave_Chain); 7330 Free_Iir (Stmt); 7331 Stmt := N_Stmt; 7332 else 7333 Set_Waveform_Chain (Stmt, Wave_Chain); 7334 end if; 7335 7336 return Stmt; 7337 end Parse_Signal_Waveform_Assignment; 7338 7339 -- precond: - 7340 -- postcond: next token 7341 -- 7342 -- [ LRM08 10.5.2 Simple signal assignments ] 7343 -- force_mode ::= IN | OUT 7344 procedure Parse_Force_Mode_Opt (Stmt : Iir) is 7345 begin 7346 case Current_Token is 7347 when Tok_In => 7348 Set_Force_Mode (Stmt, Iir_Force_In); 7349 Set_Has_Force_Mode (Stmt, True); 7350 when Tok_Out => 7351 Set_Force_Mode (Stmt, Iir_Force_Out); 7352 Set_Has_Force_Mode (Stmt, True); 7353 when others => 7354 null; 7355 end case; 7356 end Parse_Force_Mode_Opt; 7357 7358 -- precond: 'force' 7359 -- postcond: next token 7360 -- 7361 -- [ LRM08 10.5 Signal assignment statement ] 7362 -- simple_force_assignment ::= 7363 -- target <= FORCE [ force_mode ] expression ; 7364 function Parse_Signal_Force_Assignment 7365 (Target : Iir; Loc : Location_Type) return Iir 7366 is 7367 Stmt : Iir; 7368 begin 7369 Stmt := Create_Iir (Iir_Kind_Signal_Force_Assignment_Statement); 7370 Set_Location (Stmt, Loc); 7371 Set_Target (Stmt, Target); 7372 7373 -- Skip 'force'. 7374 Scan; 7375 7376 Parse_Force_Mode_Opt (Stmt); 7377 7378 Set_Expression (Stmt, Parse_Expression); 7379 7380 return Stmt; 7381 end Parse_Signal_Force_Assignment; 7382 7383 -- precond: 'release' 7384 -- postcond: next token 7385 -- 7386 -- [ LRM08 10.5 Signal assignment statement ] 7387 -- simple_release_assignment ::= 7388 -- target <= RELEASE [ force_mode ] expression ; 7389 function Parse_Signal_Release_Assignment 7390 (Target : Iir; Loc : Location_Type) return Iir 7391 is 7392 Stmt : Iir; 7393 begin 7394 Stmt := Create_Iir (Iir_Kind_Signal_Release_Assignment_Statement); 7395 Set_Location (Stmt, Loc); 7396 Set_Target (Stmt, Target); 7397 7398 -- Skip 'release'. 7399 Scan; 7400 7401 Parse_Force_Mode_Opt (Stmt); 7402 7403 return Stmt; 7404 end Parse_Signal_Release_Assignment; 7405 7406 -- precond: '<=' 7407 -- postcond: next token 7408 -- 7409 -- [ LRM93 8.4 ] 7410 -- signal_assignment_statement ::= 7411 -- [ label : ] target <= [ delay_mechanism ] waveform ; 7412 -- 7413 -- [ LRM08 10.5 Signal assignment statement ] 7414 -- signal_assignement_statement ::= 7415 -- [ label : ] simple_signal_assignement 7416 -- | [ label : ] conditional_signal_assignement 7417 -- | [ label : ] selected_signal_assignement 7418 -- 7419 -- simple_signal_assignment ::= 7420 -- simple_waveform_assignment 7421 -- | simple_force_assignment 7422 -- | simple_release_assignment 7423 function Parse_Signal_Assignment_Statement (Target : Iir) return Iir 7424 is 7425 Loc : Location_Type; 7426 begin 7427 Loc := Get_Token_Location; 7428 7429 -- Skip '<='. 7430 Scan; 7431 7432 case Current_Token is 7433 when Tok_Force => 7434 return Parse_Signal_Force_Assignment (Target, Loc); 7435 when Tok_Release => 7436 return Parse_Signal_Release_Assignment (Target, Loc); 7437 when others => 7438 return Parse_Signal_Waveform_Assignment (Target, Loc); 7439 end case; 7440 end Parse_Signal_Assignment_Statement; 7441 7442 -- precond: WHEN 7443 -- postcond: next token 7444 -- 7445 -- [ LRM08 10.5.3 Conditional signal assignments ] 7446 -- conditional_expressions ::= 7447 -- expression WHEN condition 7448 -- { ELSE expression WHEN condition } 7449 -- [ ELSE expression ] 7450 function Parse_Conditional_Expression_Chain (Expr : Iir) return Iir 7451 is 7452 Res : Iir; 7453 El, N_El : Iir; 7454 begin 7455 Res := Create_Iir (Iir_Kind_Conditional_Expression); 7456 Set_Location (Res); 7457 Set_Expression (Res, Expr); 7458 El := Res; 7459 7460 loop 7461 -- Skip 'when'. 7462 Scan; 7463 7464 Set_Condition (El, Parse_Expression); 7465 7466 exit when Current_Token /= Tok_Else; 7467 7468 N_El := Create_Iir (Iir_Kind_Conditional_Expression); 7469 Set_Location (N_El); 7470 Set_Chain (El, N_El); 7471 El := N_El; 7472 7473 -- Skip 'else'. 7474 Scan; 7475 7476 Set_Expression (N_El, Parse_Expression); 7477 7478 exit when Current_Token /= Tok_When; 7479 end loop; 7480 7481 return Res; 7482 end Parse_Conditional_Expression_Chain; 7483 7484 -- precond: ':=' 7485 -- postcond: next token 7486 -- 7487 -- [ LRM93 8.5 ] 7488 -- variable_assignment_statement ::= 7489 -- [ label : ] target := expression ; 7490 function Parse_Variable_Assignment_Statement (Target : Iir) return Iir 7491 is 7492 Stmt : Iir; 7493 Loc : Location_Type; 7494 Expr : Iir; 7495 begin 7496 Loc := Get_Token_Location; 7497 7498 -- Skip ':='. 7499 Scan; 7500 7501 Expr := Parse_Expression; 7502 7503 if Current_Token = Tok_When then 7504 if Flags.Vhdl_Std < Vhdl_08 then 7505 Error_Msg_Parse 7506 ("conditional variable assignment not allowed before vhdl08"); 7507 end if; 7508 Stmt := 7509 Create_Iir (Iir_Kind_Conditional_Variable_Assignment_Statement); 7510 Set_Location (Stmt, Loc); 7511 Set_Target (Stmt, Target); 7512 Set_Conditional_Expression_Chain 7513 (Stmt, Parse_Conditional_Expression_Chain (Expr)); 7514 else 7515 Stmt := Create_Iir (Iir_Kind_Variable_Assignment_Statement); 7516 Set_Location (Stmt, Loc); 7517 Set_Target (Stmt, Target); 7518 Set_Expression (Stmt, Expr); 7519 end if; 7520 return Stmt; 7521 end Parse_Variable_Assignment_Statement; 7522 7523 -- precond: '<=', ':=' or ';' 7524 -- postcond: next token 7525 function Parse_Sequential_Assignment_Statement (Target : Iir) return Iir 7526 is 7527 Stmt : Iir; 7528 Call : Iir; 7529 begin 7530 if Current_Token = Tok_Less_Equal then 7531 return Parse_Signal_Assignment_Statement (Target); 7532 elsif Current_Token = Tok_Assign then 7533 return Parse_Variable_Assignment_Statement (Target); 7534 elsif Current_Token = Tok_Semi_Colon then 7535 return Parenthesis_Name_To_Procedure_Call 7536 (Target, Iir_Kind_Procedure_Call_Statement); 7537 else 7538 Error_Msg_Parse 7539 ("""<="" or "":="" expected instead of %t", +Current_Token); 7540 Stmt := Create_Iir (Iir_Kind_Procedure_Call_Statement); 7541 Call := Create_Iir (Iir_Kind_Procedure_Call); 7542 Set_Prefix (Call, Target); 7543 Set_Procedure_Call (Stmt, Call); 7544 Set_Location (Call); 7545 Resync_To_End_Of_Statement; 7546 return Stmt; 7547 end if; 7548 end Parse_Sequential_Assignment_Statement; 7549 7550 -- precond: CASE 7551 -- postcond: ';' 7552 -- 7553 -- [ LRM93 8.8 ] 7554 -- case_statement ::= 7555 -- [ CASE_label : ] 7556 -- CASE expression IS 7557 -- case_statement_alternative 7558 -- { case_statement_alternative } 7559 -- END CASE [ CASE_label ] ; 7560 -- 7561 -- [ LRM93 8.8 ] 7562 -- case_statement_alternative ::= WHEN choices => sequence_of_statements 7563 function Parse_Case_Statement (Label : Name_Id) return Iir 7564 is 7565 Stmt : Iir; 7566 Assoc: Iir; 7567 First_Assoc, Last_Assoc : Iir; 7568 When_Loc : Location_Type; 7569 begin 7570 Stmt := Create_Iir (Iir_Kind_Case_Statement); 7571 Set_Label (Stmt, Label); 7572 Set_Location (Stmt); 7573 7574 -- Skip 'case'. 7575 Scan; 7576 7577 Set_Expression (Stmt, Parse_Case_Expression); 7578 7579 -- Skip 'is'. 7580 Expect_Scan (Tok_Is); 7581 7582 if Current_Token = Tok_End then 7583 Error_Msg_Parse ("missing alternative in case statement"); 7584 end if; 7585 7586 Chain_Init (First_Assoc, Last_Assoc); 7587 while Current_Token = Tok_When loop 7588 When_Loc := Get_Token_Location; 7589 7590 -- Skip 'when'. 7591 Scan; 7592 7593 Parse_Choices (Null_Iir, When_Loc, Assoc); 7594 7595 -- Skip '=>'. 7596 Expect_Scan (Tok_Double_Arrow); 7597 7598 Set_Associated_Chain (Assoc, Parse_Sequential_Statements (Stmt)); 7599 Chain_Append_Subchain (First_Assoc, Last_Assoc, Assoc); 7600 end loop; 7601 Set_Case_Statement_Alternative_Chain (Stmt, First_Assoc); 7602 7603 if Flag_Elocations then 7604 Create_Elocations (Stmt); 7605 Set_End_Location (Stmt, Get_Token_Location); 7606 end if; 7607 7608 -- Skip 'end', 'case'. 7609 Expect_Scan (Tok_End); 7610 Expect_Scan (Tok_Case); 7611 7612 if Flags.Vhdl_Std >= Vhdl_93 then 7613 Check_End_Name (Stmt); 7614 end if; 7615 7616 return Stmt; 7617 end Parse_Case_Statement; 7618 7619 -- precond: FOR 7620 -- postcond: ';' 7621 -- 7622 -- [ LRM93 8.9 ] 7623 -- loop_statement ::= 7624 -- [ LOOP_label : ] 7625 -- [ iteration_scheme ] LOOP 7626 -- sequence_of_statements 7627 -- END LOOP [ LOOP_label ] ; 7628 -- 7629 -- [ LRM93 8.9 ] 7630 -- iteration_scheme ::= WHILE condition 7631 -- | FOR LOOP_parameter_specification 7632 function Parse_For_Loop_Statement (Label : Name_Id) return Iir 7633 is 7634 Stmt : Iir; 7635 Start_Loc, Loop_Loc, End_Loc : Location_Type; 7636 begin 7637 Stmt := Create_Iir (Iir_Kind_For_Loop_Statement); 7638 Start_Loc := Get_Token_Location; 7639 Set_Location (Stmt, Start_Loc); 7640 Set_Label (Stmt, Label); 7641 7642 -- Skip 'for' 7643 Scan; 7644 7645 Set_Parameter_Specification 7646 (Stmt, Parse_Parameter_Specification (Stmt)); 7647 7648 -- Skip 'loop' 7649 Loop_Loc := Get_Token_Location; 7650 Expect (Tok_Loop); 7651 Scan; 7652 7653 Set_Sequential_Statement_Chain 7654 (Stmt, Parse_Sequential_Statements (Stmt)); 7655 7656 -- Skip 'end' 7657 End_Loc := Get_Token_Location; 7658 Expect_Scan (Tok_End); 7659 7660 -- Skip 'loop' 7661 Expect_Scan (Tok_Loop); 7662 7663 Check_End_Name (Stmt); 7664 7665 if Flag_Elocations then 7666 Create_Elocations (Stmt); 7667 Set_Start_Location (Stmt, Start_Loc); 7668 Set_Loop_Location (Stmt, Loop_Loc); 7669 Set_End_Location (Stmt, End_Loc); 7670 end if; 7671 7672 return Stmt; 7673 end Parse_For_Loop_Statement; 7674 7675 -- precond: WHILE or LOOP 7676 -- postcond: ';' 7677 -- 7678 -- [ 8.9 ] 7679 -- loop_statement ::= 7680 -- [ LOOP_label : ] 7681 -- [ iteration_scheme ] LOOP 7682 -- sequence_of_statements 7683 -- END LOOP [ LOOP_label ] ; 7684 function Parse_While_Loop_Statement (Label : Name_Id) return Iir 7685 is 7686 Stmt : Iir; 7687 Start_Loc, Loop_Loc, End_Loc : Location_Type; 7688 begin 7689 Stmt := Create_Iir (Iir_Kind_While_Loop_Statement); 7690 Start_Loc := Get_Token_Location; 7691 Set_Location (Stmt, Start_Loc); 7692 Set_Label (Stmt, Label); 7693 if Current_Token = Tok_While then 7694 -- Skip 'while'. 7695 Scan; 7696 7697 Set_Condition (Stmt, Parse_Expression); 7698 Expect (Tok_Loop); 7699 end if; 7700 7701 -- Skip 'loop'. 7702 Loop_Loc := Get_Token_Location; 7703 Scan; 7704 7705 Set_Sequential_Statement_Chain 7706 (Stmt, Parse_Sequential_Statements (Stmt)); 7707 7708 End_Loc := Get_Token_Location; 7709 7710 -- Skip 'end'. 7711 Expect_Scan (Tok_End); 7712 7713 -- Skip 'loop'. 7714 Expect_Scan (Tok_Loop); 7715 7716 Check_End_Name (Stmt); 7717 7718 if Flag_Elocations then 7719 Create_Elocations (Stmt); 7720 Set_Start_Location (Stmt, Start_Loc); 7721 Set_Loop_Location (Stmt, Loop_Loc); 7722 Set_End_Location (Stmt, End_Loc); 7723 end if; 7724 7725 return Stmt; 7726 end Parse_While_Loop_Statement; 7727 7728 -- AMS-LRM17 10.15 Break statement 7729 -- break_list ::= break_element { , break_element } 7730 -- 7731 -- break_element ::= 7732 -- [ break_selector_clause ] /quantity/_name => expression 7733 -- 7734 -- break_selector_clause ::= FOR /quantity/_name USE 7735 7736 function Parse_Break_List return Iir 7737 is 7738 First, Last : Iir; 7739 El : Iir; 7740 Sel : Iir; 7741 begin 7742 Chain_Init (First, Last); 7743 7744 loop 7745 case Current_Token is 7746 when Tok_For => 7747 -- break_selector_clause 7748 7749 -- Skip 'for'. 7750 Scan; 7751 7752 Sel := Parse_Name; 7753 7754 -- Skip 'use'. 7755 Expect_Scan (Tok_Use, "'use' expected after quantity name"); 7756 7757 when Tok_Identifier => 7758 -- No break_selector_clause. 7759 Sel := Null_Iir; 7760 7761 when others => 7762 -- No more break_element. 7763 exit; 7764 end case; 7765 7766 El := Create_Iir (Iir_Kind_Break_Element); 7767 Set_Selector_Quantity (El, Sel); 7768 7769 Set_Location (El); 7770 Set_Break_Quantity (El, Parse_Name); 7771 7772 Expect_Scan (Tok_Double_Arrow, "'=>' expected after quantity name"); 7773 Set_Expression (El, Parse_Expression); 7774 7775 Chain_Append (First, Last, El); 7776 7777 exit when Current_Token /= Tok_Comma; 7778 7779 -- Eat ',' 7780 Scan; 7781 end loop; 7782 7783 return First; 7784 end Parse_Break_List; 7785 7786 -- precond : BREAK 7787 -- postcond: ';' 7788 -- 7789 -- AMS-LRM17 10.15 Break statement 7790 -- break_statement ::= 7791 -- [ label : ] BREAK [ break_list ] [ WHEN condition ] ; 7792 function Parse_Break_Statement return Iir 7793 is 7794 Res: Iir; 7795 begin 7796 Res := Create_Iir (Iir_Kind_Break_Statement); 7797 Set_Location (Res); 7798 7799 -- Skip 'break'. 7800 Scan; 7801 7802 Set_Break_Element (Res, Parse_Break_List); 7803 7804 if Current_Token = Tok_When then 7805 -- Skip 'when'. 7806 Scan; 7807 7808 Set_Condition (Res, Parse_Expression); 7809 end if; 7810 7811 return Res; 7812 end Parse_Break_Statement; 7813 7814 -- precond: next token 7815 -- postcond: next token 7816 -- 7817 -- [ LRM93 8 ] 7818 -- sequence_of_statement ::= { sequential_statement } 7819 -- 7820 -- [ 8 ] 7821 -- sequential_statement ::= wait_statement 7822 -- | assertion_statement 7823 -- | report_statement 7824 -- | signal_assignment_statement 7825 -- | variable_assignment_statement 7826 -- | procedure_call_statement 7827 -- | if_statement 7828 -- | case_statement 7829 -- | loop_statement 7830 -- | next_statement 7831 -- | exit_statement 7832 -- | return_statement 7833 -- | null_statement 7834 -- | break_statement 7835 -- 7836 -- [ 8.13 ] 7837 -- null_statement ::= [ label : ] NULL ; 7838 -- 7839 -- [ 8.12 ] 7840 -- return_statement ::= [ label : ] RETURN [ expression ] 7841 -- 7842 -- [ 8.10 ] 7843 -- next_statement ::= [ label : ] NEXT [ LOOP_label ] [ WHEN condition ] ; 7844 -- 7845 -- [ 8.11 ] 7846 -- exit_statement ::= [ label : ] EXIT [ LOOP_label ] [ WHEN condition ] ; 7847 -- 7848 -- [ 8.9 ] 7849 -- loop_statement ::= 7850 -- [ LOOP_label : ] 7851 -- [ iteration_scheme ] LOOP 7852 -- sequence_of_statements 7853 -- END LOOP [ LOOP_label ] ; 7854 -- 7855 -- [ 8.9 ] 7856 -- iteration_scheme ::= WHILE condition 7857 -- | FOR LOOP_parameter_specification 7858 -- 7859 -- [ 8.2 ] 7860 -- assertion_statement ::= [ label : ] assertion ; 7861 -- 7862 -- [ 8.3 ] 7863 -- report_statement ::= [ label : ] REPORT expression SEVERITY expression ; 7864 function Parse_Sequential_Statements (Parent : Iir) return Iir 7865 is 7866 First_Stmt : Iir; 7867 Last_Stmt : Iir; 7868 Stmt: Iir; 7869 Label: Name_Id; 7870 Loc : Location_Type; 7871 Target : Iir; 7872 begin 7873 First_Stmt := Null_Iir; 7874 Last_Stmt := Null_Iir; 7875 -- Expect a current_token. 7876 loop 7877 Loc := Get_Token_Location; 7878 if Current_Token = Tok_Identifier then 7879 Label := Current_Identifier; 7880 7881 -- Skip identifier. 7882 Scan; 7883 7884 if Current_Token = Tok_Colon then 7885 -- Skip ':'. 7886 Scan; 7887 else 7888 Target := Create_Iir (Iir_Kind_Simple_Name); 7889 Set_Identifier (Target, Label); 7890 Set_Location (Target, Loc); 7891 Label := Null_Identifier; 7892 Target := Parse_Name_Suffix (Target, True); 7893 Stmt := Parse_Sequential_Assignment_Statement (Target); 7894 goto Has_Stmt; 7895 end if; 7896 else 7897 Label := Null_Identifier; 7898 end if; 7899 7900 case Current_Token is 7901 when Tok_Null => 7902 Stmt := Create_Iir (Iir_Kind_Null_Statement); 7903 7904 -- Skip 'null'. 7905 Scan; 7906 7907 when Tok_Assert => 7908 Stmt := Create_Iir (Iir_Kind_Assertion_Statement); 7909 Parse_Assertion (Stmt); 7910 when Tok_Report => 7911 Stmt := Parse_Report_Statement; 7912 when Tok_If => 7913 Stmt := Parse_If_Statement (Parent); 7914 Set_Label (Stmt, Label); 7915 Set_Location (Stmt, Loc); 7916 if Flags.Vhdl_Std >= Vhdl_93 then 7917 Check_End_Name (Stmt); 7918 end if; 7919 when Tok_Case => 7920 Stmt := Parse_Case_Statement (Label); 7921 when Tok_Identifier 7922 | Tok_String => 7923 -- String for an expanded name with operator_symbol prefix. 7924 Stmt := Parse_Sequential_Assignment_Statement (Parse_Name); 7925 when Tok_Left_Paren => 7926 declare 7927 Target : Iir; 7928 begin 7929 Target := Parse_Aggregate; 7930 if Current_Token = Tok_Less_Equal then 7931 Stmt := Parse_Signal_Assignment_Statement (Target); 7932 elsif Current_Token = Tok_Assign then 7933 Stmt := Parse_Variable_Assignment_Statement (Target); 7934 else 7935 Error_Msg_Parse ("'<=' or ':=' expected"); 7936 return First_Stmt; 7937 end if; 7938 end; 7939 7940 when Tok_Return => 7941 Stmt := Create_Iir (Iir_Kind_Return_Statement); 7942 7943 -- Skip return. 7944 Scan; 7945 7946 if Current_Token /= Tok_Semi_Colon then 7947 Set_Expression (Stmt, Parse_Expression); 7948 end if; 7949 7950 when Tok_For => 7951 Stmt := Parse_For_Loop_Statement (Label); 7952 Set_Location (Stmt, Loc); 7953 7954 -- A loop statement can have a label, even in vhdl87. 7955 Label := Null_Identifier; 7956 7957 when Tok_While 7958 | Tok_Loop => 7959 Stmt := Parse_While_Loop_Statement (Label); 7960 Set_Location (Stmt, Loc); 7961 7962 -- A loop statement can have a label, even in vhdl87. 7963 Label := Null_Identifier; 7964 7965 when Tok_Next 7966 | Tok_Exit => 7967 if Current_Token = Tok_Next then 7968 Stmt := Create_Iir (Iir_Kind_Next_Statement); 7969 else 7970 Stmt := Create_Iir (Iir_Kind_Exit_Statement); 7971 end if; 7972 7973 -- Skip 'next' or 'exit'. 7974 Scan; 7975 7976 if Current_Token = Tok_Identifier then 7977 Set_Loop_Label (Stmt, Parse_Name (Allow_Indexes => False)); 7978 end if; 7979 7980 if Current_Token = Tok_When then 7981 -- Skip 'when'. 7982 Scan; 7983 7984 Set_Condition (Stmt, Parse_Expression); 7985 end if; 7986 7987 when Tok_Wait => 7988 Stmt := Parse_Wait_Statement; 7989 7990 when Tok_Break => 7991 Stmt := Parse_Break_Statement; 7992 7993 when Tok_Semi_Colon => 7994 Error_Msg_Parse ("extra ';' ignored"); 7995 7996 -- Eat ';' 7997 Scan; 7998 7999 goto Again; 8000 when Tok_Constant 8001 | Tok_Variable 8002 | Tok_Signal 8003 | Tok_Alias 8004 | Tok_File 8005 | Tok_Attribute => 8006 Error_Msg_Parse ("declaration not allowed within statements"); 8007 Scan; 8008 Resync_To_End_Of_Declaration; 8009 goto Again; 8010 8011 when Tok_Begin => 8012 Error_Msg_Parse ("'begin' not allowed within statements"); 8013 Scan; 8014 goto Again; 8015 8016 when Tok_Tick => 8017 Unexpected ("statement"); 8018 Resync_To_End_Of_Statement; 8019 goto Again; 8020 8021 when others => 8022 return First_Stmt; 8023 end case; 8024 << Has_Stmt >> null; 8025 Set_Parent (Stmt, Parent); 8026 Set_Location (Stmt, Loc); 8027 if Label /= Null_Identifier then 8028 if Flags.Vhdl_Std = Vhdl_87 then 8029 Error_Msg_Parse 8030 (+Stmt, "this statement can't have a label in vhdl 87"); 8031 else 8032 Set_Label (Stmt, Label); 8033 end if; 8034 end if; 8035 8036 if Current_Token = Tok_Semi_Colon then 8037 -- Skip ';'. 8038 Scan; 8039 else 8040 Error_Missing_Semi_Colon ("statement"); 8041 Resync_To_End_Of_Statement; 8042 if Current_Token = Tok_Semi_Colon then 8043 -- Skip ';'. 8044 Scan; 8045 end if; 8046 end if; 8047 8048 -- Append it to the chain. 8049 if First_Stmt = Null_Iir then 8050 First_Stmt := Stmt; 8051 else 8052 Set_Chain (Last_Stmt, Stmt); 8053 end if; 8054 Last_Stmt := Stmt; 8055 8056 <<Again>> null; 8057 end loop; 8058 end Parse_Sequential_Statements; 8059 8060 procedure Parse_Subprogram_Body (Subprg : Iir; Is_Loc : Location_Type) 8061 is 8062 Kind : constant Iir_Kind := Get_Kind (Subprg); 8063 Subprg_Body : Iir; 8064 Begin_Loc, End_Loc : Location_Type; 8065 begin 8066 -- The body. 8067 Set_Has_Body (Subprg, True); 8068 if Kind = Iir_Kind_Function_Declaration then 8069 Subprg_Body := Create_Iir (Iir_Kind_Function_Body); 8070 else 8071 Subprg_Body := Create_Iir (Iir_Kind_Procedure_Body); 8072 end if; 8073 Location_Copy (Subprg_Body, Subprg); 8074 8075 Set_Subprogram_Body (Subprg, Subprg_Body); 8076 Set_Subprogram_Specification (Subprg_Body, Subprg); 8077 Set_Chain (Subprg, Subprg_Body); 8078 8079 Parse_Declarative_Part (Subprg_Body, Subprg_Body); 8080 8081 -- Skip 'begin'. 8082 Begin_Loc := Get_Token_Location; 8083 Expect_Scan (Tok_Begin); 8084 8085 Set_Sequential_Statement_Chain 8086 (Subprg_Body, Parse_Sequential_Statements (Subprg_Body)); 8087 8088 -- Skip 'end'. 8089 End_Loc := Get_Token_Location; 8090 Expect_Scan (Tok_End); 8091 8092 if Flag_Elocations then 8093 Create_Elocations (Subprg_Body); 8094 Set_Is_Location (Subprg_Body, Is_Loc); 8095 Set_Begin_Location (Subprg_Body, Begin_Loc); 8096 Set_End_Location (Subprg_Body, End_Loc); 8097 end if; 8098 8099 case Current_Token is 8100 when Tok_Function => 8101 if Flags.Vhdl_Std = Vhdl_87 then 8102 Error_Msg_Parse ("'function' not allowed here by vhdl 87"); 8103 end if; 8104 if Kind = Iir_Kind_Procedure_Declaration then 8105 Error_Msg_Parse ("'procedure' expected instead of 'function'"); 8106 end if; 8107 Set_End_Has_Reserved_Id (Subprg_Body, True); 8108 8109 -- Skip 'function'. 8110 Scan; 8111 8112 when Tok_Procedure => 8113 if Flags.Vhdl_Std = Vhdl_87 then 8114 Error_Msg_Parse ("'procedure' not allowed here by vhdl 87"); 8115 end if; 8116 if Kind = Iir_Kind_Function_Declaration then 8117 Error_Msg_Parse ("'function' expected instead of 'procedure'"); 8118 end if; 8119 Set_End_Has_Reserved_Id (Subprg_Body, True); 8120 8121 -- Skip 'procedure' 8122 Scan; 8123 8124 when others => 8125 null; 8126 end case; 8127 case Current_Token is 8128 when Tok_Identifier => 8129 Check_End_Name (Get_Identifier (Subprg), Subprg_Body); 8130 when Tok_String => 8131 if Scan_To_Operator_Name (Get_Token_Location) 8132 /= Get_Identifier (Subprg) 8133 then 8134 Error_Msg_Parse ("misspelling, %i expected", +Subprg); 8135 end if; 8136 Set_End_Has_Identifier (Subprg_Body, True); 8137 8138 -- Skip string. 8139 Scan; 8140 8141 when others => 8142 null; 8143 end case; 8144 Scan_Semi_Colon_Declaration ("subprogram body"); 8145 end Parse_Subprogram_Body; 8146 8147 -- precond : NEW 8148 -- 8149 -- LRM08 4.4 Subprogram instantiation declarations 8150 -- subprogram_instantiation_declaration ::= 8151 -- subprogram_kind designator IS 8152 -- NEW uninstantiated_subprogram_name [ signature ] 8153 -- [ generic_map_aspect ]; 8154 function Parse_Subprogram_Instantiation (Subprg : Iir) return Iir 8155 is 8156 Res : Iir; 8157 begin 8158 case Iir_Kinds_Subprogram_Declaration (Get_Kind (Subprg)) is 8159 when Iir_Kind_Function_Declaration => 8160 Res := Create_Iir (Iir_Kind_Function_Instantiation_Declaration); 8161 if Get_Has_Pure (Subprg) then 8162 Error_Msg_Parse 8163 (+Subprg, "pure/impure not allowed for instantiations"); 8164 end if; 8165 if Get_Return_Type_Mark (Subprg) /= Null_Iir then 8166 Error_Msg_Parse 8167 (+Subprg, "return type not allowed for instantiations"); 8168 end if; 8169 when Iir_Kind_Procedure_Declaration => 8170 Res := Create_Iir (Iir_Kind_Procedure_Instantiation_Declaration); 8171 end case; 8172 Location_Copy (Res, Subprg); 8173 Set_Identifier (Res, Get_Identifier (Subprg)); 8174 8175 if Get_Interface_Declaration_Chain (Subprg) /= Null_Iir then 8176 Error_Msg_Parse 8177 (+Subprg, "interfaces not allowed for instantiations"); 8178 end if; 8179 8180 -- Skip 'new'. 8181 Scan; 8182 8183 Set_Uninstantiated_Subprogram_Name (Res, Parse_Signature_Name); 8184 8185 if Current_Token = Tok_Generic then 8186 Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); 8187 end if; 8188 8189 -- Skip ';'. 8190 Expect_Scan (Tok_Semi_Colon); 8191 8192 return Res; 8193 end Parse_Subprogram_Instantiation; 8194 8195 -- precond : PROCEDURE, FUNCTION, PURE or IMPURE. 8196 -- postcond: next token. 8197 -- 8198 -- [ LRM93 2.1 ] 8199 -- subprogram_declaration ::= subprogram_specification ; 8200 -- 8201 -- [ LRM93 2.1 ] 8202 -- subprogram_specification ::= 8203 -- PROCEDURE designator [ ( formal_parameter_list ) ] 8204 -- | [ PURE | IMPURE ] FUNCTION designator [ ( formal_parameter_list ) ] 8205 -- RETURN type_mark 8206 -- 8207 -- [ LRM93 2.2 ] 8208 -- subprogram_body ::= 8209 -- subprogram_specification IS 8210 -- subprogram_declarative_part 8211 -- BEGIN 8212 -- subprogram_statement_part 8213 -- END [ subprogram_kind ] [ designator ] ; 8214 -- 8215 -- [ LRM93 2.1 ] 8216 -- designator ::= identifier | operator_symbol 8217 -- 8218 -- [ LRM93 2.1 ] 8219 -- operator_symbol ::= string_literal 8220 function Parse_Subprogram_Declaration return Iir 8221 is 8222 Kind : Iir_Kind; 8223 Subprg : Iir; 8224 Gen : Iir; 8225 Start_Loc, Is_Loc : Location_Type; 8226 begin 8227 -- Create the node. 8228 Start_Loc := Get_Token_Location; 8229 case Current_Token is 8230 when Tok_Procedure => 8231 Kind := Iir_Kind_Procedure_Declaration; 8232 when Tok_Function 8233 | Tok_Pure 8234 | Tok_Impure => 8235 Kind := Iir_Kind_Function_Declaration; 8236 when others => 8237 raise Internal_Error; 8238 end case; 8239 Subprg := Create_Iir (Kind); 8240 Set_Location (Subprg); 8241 Set_Implicit_Definition (Subprg, Iir_Predefined_None); 8242 8243 case Current_Token is 8244 when Tok_Procedure => 8245 null; 8246 when Tok_Function => 8247 -- LRM93 2.1 8248 -- A function is impure if its specification contains the 8249 -- reserved word IMPURE; otherwise it is said to be pure. 8250 Set_Pure_Flag (Subprg, True); 8251 when Tok_Pure 8252 | Tok_Impure => 8253 Set_Pure_Flag (Subprg, Current_Token = Tok_Pure); 8254 if Flags.Vhdl_Std = Vhdl_87 then 8255 Error_Msg_Parse 8256 ("'pure' and 'impure' are not allowed in vhdl 87"); 8257 end if; 8258 Set_Has_Pure (Subprg, True); 8259 -- FIXME: what to do in case of error ?? 8260 8261 -- Eat 'pure' or 'impure'. 8262 Scan; 8263 8264 Expect (Tok_Function, "'function' must follow 'pure' or 'impure'"); 8265 when others => 8266 raise Internal_Error; 8267 end case; 8268 8269 -- Eat 'procedure' or 'function'. 8270 Scan; 8271 8272 -- Designator. 8273 Parse_Subprogram_Designator (Subprg); 8274 8275 if Current_Token = Tok_Generic then 8276 -- Eat 'generic' 8277 Scan; 8278 8279 Gen := Parse_Interface_List (Generic_Interface_List, Subprg); 8280 Set_Generic_Chain (Subprg, Gen); 8281 end if; 8282 8283 Parse_Subprogram_Parameters_And_Return 8284 (Subprg, Kind = Iir_Kind_Function_Declaration, False); 8285 8286 if Flag_Elocations then 8287 Create_Elocations (Subprg); 8288 Set_Start_Location (Subprg, Start_Loc); 8289 end if; 8290 8291 case Current_Token is 8292 when Tok_Is => 8293 -- Skip 'is'. 8294 Is_Loc := Get_Token_Location; 8295 Scan; 8296 8297 if Current_Token = Tok_New then 8298 return Parse_Subprogram_Instantiation (Subprg); 8299 end if; 8300 when Tok_Begin => 8301 Error_Msg_Parse ("missing 'is' before 'begin'"); 8302 Is_Loc := Get_Token_Location; 8303 when others => 8304 if Kind = Iir_Kind_Function_Declaration then 8305 Check_Function_Specification (Subprg); 8306 end if; 8307 8308 -- Skip ';'. 8309 Expect_Scan (Tok_Semi_Colon); 8310 8311 return Subprg; 8312 end case; 8313 8314 if Kind = Iir_Kind_Function_Declaration then 8315 Check_Function_Specification (Subprg); 8316 end if; 8317 8318 -- The body. 8319 Parse_Subprogram_Body (Subprg, Is_Loc); 8320 return Subprg; 8321 end Parse_Subprogram_Declaration; 8322 8323 -- precond: PROCESS 8324 -- postcond: next token 8325 -- 8326 -- [ LRM87 9.2 / LRM08 11.3 ] 8327 -- process_statement ::= 8328 -- [ PROCESS_label : ] 8329 -- [ POSTPONED ] PROCESS [ ( process_sensitivity_list ) ] [ IS ] 8330 -- process_declarative_part 8331 -- BEGIN 8332 -- process_statement_part 8333 -- END [ POSTPONED ] PROCESS [ PROCESS_label ] ; 8334 -- 8335 -- process_sensitivity_list ::= ALL | sensitivity_list 8336 function Parse_Process_Statement 8337 (Label: Name_Id; Loc : Location_Type; Is_Postponed : Boolean) 8338 return Iir 8339 is 8340 Res: Iir; 8341 Sensitivity_List : Iir_List; 8342 Start_Loc, Begin_Loc, End_Loc : Location_Type; 8343 begin 8344 Start_Loc := Get_Token_Location; 8345 8346 -- Skip 'process' 8347 Scan; 8348 8349 if Current_Token = Tok_Left_Paren then 8350 Res := Create_Iir (Iir_Kind_Sensitized_Process_Statement); 8351 8352 -- Skip '(' 8353 Scan; 8354 8355 if Current_Token = Tok_All then 8356 if Vhdl_Std < Vhdl_08 then 8357 Error_Msg_Parse 8358 ("all sensitized process allowed only in vhdl 08"); 8359 end if; 8360 Sensitivity_List := Iir_List_All; 8361 8362 -- Skip 'all' 8363 Scan; 8364 else 8365 Sensitivity_List := Parse_Sensitivity_List; 8366 end if; 8367 Set_Sensitivity_List (Res, Sensitivity_List); 8368 8369 -- Skip ')' 8370 Expect_Scan (Tok_Right_Paren); 8371 else 8372 Res := Create_Iir (Iir_Kind_Process_Statement); 8373 end if; 8374 8375 Set_Location (Res, Loc); 8376 Set_Label (Res, Label); 8377 Set_Has_Label (Res, Label /= Null_Identifier); 8378 8379 if Current_Token = Tok_Is then 8380 if Flags.Vhdl_Std = Vhdl_87 then 8381 Error_Msg_Parse ("""is"" not allowed here by vhdl 87"); 8382 end if; 8383 Set_Has_Is (Res, True); 8384 8385 -- Skip 'is' 8386 Scan; 8387 end if; 8388 8389 -- Declarative part. 8390 Parse_Declarative_Part (Res, Res); 8391 8392 -- Skip 'begin'. 8393 Begin_Loc := Get_Token_Location; 8394 Expect_Scan (Tok_Begin); 8395 8396 Set_Sequential_Statement_Chain (Res, Parse_Sequential_Statements (Res)); 8397 8398 -- Skip 'end'. 8399 End_Loc := Get_Token_Location; 8400 Expect_Scan (Tok_End); 8401 8402 if Current_Token = Tok_Postponed then 8403 if not Is_Postponed then 8404 -- LRM93 9.2 8405 -- If the reserved word POSTPONED appears at the end of a process 8406 -- statement, the process must be a postponed process. 8407 Error_Msg_Parse ("process is not a postponed process"); 8408 end if; 8409 8410 Set_End_Has_Postponed (Res, True); 8411 8412 -- Skip 'postponed', 8413 Scan; 8414 end if; 8415 8416 if Current_Token = Tok_Semi_Colon then 8417 Error_Msg_Parse ("""end"" must be followed by ""process"""); 8418 8419 -- Skip ';'. 8420 Scan; 8421 else 8422 Scan_End_Token (Tok_Process, Res); 8423 Check_End_Name (Res); 8424 Expect_Scan (Tok_Semi_Colon, "';' expected at end of process"); 8425 end if; 8426 8427 if Flag_Elocations then 8428 Create_Elocations (Res); 8429 Set_Start_Location (Res, Start_Loc); 8430 Set_Begin_Location (Res, Begin_Loc); 8431 Set_End_Location (Res, End_Loc); 8432 end if; 8433 8434 return Res; 8435 end Parse_Process_Statement; 8436 8437 function Check_Formal_Form (Formal : Iir) return Iir is 8438 begin 8439 if Formal = Null_Iir then 8440 return Formal; 8441 end if; 8442 8443 case Get_Kind (Formal) is 8444 when Iir_Kind_Simple_Name 8445 | Iir_Kind_Slice_Name 8446 | Iir_Kind_Selected_Name => 8447 return Formal; 8448 when Iir_Kind_Parenthesis_Name => 8449 -- Could be an indexed name, so nothing to check within the 8450 -- parenthesis. 8451 declare 8452 Assoc : constant Iir := Get_Association_Chain (Formal); 8453 begin 8454 if Assoc /= Null_Iir then 8455 Set_In_Formal_Flag (Assoc, True); 8456 end if; 8457 end; 8458 return Formal; 8459 when Iir_Kind_String_Literal8 => 8460 -- Operator designator 8461 return String_To_Operator_Symbol (Formal); 8462 when others => 8463 Error_Msg_Parse (+Formal, "incorrect formal name ignored"); 8464 return Null_Iir; 8465 end case; 8466 end Check_Formal_Form; 8467 8468 -- precond : NEXT_TOKEN 8469 -- postcond: NEXT_TOKEN 8470 -- 8471 -- [ LRM93 4.3.2.2 ] 8472 -- association_list ::= association_element { , association_element } 8473 -- 8474 -- [ LRM93 4.3.2.2 ] 8475 -- association_element ::= [ formal_part => ] actual_part 8476 -- 8477 -- [ LRM93 4.3.2.2 ] 8478 -- actual_part ::= actual_designator 8479 -- | FUNCTION_name ( actual_designator ) 8480 -- | type_mark ( actual_designator ) 8481 -- 8482 -- [ LRM93 4.3.2.2 ] 8483 -- actual_designator ::= expression 8484 -- | SIGNAL_name 8485 -- | VARIABLE_name 8486 -- | FILE_name 8487 -- | OPEN 8488 -- 8489 -- [ LRM93 4.3.2.2 ] 8490 -- formal_part ::= formal_designator 8491 -- | FUNCTION_name ( formal_designator ) 8492 -- | type_mark ( formal_designator ) 8493 -- 8494 -- [ LRM93 4.3.2.2 ] 8495 -- formal_designator ::= GENERIC_name 8496 -- | PORT_name 8497 -- | PARAMETER_name 8498 -- 8499 -- Note: an actual part is parsed as an expression. 8500 function Parse_Association_List return Iir 8501 is 8502 Res, Last: Iir; 8503 El: Iir; 8504 Formal: Iir; 8505 Actual: Iir; 8506 Nbr_Assocs : Natural; 8507 Loc : Location_Type; 8508 Arrow_Loc : Location_Type; 8509 Comma_Loc : Location_Type; 8510 begin 8511 Chain_Init (Res, Last); 8512 8513 if Current_Token = Tok_Right_Paren then 8514 Error_Msg_Parse ("empty association list is not allowed"); 8515 return Res; 8516 end if; 8517 8518 Nbr_Assocs := 1; 8519 loop 8520 -- Parse formal and actual. 8521 Loc := Get_Token_Location; 8522 Arrow_Loc := No_Location; 8523 Formal := Null_Iir; 8524 8525 if Current_Token /= Tok_Open then 8526 Actual := Parse_Expression; 8527 case Current_Token is 8528 when Tok_To 8529 | Tok_Downto => 8530 -- To/downto can appear in slice name. 8531 8532 if Actual = Null_Iir then 8533 -- Left expression is missing ie: (downto x). 8534 Scan; 8535 Actual := Parse_Expression; 8536 else 8537 Actual := Parse_Range_Expression (Actual); 8538 end if; 8539 if Nbr_Assocs /= 1 then 8540 Error_Msg_Parse ("multi-dimensional slice is forbidden"); 8541 end if; 8542 8543 when Tok_Range => 8544 Actual := Parse_Subtype_Indication (Actual); 8545 8546 when Tok_Double_Arrow => 8547 -- Check that FORMAL is a name and not an expression. 8548 Formal := Check_Formal_Form (Actual); 8549 Arrow_Loc := Get_Token_Location; 8550 8551 -- Skip '=>' 8552 Scan; 8553 Loc := Get_Token_Location; 8554 8555 if Current_Token /= Tok_Open then 8556 Actual := Parse_Expression; 8557 end if; 8558 8559 when others => 8560 null; 8561 end case; 8562 end if; 8563 8564 if Current_Token = Tok_Open then 8565 El := Create_Iir (Iir_Kind_Association_Element_Open); 8566 Set_Location (El); 8567 8568 -- Skip 'open' 8569 Scan; 8570 else 8571 El := Create_Iir (Iir_Kind_Association_Element_By_Expression); 8572 Set_Location (El, Loc); 8573 Set_Actual (El, Actual); 8574 end if; 8575 Set_Formal (El, Formal); 8576 8577 if Flag_Elocations then 8578 Create_Elocations (El); 8579 Set_Arrow_Location (El, Arrow_Loc); 8580 end if; 8581 8582 Chain_Append (Res, Last, El); 8583 exit when Current_Token /= Tok_Comma; 8584 8585 -- Eat ','. 8586 Comma_Loc := Get_Token_Location; 8587 Scan; 8588 8589 if Current_Token = Tok_Right_Paren then 8590 Error_Msg_Parse (Comma_Loc, "extra ',' ignored"); 8591 exit; 8592 end if; 8593 8594 Nbr_Assocs := Nbr_Assocs + 1; 8595 end loop; 8596 8597 return Res; 8598 end Parse_Association_List; 8599 8600 -- precond : NEXT_TOKEN 8601 -- postcond: NEXT_TOKEN 8602 -- 8603 -- Parse: '(' association_list ')' 8604 function Parse_Association_List_In_Parenthesis return Iir 8605 is 8606 Res : Iir; 8607 begin 8608 -- Skip '(' 8609 Expect_Scan (Tok_Left_Paren); 8610 8611 Res := Parse_Association_List; 8612 8613 -- Skip ')' 8614 Expect_Scan (Tok_Right_Paren); 8615 8616 return Res; 8617 end Parse_Association_List_In_Parenthesis; 8618 8619 -- precond : GENERIC 8620 -- postcond: next token 8621 -- 8622 -- [ LRM93 5.2.1.2, LRM08 6.5.7.2 ] 8623 -- generic_map_aspect ::= GENERIC MAP ( GENERIC_association_list ) 8624 function Parse_Generic_Map_Aspect return Iir is 8625 begin 8626 -- Skip 'generic'. 8627 Expect_Scan (Tok_Generic); 8628 8629 -- Skip 'map'. 8630 Expect_Scan (Tok_Map); 8631 8632 return Parse_Association_List_In_Parenthesis; 8633 end Parse_Generic_Map_Aspect; 8634 8635 -- precond : PORT 8636 -- postcond: next token 8637 -- 8638 -- [ LRM93 5.2.1.2 ] 8639 -- port_map_aspect ::= PORT MAP ( PORT_association_list ) 8640 function Parse_Port_Map_Aspect return Iir is 8641 begin 8642 -- Skip 'port'. 8643 Expect_Scan (Tok_Port); 8644 8645 -- Skip 'map'. 8646 Expect_Scan (Tok_Map); 8647 8648 return Parse_Association_List_In_Parenthesis; 8649 end Parse_Port_Map_Aspect; 8650 8651 -- precond : COMPONENT | ENTIY | CONFIGURATION 8652 -- postcond : next_token 8653 -- 8654 -- instantiated_unit ::= 8655 -- [ COMPONENT ] component_name 8656 -- | ENTITY entity_name [ ( architecture_identifier ) ] 8657 -- | CONFIGURATION configuration_name 8658 function Parse_Instantiated_Unit return Iir 8659 is 8660 Res : Iir; 8661 begin 8662 if Flags.Vhdl_Std = Vhdl_87 then 8663 Report_Start_Group; 8664 Error_Msg_Parse 8665 ("component instantiation using keyword 'component', 'entity',"); 8666 Error_Msg_Parse (" or 'configuration' is not allowed in vhdl87"); 8667 Report_End_Group; 8668 end if; 8669 8670 case Current_Token is 8671 when Tok_Component => 8672 -- Eat 'component'. 8673 Scan; 8674 8675 return Parse_Name (False); 8676 8677 when Tok_Entity => 8678 Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity); 8679 Set_Location (Res); 8680 8681 -- Eat 'entity'. 8682 Scan; 8683 8684 Set_Entity_Name (Res, Parse_Name (False)); 8685 if Current_Token = Tok_Left_Paren then 8686 -- Skip '('. 8687 Scan; 8688 8689 if Current_Token = Tok_Identifier then 8690 Set_Architecture (Res, Parse_Simple_Name); 8691 else 8692 Expect (Tok_Identifier, "identifier for architecture"); 8693 end if; 8694 8695 -- Skip ')'. 8696 Expect_Scan (Tok_Right_Paren); 8697 end if; 8698 return Res; 8699 8700 when Tok_Configuration => 8701 Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration); 8702 Set_Location (Res); 8703 8704 -- Skip 'configuration. 8705 Scan; 8706 8707 Expect (Tok_Identifier); 8708 Set_Configuration_Name (Res, Parse_Name (False)); 8709 return Res; 8710 8711 when others => 8712 raise Internal_Error; 8713 end case; 8714 end Parse_Instantiated_Unit; 8715 8716 -- precond : next token 8717 -- postcond: next token 8718 -- 8719 -- component_instantiation_statement ::= 8720 -- INSTANTIATION_label : 8721 -- instantiated_unit [ generic_map_aspect ] [ port_map_aspect ] ; 8722 function Parse_Component_Instantiation (Name: Iir) 8723 return Iir_Component_Instantiation_Statement 8724 is 8725 Res: Iir_Component_Instantiation_Statement; 8726 begin 8727 Res := Create_Iir (Iir_Kind_Component_Instantiation_Statement); 8728 Set_Location (Res); 8729 8730 Set_Instantiated_Unit (Res, Name); 8731 8732 if Current_Token = Tok_Generic then 8733 Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); 8734 end if; 8735 if Current_Token = Tok_Port then 8736 Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect); 8737 end if; 8738 Expect_Scan (Tok_Semi_Colon); 8739 return Res; 8740 end Parse_Component_Instantiation; 8741 8742 -- precond : next token 8743 -- postcond: next token 8744 -- 8745 -- [ LRM93 9.1 ] 8746 -- block_header ::= [ generic_clause [ generic_map_aspect ; ] ] 8747 -- [ port_clause [ port_map_aspect ; ] ] 8748 function Parse_Block_Header return Iir_Block_Header is 8749 Res : Iir_Block_Header; 8750 begin 8751 Res := Create_Iir (Iir_Kind_Block_Header); 8752 Set_Location (Res); 8753 if Current_Token = Tok_Generic then 8754 Parse_Generic_Clause (Res); 8755 if Current_Token = Tok_Generic then 8756 Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); 8757 Scan_Semi_Colon ("generic map aspect"); 8758 end if; 8759 end if; 8760 if Current_Token = Tok_Port then 8761 Parse_Port_Clause (Res); 8762 if Current_Token = Tok_Port then 8763 Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect); 8764 Scan_Semi_Colon ("port map aspect"); 8765 end if; 8766 end if; 8767 return Res; 8768 end Parse_Block_Header; 8769 8770 -- precond : BLOCK 8771 -- postcond: ';' 8772 -- 8773 -- [ LRM93 9.1 ] 8774 -- block_statement ::= 8775 -- BLOCK_label : 8776 -- BLOCK [ ( GUARD_expression ) ] [ IS ] 8777 -- block_header 8778 -- block_declarative_part 8779 -- BEGIN 8780 -- block_statement_part 8781 -- END BLOCK [ BLOCK_label ] ; 8782 -- 8783 -- [ LRM93 9.1 ] 8784 -- block_declarative_part ::= { block_declarative_item } 8785 -- 8786 -- [ LRM93 9.1 ] 8787 -- block_statement_part ::= { concurrent_statement } 8788 function Parse_Block_Statement (Label: Name_Id; Loc : Location_Type) 8789 return Iir_Block_Statement 8790 is 8791 Res : Iir_Block_Statement; 8792 Guard : Iir_Guard_Signal_Declaration; 8793 Begin_Loc : Location_Type; 8794 begin 8795 if Label = Null_Identifier then 8796 Error_Msg_Parse ("a block statement must have a label"); 8797 end if; 8798 8799 -- block was just parsed. 8800 Res := Create_Iir (Iir_Kind_Block_Statement); 8801 Set_Location (Res, Loc); 8802 Set_Label (Res, Label); 8803 8804 -- Eat 'block'. 8805 Scan; 8806 8807 if Current_Token = Tok_Left_Paren then 8808 Guard := Create_Iir (Iir_Kind_Guard_Signal_Declaration); 8809 Set_Location (Guard); 8810 Set_Guard_Decl (Res, Guard); 8811 8812 -- Eat '('. 8813 Scan; 8814 8815 Set_Guard_Expression (Guard, Parse_Expression); 8816 8817 -- Eat ')'. 8818 Expect_Scan (Tok_Right_Paren, "')' expected after guard expression"); 8819 end if; 8820 8821 if Current_Token = Tok_Is then 8822 if Flags.Vhdl_Std = Vhdl_87 then 8823 Error_Msg_Parse ("'is' not allowed here in vhdl87"); 8824 end if; 8825 8826 Set_Has_Is (Res, True); 8827 8828 -- Eat 'is'. 8829 Scan; 8830 end if; 8831 if Current_Token = Tok_Generic or Current_Token = Tok_Port then 8832 Set_Block_Header (Res, Parse_Block_Header); 8833 end if; 8834 if Current_Token /= Tok_Begin then 8835 Parse_Declarative_Part (Res, Res); 8836 end if; 8837 8838 Begin_Loc := Get_Token_Location; 8839 8840 -- Eat 'begin'. 8841 Expect_Scan (Tok_Begin); 8842 8843 Parse_Concurrent_Statements (Res); 8844 8845 if Flag_Elocations then 8846 Create_Elocations (Res); 8847 Set_Begin_Location (Res, Begin_Loc); 8848 Set_End_Location (Res, Get_Token_Location); 8849 end if; 8850 8851 Check_End_Name (Tok_Block, Res); 8852 Expect_Scan (Tok_Semi_Colon); 8853 8854 return Res; 8855 end Parse_Block_Statement; 8856 8857 -- Precond : next token 8858 -- Postcond: next token after 'end' 8859 -- 8860 -- [ LRM08 11.8 ] Generate statements 8861 -- generate_statement_body ::= 8862 -- [ block_declarative_part 8863 -- BEGIN ] 8864 -- { concurrent_statement } 8865 -- [ END [ alternative_label ] ; ] 8866 -- 8867 -- This corresponds to the following part of LRM93 9.7: 8868 -- [ { block_declarative_item } 8869 -- BEGIN ] 8870 -- { concurrent_statement } 8871 -- Note there is no END. This part is followed by: 8872 -- END GENERATE [ /generate/_label ] ; 8873 procedure Parse_Generate_Statement_Body (Parent : Iir; 8874 Label : Name_Id; 8875 Bod : out Iir; 8876 End_Loc : out Location_Type) 8877 is 8878 function Is_Early_End return Boolean is 8879 begin 8880 case Current_Token is 8881 when Tok_Elsif 8882 | Tok_Else => 8883 if Get_Kind (Parent) = Iir_Kind_If_Generate_Statement then 8884 return True; 8885 end if; 8886 when Tok_When => 8887 if Get_Kind (Parent) = Iir_Kind_Case_Generate_Statement then 8888 return True; 8889 end if; 8890 when others => 8891 null; 8892 end case; 8893 return False; 8894 end Is_Early_End; 8895 begin 8896 Bod := Create_Iir (Iir_Kind_Generate_Statement_Body); 8897 Set_Location (Bod); 8898 Set_Parent (Bod, Parent); 8899 Set_Alternative_Label (Bod, Label); 8900 Set_Has_Label (Bod, Label /= Null_Identifier); 8901 End_Loc := No_Location; 8902 8903 if Flag_Elocations then 8904 Create_Elocations (Bod); 8905 end if; 8906 8907 -- Check for a block declarative item. 8908 case Current_Token is 8909 when 8910 -- subprogram_declaration 8911 -- subprogram_body 8912 Tok_Procedure 8913 | Tok_Function 8914 | Tok_Pure 8915 | Tok_Impure 8916 -- type_declaration 8917 | Tok_Type 8918 -- subtype_declaration 8919 | Tok_Subtype 8920 -- constant_declaration 8921 | Tok_Constant 8922 -- signal_declaration 8923 | Tok_Signal 8924 -- shared_variable_declaration 8925 | Tok_Shared 8926 | Tok_Variable 8927 -- file_declaration 8928 | Tok_File 8929 -- alias_declaration 8930 | Tok_Alias 8931 -- component_declaration 8932 | Tok_Component 8933 -- attribute_declaration 8934 -- attribute_specification 8935 | Tok_Attribute 8936 -- configuration_specification 8937 | Tok_For 8938 -- disconnection_specification 8939 | Tok_Disconnect 8940 -- use_clause 8941 | Tok_Use 8942 -- group_template_declaration 8943 -- group_declaration 8944 | Tok_Group 8945 | Tok_Begin => 8946 if Flags.Vhdl_Std = Vhdl_87 then 8947 Error_Msg_Parse 8948 ("declarations not allowed in a generate in vhdl87"); 8949 end if; 8950 Parse_Declarative_Part (Bod, Bod); 8951 Expect (Tok_Begin); 8952 Set_Has_Begin (Bod, True); 8953 8954 if Flag_Elocations then 8955 Set_Begin_Location (Bod, Get_Token_Location); 8956 end if; 8957 8958 -- Skip 'begin' 8959 Scan; 8960 when others => 8961 null; 8962 end case; 8963 8964 Parse_Concurrent_Statements (Bod); 8965 8966 -- Return now if no 'end' (and not expected). 8967 if Is_Early_End then 8968 return; 8969 end if; 8970 8971 -- Skip 'end' 8972 End_Loc := Get_Token_Location; 8973 Expect_Scan (Tok_End); 8974 8975 if Vhdl_Std >= Vhdl_08 and then Current_Token /= Tok_Generate then 8976 -- This is the 'end' of the generate_statement_body. 8977 Set_Has_End (Bod, True); 8978 if Flag_Elocations then 8979 Set_End_Location (Bod, End_Loc); 8980 end if; 8981 8982 Check_End_Name (Label, Bod); 8983 Scan_Semi_Colon ("generate statement body"); 8984 8985 -- Return now if no 'end' (and not expected). 8986 if Is_Early_End then 8987 return; 8988 end if; 8989 8990 Expect (Tok_End); 8991 End_Loc := Get_Token_Location; 8992 8993 -- Skip 'end' 8994 Scan; 8995 end if; 8996 end Parse_Generate_Statement_Body; 8997 8998 -- precond : FOR 8999 -- postcond: ';' 9000 -- 9001 -- [ LRM93 9.7 ] 9002 -- generate_statement ::= 9003 -- GENERATE_label : generation_scheme GENERATE 9004 -- [ { block_declarative_item } 9005 -- BEGIN ] 9006 -- { concurrent_statement } 9007 -- END GENERATE [ GENERATE_label ] ; 9008 -- 9009 -- [ LRM93 9.7 ] 9010 -- generation_scheme ::= 9011 -- FOR GENERATE_parameter_specification 9012 -- | IF condition 9013 -- 9014 -- [ LRM08 11.8 ] 9015 -- for_generate_statement ::= 9016 -- /generate/_label : 9017 -- FOR /generate/_parameter_specification GENERATE 9018 -- generate_statement_body 9019 -- END GENERATE [ /generate/_label ] ; 9020 -- 9021 -- FIXME: block_declarative item. 9022 function Parse_For_Generate_Statement (Label : Name_Id; Loc : Location_Type) 9023 return Iir 9024 is 9025 Res : Iir; 9026 Bod : Iir; 9027 Start_Loc, Generate_Loc, End_Loc : Location_Type; 9028 begin 9029 if Label = Null_Identifier then 9030 Error_Msg_Parse ("a generate statement must have a label"); 9031 end if; 9032 Res := Create_Iir (Iir_Kind_For_Generate_Statement); 9033 Set_Location (Res, Loc); 9034 Set_Label (Res, Label); 9035 Start_Loc := Get_Token_Location; 9036 9037 -- Skip 'for' 9038 Scan; 9039 9040 Set_Parameter_Specification (Res, Parse_Parameter_Specification (Res)); 9041 9042 -- Skip 'generate' 9043 Expect (Tok_Generate); 9044 Generate_Loc := Get_Token_Location; 9045 Scan; 9046 9047 Parse_Generate_Statement_Body (Res, Null_Identifier, Bod, End_Loc); 9048 Set_Generate_Statement_Body (Res, Bod); 9049 9050 -- Skip 'generate' 9051 Expect_Scan (Tok_Generate); 9052 Set_End_Has_Reserved_Id (Res, True); 9053 9054 -- LRM93 9.7 9055 -- If a label appears at the end of a generate statement, it must repeat 9056 -- the generate label. 9057 Check_End_Name (Res); 9058 Expect_Scan (Tok_Semi_Colon); 9059 9060 if Flag_Elocations then 9061 Create_Elocations (Res); 9062 Set_Start_Location (Res, Start_Loc); 9063 Set_Generate_Location (Res, Generate_Loc); 9064 Set_End_Location (Res, End_Loc); 9065 end if; 9066 9067 return Res; 9068 end Parse_For_Generate_Statement; 9069 9070 -- precond : IF 9071 -- postcond: ';' 9072 -- 9073 -- [ LRM93 9.7 ] 9074 -- generate_statement ::= 9075 -- /generate/_label : generation_scheme GENERATE 9076 -- [ { block_declarative_item } 9077 -- BEGIN ] 9078 -- { concurrent_statement } 9079 -- END GENERATE [ /generate/_label ] ; 9080 -- 9081 -- [ LRM93 9.7 ] 9082 -- generation_scheme ::= 9083 -- FOR GENERATE_parameter_specification 9084 -- | IF condition 9085 -- 9086 -- [ LRM08 11.8 ] 9087 -- if_generate_statement ::= 9088 -- /generate/_label : 9089 -- IF [ /alternative/_label : ] condition GENERATE 9090 -- generate_statement_body 9091 -- { ELSIF [ /alternative/_label : ] condition GENERATE 9092 -- generate_statement_body } 9093 -- [ ELSE [ /alternative/_label : ] GENERATE 9094 -- generate_statement_body ] 9095 -- END GENERATE [ /generate/_label ] ; 9096 function Parse_If_Generate_Statement (Label : Name_Id; Loc : Location_Type) 9097 return Iir_Generate_Statement 9098 is 9099 Res : Iir_Generate_Statement; 9100 Alt_Label : Name_Id; 9101 Alt_Loc : Location_Type; 9102 Cond : Iir; 9103 Clause : Iir; 9104 Bod : Iir; 9105 Last : Iir; 9106 Start_Loc, Generate_Loc, End_Loc : Location_Type; 9107 begin 9108 Start_Loc := Get_Token_Location; 9109 9110 -- Skip 'if'. 9111 Scan; 9112 9113 Cond := Parse_Expression; 9114 9115 -- AMS-VHDL simultaneous if statement. 9116 if Current_Token = Tok_Use then 9117 if not AMS_Vhdl then 9118 Error_Msg_Parse ("if/use is an AMS-VHDL statement"); 9119 end if; 9120 return Parse_Simultaneous_If_Statement (Label, Loc, Start_Loc, Cond); 9121 end if; 9122 9123 if Label = Null_Identifier then 9124 Error_Msg_Parse (Start_Loc, "a generate statement must have a label"); 9125 end if; 9126 Res := Create_Iir (Iir_Kind_If_Generate_Statement); 9127 Set_Location (Res, Loc); 9128 Set_Label (Res, Label); 9129 9130 Clause := Res; 9131 Last := Null_Iir; 9132 loop 9133 Alt_Label := Null_Identifier; 9134 if Current_Token = Tok_Colon then 9135 if Get_Kind (Cond) = Iir_Kind_Simple_Name then 9136 if Vhdl_Std < Vhdl_08 then 9137 Error_Msg_Parse 9138 ("alternative label not allowed before vhdl08"); 9139 end if; 9140 9141 -- In fact the parsed condition was an alternate label. 9142 Alt_Label := Get_Identifier (Cond); 9143 Alt_Loc := Get_Location (Cond); 9144 Free_Iir (Cond); 9145 else 9146 Error_Msg_Parse ("alternative label must be an identifier"); 9147 Free_Iir (Cond); 9148 end if; 9149 9150 -- Skip ':' 9151 Scan; 9152 9153 Cond := Parse_Expression; 9154 end if; 9155 9156 Set_Condition (Clause, Cond); 9157 9158 -- Skip 'generate' 9159 Generate_Loc := Get_Token_Location; 9160 case Current_Token is 9161 when Tok_Generate => 9162 -- Skip 'generate'. 9163 Scan; 9164 when Tok_Then => 9165 Expect_Error (Tok_Generate); 9166 -- Skip 'then'. 9167 Scan; 9168 when others => 9169 Expect_Error (Tok_Generate); 9170 end case; 9171 9172 Parse_Generate_Statement_Body (Res, Alt_Label, Bod, End_Loc); 9173 9174 if Alt_Label /= Null_Identifier then 9175 -- Set location on the label, for xrefs. 9176 Set_Location (Bod, Alt_Loc); 9177 end if; 9178 9179 Set_Generate_Statement_Body (Clause, Bod); 9180 9181 -- Append clause to the generate statement. 9182 if Last /= Null_Iir then 9183 Set_Generate_Else_Clause (Last, Clause); 9184 end if; 9185 Last := Clause; 9186 9187 if Flag_Elocations then 9188 Create_Elocations (Clause); 9189 Set_Start_Location (Clause, Start_Loc); 9190 Set_Generate_Location (Clause, Generate_Loc); 9191 Set_End_Location (Clause, End_Loc); 9192 end if; 9193 9194 exit when Current_Token /= Tok_Elsif; 9195 9196 -- Create new alternative. 9197 Clause := Create_Iir (Iir_Kind_If_Generate_Statement); 9198 Set_Location (Clause, Loc); 9199 Start_Loc := Get_Token_Location; 9200 9201 -- Skip 'elsif' 9202 Scan; 9203 9204 Cond := Parse_Expression; 9205 end loop; 9206 9207 if Current_Token = Tok_Else then 9208 if Vhdl_Std < Vhdl_08 then 9209 Error_Msg_Parse ("else generate not allowed before vhdl08"); 9210 end if; 9211 9212 Clause := Create_Iir (Iir_Kind_If_Generate_Else_Clause); 9213 Start_Loc := Get_Token_Location; 9214 Set_Location (Clause, Start_Loc); 9215 9216 -- Skip 'else' 9217 Scan; 9218 9219 if Current_Token = Tok_Identifier then 9220 Alt_Label := Current_Identifier; 9221 Alt_Loc := Get_Token_Location; 9222 9223 -- Skip identifier 9224 Scan; 9225 9226 -- Skip ':' 9227 Expect_Scan (Tok_Colon); 9228 else 9229 Alt_Label := Null_Identifier; 9230 end if; 9231 9232 -- Skip 'generate' 9233 Generate_Loc := Get_Token_Location; 9234 Expect_Scan (Tok_Generate); 9235 9236 Parse_Generate_Statement_Body (Res, Alt_Label, Bod, End_Loc); 9237 if Alt_Label /= Null_Identifier then 9238 -- Set location on the label, for xrefs. 9239 Set_Location (Bod, Alt_Loc); 9240 end if; 9241 9242 Set_Generate_Statement_Body (Clause, Bod); 9243 9244 Set_Generate_Else_Clause (Last, Clause); 9245 9246 if Flag_Elocations then 9247 Create_Elocations (Clause); 9248 Set_Start_Location (Clause, Start_Loc); 9249 Set_Generate_Location (Clause, Generate_Loc); 9250 Set_End_Location (Clause, End_Loc); 9251 end if; 9252 end if; 9253 9254 -- Skip 'generate' 9255 case Current_Token is 9256 when Tok_Generate => 9257 Scan; 9258 Set_End_Has_Reserved_Id (Res, True); 9259 when Tok_If => 9260 Expect_Error (Tok_Generate); 9261 -- Skip 'then'. 9262 Scan; 9263 Set_End_Has_Reserved_Id (Res, True); 9264 when others => 9265 Expect_Error (Tok_Generate); 9266 end case; 9267 9268 -- LRM93 9.7 9269 -- If a label appears at the end of a generate statement, it must repeat 9270 -- the generate label. 9271 Check_End_Name (Res); 9272 Expect_Scan (Tok_Semi_Colon); 9273 return Res; 9274 end Parse_If_Generate_Statement; 9275 9276 -- precond : WHEN 9277 -- postcond: ? 9278 -- 9279 -- [ LRM08 11.8 ] 9280 -- case_generate_alternative ::= 9281 -- WHEN [ /alternative/_label : ] choices => 9282 -- generate_statement_body 9283 procedure Parse_Case_Generate_Alternative (Parent : Iir; Assoc : out Iir) 9284 is 9285 Loc : Location_Type; 9286 Alt_Label : Name_Id; 9287 Bod : Iir; 9288 Expr : Iir; 9289 End_Loc : Location_Type; 9290 begin 9291 Loc := Get_Token_Location; 9292 9293 -- Eat 'when' 9294 Expect (Tok_When); 9295 Scan; 9296 9297 Alt_Label := Null_Identifier; 9298 if Current_Token = Tok_Double_Arrow then 9299 Error_Msg_Parse ("missing expression in alternative"); 9300 Assoc := Create_Iir (Iir_Kind_Choice_By_Expression); 9301 Set_Location (Assoc); 9302 elsif Current_Token = Tok_Others then 9303 -- 'others' is not an expression! 9304 Parse_Choices (Null_Iir, Loc, Assoc); 9305 else 9306 Expr := Parse_Expression; 9307 9308 if Current_Token = Tok_Colon then 9309 if Get_Kind (Expr) = Iir_Kind_Simple_Name then 9310 -- In fact the parsed condition was an alternate label. 9311 Alt_Label := Get_Identifier (Expr); 9312 Loc := Get_Location (Expr); 9313 Free_Iir (Expr); 9314 else 9315 Error_Msg_Parse ("alternative label must be an identifier"); 9316 Free_Iir (Expr); 9317 end if; 9318 9319 Expr := Null_Iir; 9320 9321 -- Skip ':' 9322 Scan; 9323 end if; 9324 9325 Parse_Choices (Expr, Loc, Assoc); 9326 end if; 9327 9328 -- Set location of label (if any, for xref) or location of 'when'. 9329 Set_Location (Assoc, Loc); 9330 9331 -- Eat '=>' 9332 Expect_Scan (Tok_Double_Arrow); 9333 9334 Parse_Generate_Statement_Body (Parent, Alt_Label, Bod, End_Loc); 9335 Set_Associated_Block (Assoc, Bod); 9336 if Alt_Label /= Null_Identifier then 9337 -- Set location on the label, for xrefs. 9338 Set_Location (Bod, Loc); 9339 end if; 9340 end Parse_Case_Generate_Alternative; 9341 9342 -- precond : CASE 9343 -- postcond: ';' 9344 -- 9345 -- [ LRM08 11.8 ] 9346 -- case_generate_statement ::= 9347 -- /generate/_label : 9348 -- CASE expression GENERATE 9349 -- case_generate_alternative 9350 -- { case_generate_alternative } 9351 -- END GENERATE [ /generate/_label ] ; 9352 function Parse_Case_Generate_Statement 9353 (Label : Name_Id; Loc : Location_Type) return Iir 9354 is 9355 Res : Iir; 9356 Alt : Iir; 9357 Last_Alt : Iir; 9358 Expr : Iir; 9359 Start_Loc : Location_Type; 9360 begin 9361 Start_Loc := Get_Token_Location; 9362 9363 -- Skip 'case'. 9364 Scan; 9365 9366 Expr := Parse_Case_Expression; 9367 9368 if Current_Token = Tok_Use then 9369 if not AMS_Vhdl then 9370 Error_Msg_Parse ("if/use is an AMS-VHDL statement"); 9371 end if; 9372 return Parse_Simultaneous_Case_Statement (Label, Loc, Expr); 9373 end if; 9374 9375 if Label = Null_Identifier then 9376 Error_Msg_Parse (Start_Loc, "a generate statement must have a label"); 9377 end if; 9378 9379 Res := Create_Iir (Iir_Kind_Case_Generate_Statement); 9380 Set_Location (Res, Loc); 9381 Set_Label (Res, Label); 9382 Set_Expression (Res, Expr); 9383 9384 -- Skip 'generate' 9385 Expect_Scan (Tok_Generate); 9386 9387 if Current_Token = Tok_End then 9388 Error_Msg_Parse ("no generate alternative"); 9389 end if; 9390 9391 Last_Alt := Null_Iir; 9392 while Current_Token = Tok_When loop 9393 Parse_Case_Generate_Alternative (Res, Alt); 9394 if Last_Alt = Null_Iir then 9395 Set_Case_Statement_Alternative_Chain (Res, Alt); 9396 else 9397 Set_Chain (Last_Alt, Alt); 9398 end if; 9399 9400 -- Skip until last choice of the choices list. 9401 loop 9402 Last_Alt := Alt; 9403 Alt := Get_Chain (Alt); 9404 exit when Alt = Null_Iir; 9405 end loop; 9406 end loop; 9407 9408 -- Skip 'generate' 9409 Expect_Scan (Tok_Generate); 9410 Set_End_Has_Reserved_Id (Res, True); 9411 9412 -- LRM93 9.7 9413 -- If a label appears at the end of a generate statement, it must repeat 9414 -- the generate label. 9415 Check_End_Name (Res); 9416 Expect_Scan (Tok_Semi_Colon); 9417 9418 return Res; 9419 end Parse_Case_Generate_Statement; 9420 9421 -- AMS-LRM17 11.10 Simple simultaneous statement 9422 -- simple_simultaneous_statement ::= 9423 -- [ label : ] simple_expression == simple_expression 9424 -- [ tolerance_aspect ] ; 9425 function Parse_Simple_Simultaneous_Statement (Name : Iir) return Iir 9426 is 9427 Res : Iir; 9428 begin 9429 Res := Create_Iir (Iir_Kind_Simple_Simultaneous_Statement); 9430 Set_Simultaneous_Left 9431 (Res, Parse_Binary_Expression (Name, Prio_Simple)); 9432 Set_Location (Res); 9433 Expect_Scan (Tok_Equal_Equal, "'==' expected after expression"); 9434 Set_Simultaneous_Right (Res, Parse_Expression (Prio_Simple)); 9435 Set_Tolerance (Res, Parse_Tolerance_Aspect_Opt); 9436 Expect_Scan (Tok_Semi_Colon); 9437 return Res; 9438 end Parse_Simple_Simultaneous_Statement; 9439 9440 -- AMS-LRM17 11.13 Simultaneous procedural statement 9441 -- simultaneous_procedural_statement ::= 9442 -- [ procedural_label : ] 9443 -- PROCEDURAL [ IS ] 9444 -- procedural_declarative_part 9445 -- BEGIN 9446 -- procedural_statement_part 9447 -- END PROCEDURAL [ procedural_label ] ; 9448 function Parse_Simultaneous_Procedural_Statement (Label : Name_Id) 9449 return Iir 9450 is 9451 Res: Iir; 9452 Start_Loc, Is_Loc, Begin_Loc, End_Loc : Location_Type; 9453 begin 9454 Start_Loc := Get_Token_Location; 9455 Res := Create_Iir (Iir_Kind_Simultaneous_Procedural_Statement); 9456 Set_Location (Res, Start_Loc); 9457 Set_Label (Res, Label); 9458 9459 -- Skip 'procedural'. 9460 Scan; 9461 9462 if Current_Token = Tok_Is then 9463 Is_Loc := Get_Token_Location; 9464 Set_Has_Is (Res, True); 9465 9466 -- Skip 'is'. 9467 Scan; 9468 end if; 9469 9470 Parse_Declarative_Part (Res, Res); 9471 9472 -- Skip 'begin'. 9473 Begin_Loc := Get_Token_Location; 9474 Expect_Scan (Tok_Begin); 9475 9476 Set_Sequential_Statement_Chain 9477 (Res, Parse_Sequential_Statements (Res)); 9478 9479 -- Skip 'end'. 9480 End_Loc := Get_Token_Location; 9481 Expect_Scan (Tok_End); 9482 9483 -- Skip 'procedural'. 9484 Expect_Scan (Tok_Procedural, "missing 'procedural' after 'end'"); 9485 Set_End_Has_Reserved_Id (Res, True); 9486 9487 Check_End_Name (Res); 9488 9489 if Flag_Elocations then 9490 Create_Elocations (Res); 9491 Set_Start_Location (Res, Start_Loc); 9492 Set_Is_Location (Res, Is_Loc); 9493 Set_Begin_Location (Res, Begin_Loc); 9494 Set_End_Location (Res, End_Loc); 9495 end if; 9496 9497 Scan_Semi_Colon_Declaration ("procedural statement"); 9498 9499 return Res; 9500 end Parse_Simultaneous_Procedural_Statement; 9501 9502 -- precond : NULL 9503 -- 9504 -- AMS-LRM17 11.14 Simultaneous null statement 9505 -- simultaneous_null_statement ::= 9506 -- [ label : ] NULL ; 9507 function Parse_Simultaneous_Null_Statement 9508 (Label : Name_Id; Loc : Location_Type) return Iir 9509 is 9510 Res : Iir; 9511 begin 9512 Res := Create_Iir (Iir_Kind_Simultaneous_Null_Statement); 9513 Set_Location (Res, Loc); 9514 Set_Label (Res, Label); 9515 9516 -- Skip 'procedural'. 9517 Scan; 9518 9519 Scan_Semi_Colon_Declaration ("null statement"); 9520 9521 return Res; 9522 end Parse_Simultaneous_Null_Statement; 9523 9524 -- precond : first token 9525 -- postcond: next token 9526 -- 9527 -- [ LRM93 9.3 ] 9528 -- concurrent_procedure_call_statement ::= 9529 -- [ label : ] [ POSTPONED ] procedure_call ; 9530 -- 9531 -- [ LRM93 9.5 ] 9532 -- concurrent_signal_assignment_statement ::= 9533 -- [ label : ] [ POSTPONED ] conditional_signal_assignment 9534 -- | [ label : ] [ POSTPONED ] selected_signal_assignment 9535 function Parse_Concurrent_Assignment (Target : Iir) return Iir 9536 is 9537 Res : Iir; 9538 begin 9539 case Current_Token is 9540 when Tok_Less_Equal 9541 | Tok_Assign => 9542 -- This is a conditional signal assignment. 9543 -- Error for ':=' is handled by the subprogram. 9544 return Parse_Concurrent_Conditional_Signal_Assignment (Target); 9545 when Tok_Semi_Colon => 9546 -- a procedure call or a component instantiation. 9547 -- Parse it as a procedure call, may be revert to a 9548 -- component instantiation during sem. 9549 Res := Parenthesis_Name_To_Procedure_Call 9550 (Target, Iir_Kind_Concurrent_Procedure_Call_Statement); 9551 9552 -- Skip ';'. 9553 Scan; 9554 9555 return Res; 9556 when Tok_Generic | Tok_Port => 9557 -- or a component instantiation. 9558 return Parse_Component_Instantiation (Target); 9559 when others => 9560 -- Catch PSL clock declaration. Within comments, this is the 9561 -- right place (and handled as a concurrent statement). After 9562 -- vhdl08, it is a declaration. 9563 if Get_Kind (Target) = Iir_Kind_Simple_Name 9564 and then Get_Identifier (Target) = Name_Default 9565 and then Current_Token = Tok_Identifier 9566 and then Current_Identifier = Name_Clock 9567 then 9568 Error_Msg_Parse (+Target, "PSL default clock is a declaration"); 9569 9570 Current_Token := Tok_Psl_Clock; 9571 Res := Parse_Psl_Default_Clock_Cont 9572 (Get_Location (Target), False); 9573 9574 return Res; 9575 end if; 9576 9577 -- or a simple simultaneous statement 9578 if AMS_Vhdl then 9579 return Parse_Simple_Simultaneous_Statement (Target); 9580 else 9581 return Parse_Concurrent_Conditional_Signal_Assignment 9582 (Parse_Binary_Expression (Target, Prio_Simple)); 9583 end if; 9584 end case; 9585 end Parse_Concurrent_Assignment; 9586 9587 function Parse_Name_From_Identifier (Name : Name_Id; Loc : Location_Type) 9588 return Iir 9589 is 9590 Target : Iir; 9591 begin 9592 Target := Create_Iir (Iir_Kind_Simple_Name); 9593 Set_Location (Target, Loc); 9594 Set_Identifier (Target, Name); 9595 return Parse_Name_Suffix (Target); 9596 end Parse_Name_From_Identifier; 9597 9598 function Parse_Concurrent_Assignment_With_Name 9599 (Name : Name_Id; Loc : Location_Type) return Iir 9600 is 9601 Target : Iir; 9602 begin 9603 Target := Parse_Name_From_Identifier (Name, Loc); 9604 return Parse_Concurrent_Assignment (Target); 9605 end Parse_Concurrent_Assignment_With_Name; 9606 9607 -- AMS-LRM17 11.9 Concurrent break statement 9608 -- concurrent_break_statement ::= 9609 -- [ label : ] BREAK [ break_list ] [ sensitivity_clause ] 9610 -- [ WHEN condition ] ; 9611 function Parse_Concurrent_Break_Statement (Label : Name_Id; 9612 Loc : Location_Type) return Iir 9613 is 9614 Res : Iir; 9615 begin 9616 Res := Create_Iir (Iir_Kind_Concurrent_Break_Statement); 9617 Set_Location (Res, Loc); 9618 Set_Label (Res, Label); 9619 9620 -- Skip 'break'. 9621 Scan; 9622 9623 Set_Break_Element (Res, Parse_Break_List); 9624 9625 if Current_Token = Tok_On then 9626 -- Sensitivity list. 9627 -- Skip 'on'. 9628 Scan; 9629 9630 Set_Sensitivity_List (Res, Parse_Sensitivity_List); 9631 end if; 9632 9633 if Current_Token = Tok_When then 9634 -- Condition. 9635 -- Skip 'when'. 9636 Scan; 9637 9638 Set_Condition (Res, Parse_Expression); 9639 end if; 9640 9641 -- Skip ';'. 9642 Expect_Scan (Tok_Semi_Colon); 9643 9644 return Res; 9645 end Parse_Concurrent_Break_Statement; 9646 9647 -- AMS-LRM17 11 Architecture statements 9648 -- simultaneous_statement ::= 9649 -- simple_simultaneous_statement 9650 -- | simultaneous_if_statement 9651 -- | simultaneous_case_statement 9652 -- | simultaneous_procedural_statement 9653 -- | simultaneous_null_statement 9654 -- 9655 -- simultaneous_statement_part ::= 9656 -- { simultaneous_statement } 9657 function Parse_Simultaneous_Statements (Parent : Iir) return Iir 9658 is 9659 First_Stmt, Last_Stmt : Iir; 9660 Stmt: Iir; 9661 Label: Name_Id; 9662 Loc : Location_Type; 9663 Start_Loc : Location_Type; 9664 Expr : Iir; 9665 begin 9666 Chain_Init (First_Stmt, Last_Stmt); 9667 loop 9668 Stmt := Null_Iir; 9669 Label := Null_Identifier; 9670 Loc := Get_Token_Location; 9671 9672 -- Try to find a label. 9673 if Current_Token = Tok_Identifier then 9674 Label := Current_Identifier; 9675 9676 -- Skip identifier 9677 Scan; 9678 9679 if Current_Token = Tok_Colon then 9680 -- The identifier is really a label. 9681 9682 -- Skip ':' 9683 Scan; 9684 else 9685 -- This is not a label. Assume a concurrent assignment. 9686 Expr := Parse_Name_From_Identifier (Label, Loc); 9687 Stmt := Parse_Simple_Simultaneous_Statement (Expr); 9688 Label := Null_Identifier; 9689 goto Has_Stmt; 9690 end if; 9691 end if; 9692 9693 case Current_Token is 9694 when Tok_End | Tok_Else | Tok_Elsif | Tok_When => 9695 -- End of list. 'else', 'elseif' and 'when' can be used to 9696 -- separate statements in a generate statement. 9697 if Label /= Null_Identifier then 9698 Error_Msg_Parse ("label is not allowed here"); 9699 end if; 9700 return First_Stmt; 9701 when Tok_Identifier => 9702 -- FIXME: sign, factor, parenthesis... 9703 Expr := Parse_Name (Allow_Indexes => True); 9704 Stmt := Parse_Simple_Simultaneous_Statement (Expr); 9705 when Tok_If => 9706 Start_Loc := Get_Token_Location; 9707 9708 -- Skip 'if'. 9709 Scan; 9710 9711 Expr := Parse_Expression; 9712 9713 Stmt := Parse_Simultaneous_If_Statement 9714 (Label, Loc, Start_Loc, Expr); 9715 when Tok_Case => 9716 -- Skip 'case'. 9717 Scan; 9718 9719 Expr := Parse_Expression; 9720 9721 Stmt := Parse_Simultaneous_Case_Statement (Label, Loc, Expr); 9722 when Tok_Null => 9723 Stmt := Parse_Simultaneous_Null_Statement (Label, Loc); 9724 when Tok_Eof => 9725 Error_Msg_Parse ("unexpected end of file, 'END;' expected"); 9726 return First_Stmt; 9727 when others => 9728 -- FIXME: improve message: 9729 Unexpected ("simultaneous statement list"); 9730 Resync_To_End_Of_Statement; 9731 if Current_Token = Tok_Semi_Colon then 9732 Scan; 9733 end if; 9734 end case; 9735 9736 << Has_Stmt >> null; 9737 9738 -- Stmt can be null in case of error. 9739 if Stmt /= Null_Iir then 9740 Set_Location (Stmt, Loc); 9741 if Label /= Null_Identifier then 9742 Set_Label (Stmt, Label); 9743 end if; 9744 Set_Parent (Stmt, Parent); 9745 -- Append it to the chain. 9746 Chain_Append (First_Stmt, Last_Stmt, Stmt); 9747 end if; 9748 end loop; 9749 end Parse_Simultaneous_Statements; 9750 9751 -- AMS-LRM17 11.11 Simultaneous if statement 9752 -- simultaneous_if_statement ::= 9753 -- [ /if/_label : ] 9754 -- IF condition USE 9755 -- simultaneous_statement_part 9756 -- { ELSIF condition USE 9757 -- simultaneous_statement_part } 9758 -- [ ELSE 9759 -- simultaneous_statement_part ] 9760 -- END USE [ /if/_label ]; 9761 function Parse_Simultaneous_If_Statement (Label : Name_Id; 9762 Label_Loc : Location_Type; 9763 If_Loc : Location_Type; 9764 First_Cond : Iir) return Iir 9765 is 9766 Res : Iir; 9767 Clause : Iir; 9768 N_Clause : Iir; 9769 Start_Loc, Use_Loc, End_Loc : Location_Type; 9770 begin 9771 Res := Create_Iir (Iir_Kind_Simultaneous_If_Statement); 9772 Set_Location (Res, Label_Loc); 9773 Set_Label (Res, Label); 9774 Set_Condition (Res, First_Cond); 9775 9776 Start_Loc := If_Loc; 9777 Clause := Res; 9778 loop 9779 -- Set_Condition (Clause, Parse_Expression); 9780 Use_Loc := Get_Token_Location; 9781 if Current_Token = Tok_Use then 9782 -- Eat 'use'. 9783 Scan; 9784 else 9785 Expect_Error (Tok_Use, "'use' is expected here"); 9786 end if; 9787 9788 Set_Simultaneous_Statement_Chain 9789 (Clause, Parse_Simultaneous_Statements (Clause)); 9790 9791 End_Loc := Get_Token_Location; 9792 9793 if Flag_Elocations then 9794 Create_Elocations (Clause); 9795 Set_Start_Location (Clause, Start_Loc); 9796 Set_Use_Location (Clause, Use_Loc); 9797 Set_End_Location (Clause, End_Loc); 9798 end if; 9799 9800 exit when Current_Token /= Tok_Else and Current_Token /= Tok_Elsif; 9801 9802 N_Clause := Create_Iir (Iir_Kind_Simultaneous_Elsif); 9803 Start_Loc := Get_Token_Location; 9804 Set_Location (N_Clause, Start_Loc); 9805 Set_Else_Clause (Clause, N_Clause); 9806 Clause := N_Clause; 9807 if Current_Token = Tok_Else then 9808 9809 -- Skip 'else'. 9810 Scan; 9811 9812 Set_Simultaneous_Statement_Chain 9813 (Clause, Parse_Simultaneous_Statements (Clause)); 9814 9815 if Flag_Elocations then 9816 Create_Elocations (Clause); 9817 Set_Start_Location (Clause, Start_Loc); 9818 Set_End_Location (Clause, Get_Token_Location); 9819 end if; 9820 9821 exit; 9822 else 9823 pragma Assert (Current_Token = Tok_Elsif); 9824 -- Skip 'elsif'. 9825 Scan; 9826 9827 Set_Condition (Clause, Parse_Expression); 9828 end if; 9829 end loop; 9830 9831 -- Skip 'end' 'use' 9832 Expect_Scan (Tok_End); 9833 Expect_Scan (Tok_Use); 9834 9835 Expect_Scan (Tok_Semi_Colon); 9836 9837 return Res; 9838 end Parse_Simultaneous_If_Statement; 9839 9840 -- simultaneous_case_statement ::= 9841 -- /case/_label : 9842 -- CASE expression USE 9843 -- simultaneous_alternative 9844 -- { simultaneous_alternative } 9845 -- END CASE [ /case/_label ] ; 9846 function Parse_Simultaneous_Case_Statement 9847 (Label : Name_Id; Loc : Location_Type; Expr : Iir) return Iir 9848 is 9849 Res : Iir; 9850 When_Loc : Location_Type; 9851 Assoc : Iir; 9852 First_Assoc, Last_Assoc : Iir; 9853 begin 9854 Res := Create_Iir (Iir_Kind_Simultaneous_Case_Statement); 9855 Set_Location (Res, Loc); 9856 Set_Label (Res, Label); 9857 Set_Expression (Res, Expr); 9858 9859 -- Skip 'use' 9860 Expect_Scan (Tok_Use); 9861 9862 if Current_Token = Tok_End then 9863 Error_Msg_Parse ("no generate alternative"); 9864 end if; 9865 9866 Chain_Init (First_Assoc, Last_Assoc); 9867 while Current_Token = Tok_When loop 9868 When_Loc := Get_Token_Location; 9869 9870 -- Skip 'when'. 9871 Scan; 9872 9873 Parse_Choices (Null_Iir, When_Loc, Assoc); 9874 9875 -- Skip '=>'. 9876 Expect_Scan (Tok_Double_Arrow); 9877 9878 Set_Associated_Chain (Assoc, Parse_Simultaneous_Statements (Res)); 9879 Chain_Append_Subchain (First_Assoc, Last_Assoc, Assoc); 9880 end loop; 9881 9882 Set_Case_Statement_Alternative_Chain (Res, First_Assoc); 9883 9884 -- Skip 'end', 'case' 9885 Expect_Scan (Tok_End); 9886 Expect_Scan (Tok_Case); 9887 9888 -- LRM93 9.7 9889 -- If a label appears at the end of a generate statement, it must repeat 9890 -- the generate label. 9891 Check_End_Name (Res); 9892 Expect_Scan (Tok_Semi_Colon); 9893 9894 return Res; 9895 end Parse_Simultaneous_Case_Statement; 9896 9897 -- Parse end of PSL assert/cover statement. 9898 procedure Parse_Psl_Assert_Report_Severity 9899 (Stmt : Iir; Flag_Psl : Boolean) is 9900 begin 9901 -- No more PSL tokens after the property. 9902 Vhdl.Scanner.Flag_Psl := Flag_Psl; 9903 9904 if Current_Token = Tok_Report then 9905 -- Skip 'report' 9906 Scan; 9907 9908 Set_Report_Expression (Stmt, Parse_Expression); 9909 end if; 9910 9911 if Current_Token = Tok_Severity then 9912 -- Skip 'severity' 9913 Scan; 9914 9915 Set_Severity_Expression (Stmt, Parse_Expression); 9916 end if; 9917 9918 Vhdl.Scanner.Flag_Scan_In_Comment := False; 9919 9920 Expect_Scan (Tok_Semi_Colon); 9921 end Parse_Psl_Assert_Report_Severity; 9922 9923 function Parse_Psl_Assert_Directive (Flag_Psl : Boolean) return Iir 9924 is 9925 Res : Iir; 9926 begin 9927 Res := Create_Iir (Iir_Kind_Psl_Assert_Directive); 9928 Set_Location (Res); 9929 9930 -- Accept PSL tokens 9931 if Flags.Vhdl_Std >= Vhdl_08 then 9932 Vhdl.Scanner.Flag_Psl := True; 9933 end if; 9934 9935 -- Skip 'assert' 9936 Scan; 9937 9938 Set_Psl_Property (Res, Parse_Psl.Parse_Psl_Property); 9939 9940 Parse_Psl_Assert_Report_Severity (Res, Flag_Psl); 9941 9942 return Res; 9943 end Parse_Psl_Assert_Directive; 9944 9945 function Parse_Psl_Assume_Directive (Flag_Psl : Boolean) return Iir 9946 is 9947 Res : Iir; 9948 begin 9949 Res := Create_Iir (Iir_Kind_Psl_Assume_Directive); 9950 Set_Location (Res); 9951 9952 -- Accept PSL tokens 9953 Vhdl.Scanner.Flag_Psl := True; 9954 9955 -- Skip 'assume' 9956 Scan; 9957 9958 Set_Psl_Property (Res, Parse_Psl.Parse_Psl_Property); 9959 9960 Vhdl.Scanner.Flag_Psl := Flag_Psl; 9961 Vhdl.Scanner.Flag_Scan_In_Comment := False; 9962 9963 Expect_Scan (Tok_Semi_Colon); 9964 9965 return Res; 9966 end Parse_Psl_Assume_Directive; 9967 9968 function Parse_Psl_Cover_Directive (Flag_Psl : Boolean) return Iir 9969 is 9970 Res : Iir; 9971 begin 9972 Res := Create_Iir (Iir_Kind_Psl_Cover_Directive); 9973 9974 -- Accept PSL tokens 9975 Vhdl.Scanner.Flag_Psl := True; 9976 9977 -- Skip 'cover' 9978 Scan; 9979 9980 Set_Psl_Sequence (Res, Parse_Psl.Parse_Psl_Sequence); 9981 9982 Parse_Psl_Assert_Report_Severity (Res, Flag_Psl); 9983 9984 return Res; 9985 end Parse_Psl_Cover_Directive; 9986 9987 function Parse_Psl_Restrict_Directive (Flag_Psl : Boolean) return Iir 9988 is 9989 Res : Iir; 9990 begin 9991 Res := Create_Iir (Iir_Kind_Psl_Restrict_Directive); 9992 9993 -- Accept PSL tokens 9994 Vhdl.Scanner.Flag_Psl := True; 9995 9996 -- Skip 'restrict' 9997 Scan; 9998 9999 Set_Psl_Sequence (Res, Parse_Psl.Parse_Psl_Sequence); 10000 10001 -- No more PSL tokens after the sequence. 10002 Vhdl.Scanner.Flag_Psl := Flag_Psl; 10003 Vhdl.Scanner.Flag_Scan_In_Comment := False; 10004 10005 Expect_Scan (Tok_Semi_Colon); 10006 return Res; 10007 end Parse_Psl_Restrict_Directive; 10008 10009 -- precond : first token 10010 -- postcond: next token (end/else/when...) 10011 -- 10012 -- [ LRM93 9 ] 10013 -- concurrent_statement ::= block_statement 10014 -- | process_statement 10015 -- | concurrent_procedure_call_statement 10016 -- | concurrent_assertion_statement 10017 -- | concurrent_signal_assignment_statement 10018 -- | component_instantiation_statement 10019 -- | generate_statement 10020 -- 10021 function Parse_Concurrent_Statement (Parent : Iir; Prev_Label : Name_Id) 10022 return Iir 10023 is 10024 Stmt: Iir; 10025 Label: Name_Id; 10026 Id: Iir; 10027 Postponed : Boolean; 10028 Loc : Location_Type; 10029 Target : Iir; 10030 10031 procedure Postponed_Not_Allowed is 10032 begin 10033 if Postponed then 10034 Error_Msg_Parse ("'postponed' not allowed here"); 10035 Postponed := False; 10036 end if; 10037 end Postponed_Not_Allowed; 10038 10039 procedure Label_Not_Allowed is 10040 begin 10041 if Label /= Null_Identifier then 10042 Error_Msg_Parse ("'postponed' not allowed here"); 10043 Label := Null_Identifier; 10044 end if; 10045 end Label_Not_Allowed; 10046 begin 10047 -- begin was just parsed. 10048 loop 10049 Stmt := Null_Iir; 10050 Label := Null_Identifier; 10051 Postponed := False; 10052 Loc := Get_Token_Location; 10053 10054 -- Try to find a label. 10055 if Prev_Label /= Null_Identifier then 10056 Label := Prev_Label; 10057 elsif Current_Token = Tok_Identifier then 10058 Label := Current_Identifier; 10059 10060 -- Skip identifier 10061 Scan; 10062 10063 if Current_Token = Tok_Colon then 10064 -- The identifier is really a label. 10065 10066 -- Skip ':' 10067 Scan; 10068 else 10069 -- This is not a label. Assume a concurrent assignment. 10070 Stmt := Parse_Concurrent_Assignment_With_Name (Label, Loc); 10071 Label := Null_Identifier; 10072 goto Has_Stmt; 10073 end if; 10074 end if; 10075 10076 if Current_Token = Tok_Postponed then 10077 if Flags.Vhdl_Std = Vhdl_87 then 10078 Error_Msg_Parse ("'postponed' is not allowed in vhdl 87"); 10079 else 10080 Postponed := True; 10081 end if; 10082 10083 -- Skip 'postponed' 10084 Scan; 10085 end if; 10086 10087 case Current_Token is 10088 when Tok_End | Tok_Else | Tok_Elsif | Tok_When => 10089 -- End of list. 'else', 'elseif' and 'when' can be used to 10090 -- separate statements in a generate statement. 10091 Postponed_Not_Allowed; 10092 if Label /= Null_Identifier then 10093 Error_Msg_Parse ("label is not allowed here"); 10094 end if; 10095 return Null_Iir; 10096 when Tok_Identifier => 10097 Target := Parse_Name (Allow_Indexes => True); 10098 Stmt := Parse_Concurrent_Assignment (Target); 10099 if Get_Kind (Stmt) = Iir_Kind_Component_Instantiation_Statement 10100 and then Postponed 10101 then 10102 Error_Msg_Parse ("'postponed' not allowed for " & 10103 "an instantiation statement"); 10104 Postponed := False; 10105 end if; 10106 when Tok_Left_Paren => 10107 Id := Parse_Aggregate; 10108 if Current_Token = Tok_Less_Equal then 10109 -- This is a conditional signal assignment. 10110 Stmt := Parse_Concurrent_Conditional_Signal_Assignment (Id); 10111 else 10112 Error_Msg_Parse ("'<=' expected after aggregate"); 10113 Skip_Until_Semi_Colon; 10114 end if; 10115 when Tok_Process => 10116 Stmt := Parse_Process_Statement (Label, Loc, Postponed); 10117 when Tok_Assert => 10118 if Vhdl_Std >= Vhdl_08 10119 or else (Flag_Psl_Comment and then Flag_Scan_In_Comment) 10120 then 10121 Stmt := Parse_Psl_Assert_Directive (False); 10122 else 10123 Stmt := Create_Iir (Iir_Kind_Concurrent_Assertion_Statement); 10124 Parse_Assertion (Stmt); 10125 Expect_Scan (Tok_Semi_Colon); 10126 end if; 10127 when Tok_With => 10128 Stmt := Parse_Selected_Signal_Assignment; 10129 when Tok_Block => 10130 Postponed_Not_Allowed; 10131 Stmt := Parse_Block_Statement (Label, Loc); 10132 when Tok_For => 10133 Postponed_Not_Allowed; 10134 Stmt := Parse_For_Generate_Statement (Label, Loc); 10135 when Tok_If => 10136 Postponed_Not_Allowed; 10137 Stmt := Parse_If_Generate_Statement (Label, Loc); 10138 when Tok_Case => 10139 Postponed_Not_Allowed; 10140 Stmt := Parse_Case_Generate_Statement (Label, Loc); 10141 when Tok_Component 10142 | Tok_Entity 10143 | Tok_Configuration => 10144 Postponed_Not_Allowed; 10145 declare 10146 Unit : Iir; 10147 Has_Component : constant Boolean := 10148 Current_Token = Tok_Component; 10149 begin 10150 Unit := Parse_Instantiated_Unit; 10151 Stmt := Parse_Component_Instantiation (Unit); 10152 Set_Has_Component (Stmt, Has_Component); 10153 end; 10154 when Tok_Break => 10155 Postponed_Not_Allowed; 10156 Stmt := Parse_Concurrent_Break_Statement (Label, Loc); 10157 when Tok_Procedural => 10158 Postponed_Not_Allowed; 10159 Stmt := Parse_Simultaneous_Procedural_Statement (Label); 10160 when Tok_Null => 10161 if not AMS_Vhdl then 10162 Error_Msg_Parse ("concurrent null statement not allowed"); 10163 else 10164 Postponed_Not_Allowed; 10165 end if; 10166 Stmt := Parse_Simultaneous_Null_Statement (Label, Loc); 10167 when Tok_Default => 10168 Postponed_Not_Allowed; 10169 Label_Not_Allowed; 10170 Stmt := Parse_Psl_Default_Clock (False); 10171 when Tok_Property 10172 | Tok_Sequence 10173 | Tok_Psl_Endpoint => 10174 Postponed_Not_Allowed; 10175 Label_Not_Allowed; 10176 Stmt := Parse_Psl_Declaration; 10177 when Tok_Assume => 10178 Postponed_Not_Allowed; 10179 Stmt := Parse_Psl_Assume_Directive (False); 10180 when Tok_Cover => 10181 Postponed_Not_Allowed; 10182 Stmt := Parse_Psl_Cover_Directive (False); 10183 when Tok_Restrict => 10184 Postponed_Not_Allowed; 10185 Stmt := Parse_Psl_Restrict_Directive (False); 10186 when Tok_Wait 10187 | Tok_Loop 10188 | Tok_While => 10189 Error_Msg_Parse 10190 ("sequential statement only allowed in processes"); 10191 Stmt := Parse_Sequential_Statements (Parent); 10192 -- Continue. 10193 Stmt := Null_Iir; 10194 when Tok_Eof => 10195 Error_Msg_Parse ("unexpected end of file, 'END;' expected"); 10196 return Null_Iir; 10197 when others => 10198 -- FIXME: improve message: 10199 -- instead of 'unexpected token 'signal' in conc stmt list' 10200 -- report: 'signal declarations are not allowed in conc stmt' 10201 Unexpected ("concurrent statement list"); 10202 Resync_To_End_Of_Statement; 10203 if Current_Token = Tok_Semi_Colon then 10204 Scan; 10205 end if; 10206 Stmt := Null_Iir; 10207 end case; 10208 10209 << Has_Stmt >> null; 10210 10211 -- Stmt can be null in case of error. 10212 if Stmt /= Null_Iir then 10213 Set_Location (Stmt, Loc); 10214 Set_Parent (Stmt, Parent); 10215 if Label /= Null_Identifier then 10216 Set_Label (Stmt, Label); 10217 end if; 10218 Set_Parent (Stmt, Parent); 10219 if Postponed then 10220 Set_Postponed_Flag (Stmt, True); 10221 end if; 10222 return Stmt; 10223 end if; 10224 end loop; 10225 end Parse_Concurrent_Statement; 10226 10227 -- precond : first token 10228 -- postcond: next token (end/else/when...) 10229 procedure Parse_Concurrent_Statements (Parent : Iir) 10230 is 10231 Last_Stmt : Iir; 10232 Stmt : Iir; 10233 begin 10234 -- begin was just parsed. 10235 Last_Stmt := Null_Iir; 10236 loop 10237 Stmt := Parse_Concurrent_Statement (Parent, Null_Identifier); 10238 exit when Stmt = Null_Iir; 10239 10240 -- Append it to the chain. 10241 if Last_Stmt = Null_Iir then 10242 Set_Concurrent_Statement_Chain (Parent, Stmt); 10243 else 10244 Set_Chain (Last_Stmt, Stmt); 10245 end if; 10246 Last_Stmt := Stmt; 10247 end loop; 10248 end Parse_Concurrent_Statements; 10249 10250 -- precond : LIBRARY 10251 -- postcond: ; 10252 -- 10253 -- [ LRM93 11.2 ] 10254 -- library_clause ::= LIBRARY logical_name_list 10255 function Parse_Library_Clause return Iir 10256 is 10257 First, Last : Iir; 10258 Library: Iir_Library_Clause; 10259 Start_Loc : Location_Type; 10260 begin 10261 Chain_Init (First, Last); 10262 Expect (Tok_Library); 10263 loop 10264 Library := Create_Iir (Iir_Kind_Library_Clause); 10265 Start_Loc := Get_Token_Location; 10266 Chain_Append (First, Last, Library); 10267 10268 -- Skip 'library' or ','. 10269 Scan; 10270 10271 Scan_Identifier (Library); 10272 10273 if Flag_Elocations then 10274 Create_Elocations (Library); 10275 Set_Start_Location (Library, Start_Loc); 10276 end if; 10277 10278 exit when Current_Token /= Tok_Comma; 10279 10280 Set_Has_Identifier_List (Library, True); 10281 end loop; 10282 10283 -- Skip ';'. 10284 Scan_Semi_Colon ("library clause"); 10285 10286 return First; 10287 end Parse_Library_Clause; 10288 10289 -- precond : USE 10290 -- postcond: next token (after ';'). 10291 -- 10292 -- [ LRM93 10.4 ] 10293 -- use_clause ::= USE selected_name { , selected_name } 10294 -- 10295 -- FIXME: should be a list. 10296 function Parse_Use_Clause return Iir_Use_Clause 10297 is 10298 Use_Clause: Iir_Use_Clause; 10299 Loc : Location_Type; 10300 First, Last : Iir; 10301 begin 10302 First := Null_Iir; 10303 Last := Null_Iir; 10304 10305 Loc := Get_Token_Location; 10306 10307 -- Skip 'use'. 10308 Scan; 10309 10310 loop 10311 Use_Clause := Create_Iir (Iir_Kind_Use_Clause); 10312 Set_Location (Use_Clause, Loc); 10313 Expect (Tok_Identifier); 10314 Set_Selected_Name (Use_Clause, Parse_Name); 10315 10316 -- Chain use clauses. 10317 if First = Null_Iir then 10318 First := Use_Clause; 10319 else 10320 Set_Use_Clause_Chain (Last, Use_Clause); 10321 end if; 10322 Last := Use_Clause; 10323 10324 exit when Current_Token /= Tok_Comma; 10325 Loc := Get_Token_Location; 10326 10327 -- Skip ','. 10328 Scan; 10329 end loop; 10330 10331 -- Skip ';'. 10332 Scan_Semi_Colon ("use clause"); 10333 10334 return First; 10335 end Parse_Use_Clause; 10336 10337 -- precond : ARCHITECTURE 10338 -- postcond: ';'. 10339 -- 10340 -- [ LRM93 1.2 ] 10341 -- architecture_body ::= 10342 -- ARCHITECTURE identifier OF ENTITY_name IS 10343 -- architecture_declarative_part 10344 -- BEGIN 10345 -- architecture_statement_part 10346 -- END [ ARCHITECTURE ] [ ARCHITECTURE_simple_name ] ; 10347 procedure Parse_Architecture_Body (Unit : Iir_Design_Unit) 10348 is 10349 Res : Iir_Architecture_Body; 10350 Start_Loc : Location_Type; 10351 Begin_Loc : Location_Type; 10352 End_Loc : Location_Type; 10353 begin 10354 Expect (Tok_Architecture); 10355 Res := Create_Iir (Iir_Kind_Architecture_Body); 10356 Start_Loc := Get_Token_Location; 10357 10358 -- Skip 'architecture'. 10359 Scan; 10360 10361 -- Identifier. 10362 Scan_Identifier (Res); 10363 10364 -- Skip 'of'. 10365 Expect_Scan (Tok_Of); 10366 10367 Set_Entity_Name (Res, Parse_Name (False)); 10368 10369 -- Skip 'is'. 10370 Expect_Scan (Tok_Is); 10371 10372 Parse_Declarative_Part (Res, Res); 10373 10374 -- Skip 'begin'. 10375 Begin_Loc := Get_Token_Location; 10376 Expect_Scan (Tok_Begin); 10377 10378 Parse_Concurrent_Statements (Res); 10379 -- end was scanned. 10380 End_Loc := Get_Token_Location; 10381 10382 -- Skip 'end'. 10383 Expect_Scan (Tok_End); 10384 10385 if Current_Token = Tok_Architecture then 10386 if Flags.Vhdl_Std = Vhdl_87 then 10387 Error_Msg_Parse 10388 ("'architecture' keyword not allowed here by vhdl 87"); 10389 end if; 10390 Set_End_Has_Reserved_Id (Res, True); 10391 10392 -- Skip 'architecture'. 10393 Scan; 10394 end if; 10395 Check_End_Name (Res); 10396 Scan_Semi_Colon_Unit ("architecture"); 10397 10398 Set_Library_Unit (Unit, Res); 10399 10400 if Flag_Elocations then 10401 Create_Elocations (Res); 10402 Set_Start_Location (Res, Start_Loc); 10403 Set_Begin_Location (Res, Begin_Loc); 10404 Set_End_Location (Res, End_Loc); 10405 end if; 10406 end Parse_Architecture_Body; 10407 10408 -- precond : next token 10409 -- postcond: a token 10410 -- 10411 -- [ LRM93 5.2 ] 10412 -- instantiation_list ::= INSTANTIATION_label { , INSTANTIATION_label } 10413 -- | OTHERS 10414 -- | ALL 10415 -- 10416 -- FIXME: merge with parse_signal_list ? 10417 function Parse_Instantiation_List return Iir_Flist 10418 is 10419 Res : Iir_List; 10420 begin 10421 case Current_Token is 10422 when Tok_All => 10423 -- Skip 'all'. 10424 Scan; 10425 10426 return Iir_Flist_All; 10427 10428 when Tok_Others => 10429 -- Skip 'others'. 10430 Scan; 10431 10432 return Iir_Flist_Others; 10433 10434 when Tok_Identifier => 10435 Res := Create_Iir_List; 10436 loop 10437 Append_Element (Res, Parse_Simple_Name); 10438 10439 exit when Current_Token /= Tok_Comma; 10440 10441 -- Skip ','. 10442 Scan; 10443 10444 if Current_Token /= Tok_Identifier then 10445 Expect (Tok_Identifier); 10446 exit; 10447 end if; 10448 end loop; 10449 return List_To_Flist (Res); 10450 10451 when others => 10452 Error_Msg_Parse ("instantiation list expected"); 10453 return Null_Iir_Flist; 10454 end case; 10455 end Parse_Instantiation_List; 10456 10457 -- precond : next token 10458 -- postcond: next token 10459 -- 10460 -- [ LRM93 5.2 ] 10461 -- component_specification ::= instantiation_list : COMPONENT_name 10462 procedure Parse_Component_Specification (Res : Iir) 10463 is 10464 List : Iir_Flist; 10465 begin 10466 List := Parse_Instantiation_List; 10467 Set_Instantiation_List (Res, List); 10468 10469 -- Skip ':'. 10470 Expect_Scan (Tok_Colon); 10471 10472 Expect (Tok_Identifier); 10473 Set_Component_Name (Res, Parse_Name); 10474 end Parse_Component_Specification; 10475 10476 -- precond : next token 10477 -- postcond: next token 10478 -- 10479 -- [ LRM93 5.2.1.1 ] 10480 -- entity_aspect ::= ENTITY ENTITY_name [ ( ARCHITECTURE_identifier ) ] 10481 function Parse_Entity_Aspect_Entity return Iir 10482 is 10483 Res : Iir; 10484 begin 10485 Res := Create_Iir (Iir_Kind_Entity_Aspect_Entity); 10486 Set_Location (Res); 10487 10488 if Current_Token = Tok_Entity then 10489 -- Eat 'entity' (but only if present). 10490 Scan; 10491 end if; 10492 10493 Expect (Tok_Identifier); 10494 Set_Entity_Name (Res, Parse_Name (False)); 10495 10496 -- Optional architecture 10497 if Current_Token = Tok_Left_Paren then 10498 -- Skip '('. 10499 Scan; 10500 10501 if Current_Token = Tok_Identifier then 10502 Set_Architecture (Res, Parse_Simple_Name); 10503 else 10504 Expect (Tok_Identifier); 10505 end if; 10506 10507 Expect_Scan (Tok_Right_Paren); 10508 end if; 10509 10510 return Res; 10511 end Parse_Entity_Aspect_Entity; 10512 10513 -- precond : next token 10514 -- postcond: next token 10515 -- 10516 -- [ LRM93 5.2.1.1 ] 10517 -- entity_aspect ::= ENTITY ENTITY_name [ ( ARCHITECTURE_identifier ) ] 10518 -- | CONFIGURATION CONFIGURATION_name 10519 -- | OPEN 10520 function Parse_Entity_Aspect return Iir 10521 is 10522 Res : Iir; 10523 begin 10524 case Current_Token is 10525 when Tok_Entity => 10526 Res := Parse_Entity_Aspect_Entity; 10527 when Tok_Configuration => 10528 Res := Create_Iir (Iir_Kind_Entity_Aspect_Configuration); 10529 Set_Location (Res); 10530 10531 -- Skip 'configuration'. 10532 Scan; 10533 10534 Expect (Tok_Identifier); 10535 Set_Configuration_Name (Res, Parse_Name (False)); 10536 when Tok_Open => 10537 Res := Create_Iir (Iir_Kind_Entity_Aspect_Open); 10538 Set_Location (Res); 10539 Scan; 10540 when others => 10541 Error_Msg_Parse ("'entity', 'configuration' or 'open' expected"); 10542 -- Assume 'entity' is missing (common case). 10543 Res := Parse_Entity_Aspect_Entity; 10544 end case; 10545 return Res; 10546 end Parse_Entity_Aspect; 10547 10548 -- precond : next token 10549 -- postcond: next token 10550 -- 10551 -- [ LRM93 5.2.1 ] 10552 -- binding_indication ::= 10553 -- [ USE entity_aspect ] 10554 -- [ generic_map_aspect ] 10555 -- [ port_map_aspect ] 10556 function Parse_Binding_Indication return Iir_Binding_Indication 10557 is 10558 Res : Iir_Binding_Indication; 10559 begin 10560 case Current_Token is 10561 when Tok_Use 10562 | Tok_Generic 10563 | Tok_Port => 10564 null; 10565 when others => 10566 return Null_Iir; 10567 end case; 10568 Res := Create_Iir (Iir_Kind_Binding_Indication); 10569 Set_Location (Res); 10570 if Current_Token = Tok_Use then 10571 Scan; 10572 Set_Entity_Aspect (Res, Parse_Entity_Aspect); 10573 end if; 10574 if Current_Token = Tok_Generic then 10575 Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); 10576 end if; 10577 if Current_Token = Tok_Port then 10578 Set_Port_Map_Aspect_Chain (Res, Parse_Port_Map_Aspect); 10579 end if; 10580 return Res; 10581 end Parse_Binding_Indication; 10582 10583 -- precond : ':' after instantiation_list. 10584 -- postcond: next token. 10585 -- 10586 -- [ LRM93 1.3.2 ] 10587 -- component_configuration ::= 10588 -- FOR component_specification 10589 -- [ binding_indication ; ] 10590 -- [ block_configuration ] 10591 -- END FOR ; 10592 function Parse_Component_Configuration (Loc : Location_Type; 10593 Inst_List : Iir_Flist) 10594 return Iir_Component_Configuration 10595 is 10596 Res : Iir_Component_Configuration; 10597 begin 10598 Res := Create_Iir (Iir_Kind_Component_Configuration); 10599 Set_Location (Res, Loc); 10600 10601 -- Skip ':'. 10602 pragma Assert (Current_Token = Tok_Colon); 10603 Scan; 10604 10605 -- Component specification. 10606 Set_Instantiation_List (Res, Inst_List); 10607 10608 Expect (Tok_Identifier); 10609 Set_Component_Name (Res, Parse_Name); 10610 10611 case Current_Token is 10612 when Tok_Use 10613 | Tok_Generic 10614 | Tok_Port => 10615 Set_Binding_Indication (Res, Parse_Binding_Indication); 10616 Scan_Semi_Colon ("binding indication"); 10617 when others => 10618 null; 10619 end case; 10620 if Current_Token = Tok_For then 10621 Set_Block_Configuration (Res, Parse_Block_Configuration); 10622 end if; 10623 Expect_Scan (Tok_End); 10624 Expect_Scan (Tok_For); 10625 Expect_Scan (Tok_Semi_Colon); 10626 return Res; 10627 end Parse_Component_Configuration; 10628 10629 -- precond : FOR 10630 -- postcond: next token. 10631 -- 10632 -- [ LRM93 1.3.1 ] 10633 -- block_configuration ::= 10634 -- FOR block_specification 10635 -- { use_clause } 10636 -- { configuration_item } 10637 -- END FOR ; 10638 -- 10639 -- [ LRM93 1.3.1 ] 10640 -- block_specification ::= 10641 -- ARCHITECTURE_name 10642 -- | BLOCK_STATEMENT_label 10643 -- | GENERATE_STATEMENT_label [ ( index_specification ) ] 10644 function Parse_Block_Configuration_Suffix (Loc : Location_Type; 10645 Block_Spec : Iir) 10646 return Iir 10647 is 10648 Res : Iir_Block_Configuration; 10649 begin 10650 Res := Create_Iir (Iir_Kind_Block_Configuration); 10651 Set_Location (Res, Loc); 10652 10653 Set_Block_Specification (Res, Block_Spec); 10654 10655 -- Parse use clauses. 10656 if Current_Token = Tok_Use then 10657 declare 10658 First, Last : Iir; 10659 begin 10660 Chain_Init (First, Last); 10661 10662 while Current_Token = Tok_Use loop 10663 Chain_Append_Subchain (First, Last, Parse_Use_Clause); 10664 end loop; 10665 Set_Declaration_Chain (Res, First); 10666 end; 10667 end if; 10668 10669 -- Parse configuration item list 10670 declare 10671 First, Last : Iir; 10672 begin 10673 Chain_Init (First, Last); 10674 while Current_Token = Tok_For loop 10675 Chain_Append (First, Last, Parse_Configuration_Item); 10676 end loop; 10677 Set_Configuration_Item_Chain (Res, First); 10678 end; 10679 Expect_Scan (Tok_End); 10680 Expect_Scan (Tok_For); 10681 Expect_Scan (Tok_Semi_Colon); 10682 return Res; 10683 end Parse_Block_Configuration_Suffix; 10684 10685 function Parse_Block_Configuration return Iir_Block_Configuration 10686 is 10687 Loc : Location_Type; 10688 begin 10689 Loc := Get_Token_Location; 10690 10691 -- Skip 'for'. 10692 Expect_Scan (Tok_For); 10693 10694 return Parse_Block_Configuration_Suffix (Loc, Parse_Name); 10695 end Parse_Block_Configuration; 10696 10697 -- precond : FOR 10698 -- postcond: next token. 10699 -- 10700 -- [ LRM93 1.3.1 ] 10701 -- configuration_item ::= block_configuration 10702 -- | component_configuration 10703 function Parse_Configuration_Item return Iir 10704 is 10705 Loc : Location_Type; 10706 List : Iir_List; 10707 Flist : Iir_Flist; 10708 El : Iir; 10709 begin 10710 Loc := Get_Token_Location; 10711 Expect_Scan (Tok_For); 10712 10713 -- ALL and OTHERS are tokens from an instantiation list. 10714 -- Thus, the rule is a component_configuration. 10715 case Current_Token is 10716 when Tok_All => 10717 -- Skip 'all'. 10718 Scan; 10719 10720 return Parse_Component_Configuration (Loc, Iir_Flist_All); 10721 10722 when Tok_Others => 10723 -- Skip 'others'. 10724 Scan; 10725 10726 return Parse_Component_Configuration (Loc, Iir_Flist_Others); 10727 10728 when Tok_Identifier => 10729 El := Parse_Simple_Name; 10730 10731 case Current_Token is 10732 when Tok_Colon => 10733 -- The identifier was a label from an instantiation list. 10734 Flist := Create_Iir_Flist (1); 10735 Set_Nth_Element (Flist, 0, El); 10736 return Parse_Component_Configuration (Loc, Flist); 10737 when Tok_Comma => 10738 -- The identifier was a label from an instantiation list. 10739 List := Create_Iir_List; 10740 Append_Element (List, El); 10741 while Current_Token = Tok_Comma loop 10742 -- Skip ','. 10743 Scan; 10744 10745 if Current_Token = Tok_Identifier then 10746 Append_Element (List, Parse_Simple_Name); 10747 else 10748 Expect (Tok_Identifier); 10749 exit; 10750 end if; 10751 end loop; 10752 Flist := List_To_Flist (List); 10753 return Parse_Component_Configuration (Loc, Flist); 10754 when Tok_Left_Paren => 10755 El := Parse_Name_Suffix (El); 10756 return Parse_Block_Configuration_Suffix (Loc, El); 10757 when Tok_Use | Tok_For | Tok_End => 10758 -- Possibilities for a block_configuration. 10759 -- FIXME: should use 'when others' ? 10760 return Parse_Block_Configuration_Suffix (Loc, El); 10761 when others => 10762 Error_Msg_Parse 10763 ("block_configuration or component_configuration " 10764 & "expected"); 10765 return Null_Iir; 10766 end case; 10767 when others => 10768 Error_Msg_Parse ("configuration item expected"); 10769 return Null_Iir; 10770 end case; 10771 end Parse_Configuration_Item; 10772 10773 -- precond : next token 10774 -- postcond: next token 10775 -- 10776 -- [ LRM93 1.3] 10777 -- configuration_declarative_part ::= { configuration_declarative_item } 10778 -- 10779 -- [ LRM93 1.3] 10780 -- configuration_declarative_item ::= use_clause 10781 -- | attribute_specification 10782 -- | group_declaration 10783 -- FIXME: attribute_specification, group_declaration 10784 procedure Parse_Configuration_Declarative_Part (Parent : Iir) 10785 is 10786 First, Last : Iir; 10787 El : Iir; 10788 begin 10789 Chain_Init (First, Last); 10790 loop 10791 case Current_Token is 10792 when Tok_Invalid => 10793 raise Internal_Error; 10794 when Tok_Use => 10795 Chain_Append_Subchain (First, Last, Parse_Use_Clause); 10796 when Tok_Attribute => 10797 El := Parse_Attribute; 10798 if El /= Null_Iir then 10799 if Get_Kind (El) /= Iir_Kind_Attribute_Specification then 10800 Error_Msg_Parse 10801 ("attribute declaration not allowed here"); 10802 end if; 10803 Set_Parent (El, Parent); 10804 Chain_Append (First, Last, El); 10805 end if; 10806 when Tok_Group => 10807 El := Parse_Group; 10808 if El /= Null_Iir then 10809 if Get_Kind (El) /= Iir_Kind_Group_Declaration then 10810 Error_Msg_Parse 10811 ("group template declaration not allowed here"); 10812 end if; 10813 Set_Parent (El, Parent); 10814 Chain_Append (First, Last, El); 10815 end if; 10816 when others => 10817 exit; 10818 end case; 10819 end loop; 10820 Set_Declaration_Chain (Parent, First); 10821 end Parse_Configuration_Declarative_Part; 10822 10823 -- precond : CONFIGURATION 10824 -- postcond: next token. 10825 -- 10826 -- [ LRM93 1.3 ] 10827 -- configuration_declaration ::= 10828 -- CONFIGURATION identifier OF ENTITY_name IS 10829 -- configuration_declarative_part 10830 -- block_configuration 10831 -- END [ CONFIGURATION ] [ CONFIGURATION_simple_name ] ; 10832 -- 10833 -- [ LRM93 1.3 ] 10834 -- configuration_declarative_part ::= { configuration_declarative_item } 10835 procedure Parse_Configuration_Declaration (Unit : Iir_Design_Unit) 10836 is 10837 Res : Iir_Configuration_Declaration; 10838 Start_Loc : Location_Type; 10839 End_Loc : Location_Type; 10840 begin 10841 pragma Assert (Current_Token = Tok_Configuration); 10842 Res := Create_Iir (Iir_Kind_Configuration_Declaration); 10843 Start_Loc := Get_Token_Location; 10844 10845 -- Skip 'configuration'. 10846 pragma Assert (Current_Token = Tok_Configuration); 10847 Scan; 10848 10849 -- Get identifier. 10850 Scan_Identifier (Res); 10851 10852 -- Skip 'of'. 10853 Expect_Scan (Tok_Of); 10854 10855 Set_Entity_Name (Res, Parse_Name (False)); 10856 10857 -- Skip 'is'. 10858 Expect_Scan (Tok_Is); 10859 10860 Parse_Configuration_Declarative_Part (Res); 10861 10862 Set_Block_Configuration (Res, Parse_Block_Configuration); 10863 10864 End_Loc := Get_Token_Location; 10865 -- Skip 'end'. 10866 Expect_Scan (Tok_End); 10867 10868 if Current_Token = Tok_Configuration then 10869 if Flags.Vhdl_Std = Vhdl_87 then 10870 Error_Msg_Parse 10871 ("'configuration' keyword not allowed here by vhdl 87"); 10872 end if; 10873 Set_End_Has_Reserved_Id (Res, True); 10874 10875 -- Skip 'configuration'. 10876 Scan; 10877 end if; 10878 10879 -- LRM93 1.3 10880 -- If a simple name appears at the end of a configuration declaration, 10881 -- it must repeat the identifier of the configuration declaration. 10882 Check_End_Name (Res); 10883 Scan_Semi_Colon_Unit ("configuration"); 10884 10885 Set_Library_Unit (Unit, Res); 10886 10887 if Flag_Elocations then 10888 Create_Elocations (Res); 10889 Set_Start_Location (Res, Start_Loc); 10890 Set_End_Location (Res, End_Loc); 10891 end if; 10892 end Parse_Configuration_Declaration; 10893 10894 -- Return the parent of a nested package. Used to check if some 10895 -- declarations are allowed in a package. 10896 function Get_Package_Parent (Decl : Iir) return Iir 10897 is 10898 Res : Iir; 10899 Parent : Iir; 10900 begin 10901 Res := Decl; 10902 loop 10903 case Get_Kind (Res) is 10904 when Iir_Kind_Package_Declaration 10905 | Iir_Kind_Package_Body => 10906 Parent := Get_Parent (Res); 10907 if Get_Kind (Parent) = Iir_Kind_Design_Unit then 10908 return Res; 10909 else 10910 Res := Parent; 10911 end if; 10912 when others => 10913 return Res; 10914 end case; 10915 end loop; 10916 end Get_Package_Parent; 10917 10918 -- precond : generic 10919 -- postcond: next token 10920 -- 10921 -- [ LRM08 4.7 ] 10922 -- package_header ::= 10923 -- [ generic_clause -- LRM08 6.5.6.2 10924 -- [ generic_map aspect ; ] ] 10925 function Parse_Package_Header return Iir 10926 is 10927 Res : Iir; 10928 begin 10929 Res := Create_Iir (Iir_Kind_Package_Header); 10930 Set_Location (Res); 10931 Parse_Generic_Clause (Res); 10932 10933 if Current_Token = Tok_Generic then 10934 Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); 10935 Scan_Semi_Colon ("generic map aspect"); 10936 end if; 10937 return Res; 10938 end Parse_Package_Header; 10939 10940 -- precond : token (after 'IS') 10941 -- postcond: next token. 10942 -- 10943 -- [ LRM93 2.5, LRM08 4.7 ] 10944 -- package_declaration ::= 10945 -- PACKAGE identifier IS 10946 -- package_header -- LRM08 10947 -- package_declarative_part 10948 -- END [ PACKAGE ] [ PACKAGE_simple_name ] ; 10949 function Parse_Package_Declaration 10950 (Parent : Iir; Id : Name_Id; Loc : Location_Type) return Iir 10951 is 10952 Res: Iir_Package_Declaration; 10953 End_Loc : Location_Type; 10954 begin 10955 Res := Create_Iir (Iir_Kind_Package_Declaration); 10956 Set_Location (Res, Loc); 10957 Set_Identifier (Res, Id); 10958 Set_Parent (Res, Parent); 10959 10960 if Current_Token = Tok_Generic then 10961 if Vhdl_Std < Vhdl_08 then 10962 Error_Msg_Parse ("generic packages not allowed before vhdl 2008"); 10963 end if; 10964 Set_Package_Header (Res, Parse_Package_Header); 10965 end if; 10966 10967 Parse_Declarative_Part (Res, Get_Package_Parent (Res)); 10968 10969 End_Loc := Get_Token_Location; 10970 10971 -- Skip 'end' 10972 Expect_Scan (Tok_End); 10973 10974 if Current_Token = Tok_Package then 10975 if Flags.Vhdl_Std = Vhdl_87 then 10976 Error_Msg_Parse ("'package' keyword not allowed here by vhdl 87"); 10977 end if; 10978 Set_End_Has_Reserved_Id (Res, True); 10979 10980 -- Skip 'package'. 10981 Scan; 10982 end if; 10983 10984 Check_End_Name (Res); 10985 Scan_Semi_Colon_Unit ("package declaration"); 10986 10987 if Flag_Elocations then 10988 Create_Elocations (Res); 10989 Set_End_Location (Res, End_Loc); 10990 end if; 10991 10992 return Res; 10993 end Parse_Package_Declaration; 10994 10995 -- precond : BODY 10996 -- postcond: next token. 10997 -- 10998 -- [ LRM93 2.6, LRM08 4.8 ] 10999 -- package_body ::= 11000 -- PACKAGE BODY PACKAGE_simple_name IS 11001 -- package_body_declarative_part 11002 -- END [ PACKAGE BODY ] [ PACKAGE_simple_name ] ; 11003 function Parse_Package_Body (Parent : Iir) return Iir 11004 is 11005 Res : Iir; 11006 End_Loc : Location_Type; 11007 begin 11008 Res := Create_Iir (Iir_Kind_Package_Body); 11009 Set_Parent (Res, Parent); 11010 11011 -- Get identifier. 11012 Scan_Identifier (Res); 11013 11014 -- Skip 'is'. 11015 Expect_Scan (Tok_Is); 11016 11017 Parse_Declarative_Part (Res, Get_Package_Parent (Res)); 11018 11019 End_Loc := Get_Token_Location; 11020 11021 -- Skip 'end' 11022 Expect_Scan (Tok_End); 11023 11024 if Current_Token = Tok_Package then 11025 if Flags.Vhdl_Std = Vhdl_87 then 11026 Error_Msg_Parse ("'package' keyword not allowed here by vhdl 87"); 11027 end if; 11028 Set_End_Has_Reserved_Id (Res, True); 11029 11030 -- Skip 'package' 11031 Scan; 11032 11033 if Current_Token /= Tok_Body then 11034 Error_Msg_Parse ("missing 'body' after 'package'"); 11035 else 11036 -- Skip 'body' 11037 Scan; 11038 end if; 11039 end if; 11040 11041 Check_End_Name (Res); 11042 Scan_Semi_Colon_Unit ("package body"); 11043 11044 if Flag_Elocations then 11045 Create_Elocations (Res); 11046 Set_End_Location (Res, End_Loc); 11047 end if; 11048 11049 return Res; 11050 end Parse_Package_Body; 11051 11052 -- precond : NEW 11053 -- postcond: ';'. 11054 -- 11055 -- [ LRM08 4.9 ] 11056 -- package_instantiation_declaration ::= 11057 -- PACKAGE identifier IS NEW uninstantiated_package_name 11058 -- [ generic_map_aspect ] ; 11059 function Parse_Package_Instantiation_Declaration 11060 (Parent : Iir; Id : Name_Id; Loc : Location_Type) return Iir 11061 is 11062 Res: Iir; 11063 begin 11064 Res := Create_Iir (Iir_Kind_Package_Instantiation_Declaration); 11065 Set_Location (Res, Loc); 11066 Set_Identifier (Res, Id); 11067 Set_Parent (Res, Parent); 11068 11069 -- Skip 'new' 11070 Scan; 11071 11072 Set_Uninstantiated_Package_Name (Res, Parse_Name (False)); 11073 11074 if Current_Token = Tok_Generic then 11075 Set_Generic_Map_Aspect_Chain (Res, Parse_Generic_Map_Aspect); 11076 elsif Current_Token = Tok_Left_Paren then 11077 Error_Msg_Parse ("missing 'generic map'"); 11078 Set_Generic_Map_Aspect_Chain 11079 (Res, Parse_Association_List_In_Parenthesis); 11080 end if; 11081 11082 if Flag_Elocations then 11083 Create_Elocations (Res); 11084 Set_End_Location (Res, Get_Token_Location); 11085 end if; 11086 11087 Scan_Semi_Colon_Unit ("package instantiation"); 11088 11089 return Res; 11090 end Parse_Package_Instantiation_Declaration; 11091 11092 -- precond : PACKAGE 11093 -- postcond: next token. 11094 -- 11095 -- package_declaration 11096 -- | package_body 11097 -- | package_instantiation_declaration 11098 function Parse_Package (Parent : Iir) return Iir 11099 is 11100 Loc : Location_Type; 11101 Id : Name_Id; 11102 Res : Iir; 11103 Start_Loc : Location_Type; 11104 begin 11105 -- Skip 'package' 11106 Start_Loc := Get_Token_Location; 11107 Scan; 11108 11109 if Current_Token = Tok_Body then 11110 -- Skip 'body' 11111 Scan; 11112 11113 Res := Parse_Package_Body (Parent); 11114 else 11115 Loc := Get_Token_Location; 11116 if Current_Token = Tok_Identifier then 11117 Id := Current_Identifier; 11118 11119 -- Skip identifier. 11120 Scan; 11121 else 11122 Expect (Tok_Identifier); 11123 end if; 11124 11125 -- Skip 'is'. 11126 Expect_Scan (Tok_Is); 11127 11128 if Current_Token = Tok_New then 11129 Res := Parse_Package_Instantiation_Declaration (Parent, Id, Loc); 11130 -- Note: there is no 'end' in instantiation. 11131 else 11132 Res := Parse_Package_Declaration (Parent, Id, Loc); 11133 end if; 11134 end if; 11135 11136 if Flag_Elocations then 11137 Set_Start_Location (Res, Start_Loc); 11138 end if; 11139 11140 return Res; 11141 end Parse_Package; 11142 11143 -- 1850-2005 7.2 Verification units 11144 -- verification_unit ::= 11145 -- vunit_type PSL_Identifier [ ( hierachical_hdl_name ) ] { 11146 -- { inherit_spec } 11147 -- { vunit_item } 11148 -- } 11149 procedure Parse_Verification_Unit (Unit : Iir_Design_Unit) 11150 is 11151 Kind : constant Iir_Kind := Iir_Kind_Vunit_Declaration; 11152 Hier_Name : Iir; 11153 Res : Iir; 11154 Item, Last_Item : Iir; 11155 11156 Label : Name_Id; 11157 Loc : Location_Type; 11158 begin 11159 Res := Create_Iir (Kind); 11160 Set_Parent (Res, Unit); 11161 11162 -- Recognize PSL keywords. 11163 Vhdl.Scanner.Flag_Psl := True; 11164 11165 -- Skip 'vunit'. 11166 Scan; 11167 11168 -- Identifier. 11169 Scan_Identifier (Res); 11170 11171 -- Hierarchical hdl name. 11172 if Current_Token = Tok_Left_Paren then 11173 -- Skip '('. 11174 Scan; 11175 11176 Hier_Name := Create_Iir (Iir_Kind_Psl_Hierarchical_Name); 11177 Set_Location (Hier_Name); 11178 Set_Hierarchical_Name (Res, Hier_Name); 11179 11180 Set_Entity_Name (Hier_Name, Parse_Simple_Name); 11181 11182 if Current_Token = Tok_Left_Paren then 11183 -- Skip '('. 11184 Scan; 11185 11186 Set_Architecture (Hier_Name, Parse_Simple_Name); 11187 11188 -- Skip ')'. 11189 Expect_Scan (Tok_Right_Paren); 11190 end if; 11191 11192 -- Skip ')' 11193 Expect_Scan (Tok_Right_Paren); 11194 end if; 11195 11196 -- Skip '{'. 11197 Expect_Scan (Tok_Left_Curly); 11198 11199 -- TODO: inherit spec. 11200 11201 -- Vunit items. 11202 Last_Item := Null_Iir; 11203 loop 11204 -- Some parse subprograms clear the mode... 11205 Vhdl.Scanner.Flag_Psl := True; 11206 11207 if Current_Token = Tok_Identifier then 11208 Label := Current_Identifier; 11209 Loc := Get_Token_Location; 11210 11211 -- Skip label. 11212 Scan; 11213 11214 if Current_Token = Tok_Colon then 11215 -- Skip ':'. 11216 Scan; 11217 else 11218 Item := Parse_Concurrent_Assignment_With_Name (Label, Loc); 11219 goto Has_Stmt; 11220 end if; 11221 else 11222 Label := Null_Identifier; 11223 end if; 11224 11225 case Current_Token is 11226 when Tok_Type 11227 | Tok_Subtype 11228 | Tok_Signal 11229 | Tok_Constant 11230 | Tok_Variable 11231 | Tok_Shared 11232 | Tok_File 11233 | Tok_Function 11234 | Tok_Pure 11235 | Tok_Impure 11236 | Tok_Procedure 11237 | Tok_Alias 11238 | Tok_For 11239 | Tok_Attribute 11240 | Tok_Disconnect 11241 | Tok_Use 11242 | Tok_Group 11243 | Tok_Package 11244 | Tok_Default => 11245 if Label /= Null_Identifier then 11246 Error_Msg_Sem 11247 (+Loc, "label not allowed before a declaration"); 11248 Label := Null_Identifier; 11249 end if; 11250 -- Do not recognize PSL keywords. This is required for 11251 -- 'boolean' which is a PSL keyword. 11252 Vhdl.Scanner.Flag_Psl := False; 11253 Item := Parse_Declaration (Res, Res); 11254 11255 when Tok_End 11256 | Tok_Eof 11257 | Tok_Right_Curly => 11258 exit; 11259 11260 when others => 11261 -- Do not recognize PSL keywords. This is required for 11262 -- 'boolean' which is a PSL keyword. 11263 Vhdl.Scanner.Flag_Psl := False; 11264 Item := Parse_Concurrent_Statement (Res, Label); 11265 exit when Item = Null_Iir; 11266 end case; 11267 11268 <<Has_Stmt>> null; 11269 11270 while Item /= Null_Iir loop 11271 Set_Parent (Item, Res); 11272 if Last_Item = Null_Node then 11273 Set_Vunit_Item_Chain (Res, Item); 11274 else 11275 Set_Chain (Last_Item, Item); 11276 end if; 11277 Last_Item := Item; 11278 Item := Get_Chain (Item); 11279 end loop; 11280 end loop; 11281 11282 -- Skip '}'. 11283 Expect_Scan (Tok_Right_Curly); 11284 11285 -- Normal mode. 11286 Vhdl.Scanner.Flag_Psl := False; 11287 11288 Set_Library_Unit (Unit, Res); 11289 end Parse_Verification_Unit; 11290 11291 procedure Parse_Context_Declaration_Or_Reference 11292 (Unit : Iir_Design_Unit; Clause : out Iir); 11293 11294 -- Precond: next token 11295 -- Postcond: next token 11296 -- 11297 -- [ LRM93 11.3, LRM08 13.4 Context clauses ] 11298 -- context_clause ::= { context_item } 11299 -- 11300 -- context_item ::= library_clause | use_clause | context_reference 11301 procedure Parse_Context_Clause (Unit : Iir) 11302 is 11303 First, Last : Iir; 11304 Els : Iir; 11305 begin 11306 Chain_Init (First, Last); 11307 11308 loop 11309 case Current_Token is 11310 when Tok_Library => 11311 Els := Parse_Library_Clause; 11312 when Tok_Use => 11313 Els := Parse_Use_Clause; 11314 when Tok_Context => 11315 Parse_Context_Declaration_Or_Reference (Unit, Els); 11316 if Els = Null_Iir then 11317 -- This was a context declaration. No more clause. 11318 11319 -- LRM08 13.1 Design units 11320 -- It is an error if the context clause preceding a library 11321 -- unit that is a context declaration is not empty. 11322 if Get_Context_Items (Unit) /= Null_Iir then 11323 Error_Msg_Parse 11324 (+Get_Context_Items (Unit), 11325 "context declaration does not allow context " 11326 & "clauses before it"); 11327 end if; 11328 11329 return; 11330 end if; 11331 when Tok_With => 11332 -- Be Ada friendly. 11333 Error_Msg_Parse ("'with' not allowed in context clause " 11334 & "(try 'use' or 'library')"); 11335 Els := Parse_Use_Clause; 11336 when others => 11337 exit; 11338 end case; 11339 Chain_Append_Subchain (First, Last, Els); 11340 end loop; 11341 Set_Context_Items (Unit, First); 11342 end Parse_Context_Clause; 11343 11344 -- Precond: IS 11345 -- 11346 -- [ LRM08 13.13 Context declarations ] 11347 -- context_declaration ::= 11348 -- CONTEXT identifier IS 11349 -- context_clause 11350 -- END [ CONTEXT ] [ /context/_simple_name ] ; 11351 procedure Parse_Context_Declaration (Unit : Iir; Decl : Iir) 11352 is 11353 End_Loc : Location_Type; 11354 begin 11355 Set_Library_Unit (Unit, Decl); 11356 11357 -- Skip 'is' 11358 Scan; 11359 11360 Parse_Context_Clause (Decl); 11361 11362 Expect (Tok_End); 11363 End_Loc := Get_Token_Location; 11364 11365 -- Skip 'end' 11366 Scan; 11367 11368 if Current_Token = Tok_Context then 11369 Set_End_Has_Reserved_Id (Decl, True); 11370 11371 -- Skip 'context'. 11372 Scan; 11373 end if; 11374 11375 Check_End_Name (Decl); 11376 Scan_Semi_Colon_Unit ("context declaration"); 11377 11378 if Flag_Elocations then 11379 Create_Elocations (Decl); 11380 Set_End_Location (Decl, End_Loc); 11381 end if; 11382 end Parse_Context_Declaration; 11383 11384 -- Precond: next token after selected_name. 11385 -- Postcond: next token 11386 -- 11387 -- [ LRM08 13.4 Context clauses ] 11388 -- 11389 -- context_reference ::= 11390 -- CONTEXT selected_name { , selected_name } 11391 function Parse_Context_Reference 11392 (Loc : Location_Type; Name : Iir) return Iir 11393 is 11394 Ref : Iir; 11395 First, Last : Iir; 11396 begin 11397 Ref := Create_Iir (Iir_Kind_Context_Reference); 11398 Set_Location (Ref, Loc); 11399 Set_Selected_Name (Ref, Name); 11400 First := Ref; 11401 Last := Ref; 11402 11403 while Current_Token = Tok_Comma loop 11404 -- Skip ','. 11405 Scan; 11406 11407 Ref := Create_Iir (Iir_Kind_Context_Reference); 11408 Set_Location (Ref, Loc); 11409 Set_Selected_Name (Ref, Parse_Name); 11410 11411 Set_Context_Reference_Chain (Last, Ref); 11412 Last := Ref; 11413 end loop; 11414 11415 Scan_Semi_Colon_Unit ("context reference"); 11416 11417 return First; 11418 end Parse_Context_Reference; 11419 11420 -- Precond: CONTEXT 11421 -- 11422 procedure Parse_Context_Declaration_Or_Reference 11423 (Unit : Iir_Design_Unit; Clause : out Iir) 11424 is 11425 Loc : Location_Type; 11426 Name : Iir; 11427 Res : Iir; 11428 begin 11429 Loc := Get_Token_Location; 11430 11431 -- Skip 'context'. 11432 Scan; 11433 11434 Name := Parse_Name; 11435 11436 if Current_Token = Tok_Is then 11437 Res := Create_Iir (Iir_Kind_Context_Declaration); 11438 if Get_Kind (Name) = Iir_Kind_Simple_Name then 11439 Location_Copy (Res, Name); 11440 Set_Identifier (Res, Get_Identifier (Name)); 11441 else 11442 Set_Location (Res, Loc); 11443 Error_Msg_Parse (+Name, "identifier for context expected"); 11444 end if; 11445 Free_Iir (Name); 11446 11447 Parse_Context_Declaration (Unit, Res); 11448 Clause := Null_Iir; 11449 else 11450 Clause := Parse_Context_Reference (Loc, Name); 11451 end if; 11452 end Parse_Context_Declaration_Or_Reference; 11453 11454 -- Parse a design_unit. 11455 -- The lexical scanner must have been initialized, but without a 11456 -- current_token. 11457 -- 11458 -- [ LRM93 11.1 ] 11459 -- design_unit ::= context_clause library_unit 11460 function Parse_Design_Unit return Iir_Design_Unit 11461 is 11462 procedure Error_Empty is 11463 begin 11464 Error_Msg_Parse 11465 ("missing entity, architecture, package or configuration"); 11466 end Error_Empty; 11467 11468 Res: Iir_Design_Unit; 11469 Unit: Iir; 11470 begin 11471 pragma Assert (Parenthesis_Depth = 0); 11472 11473 -- Create the design unit node. 11474 Res := Create_Iir (Iir_Kind_Design_Unit); 11475 Set_Location (Res); 11476 Set_Date_State (Res, Date_Extern); 11477 11478 Parse_Context_Clause (Res); 11479 11480 if Get_Library_Unit (Res) = Null_Iir then 11481 -- Parse library unit. Context declaration are already parsed. 11482 case Current_Token is 11483 when Tok_Entity => 11484 Parse_Entity_Declaration (Res); 11485 when Tok_Architecture => 11486 Parse_Architecture_Body (Res); 11487 when Tok_Package => 11488 Set_Library_Unit (Res, Parse_Package (Res)); 11489 when Tok_Configuration => 11490 Parse_Configuration_Declaration (Res); 11491 when Tok_Vunit => 11492 Parse_Verification_Unit (Res); 11493 when Tok_Identifier => 11494 if Current_Identifier = Name_Context then 11495 Error_Msg_Parse 11496 ("context clause not allowed before vhdl 08"); 11497 else 11498 Error_Empty; 11499 end if; 11500 Resync_To_Next_Unit; 11501 return Res; 11502 when others => 11503 Error_Empty; 11504 Resync_To_Next_Unit; 11505 return Res; 11506 end case; 11507 end if; 11508 11509 Unit := Get_Library_Unit (Res); 11510 Set_Design_Unit (Unit, Res); 11511 Set_Identifier (Res, Get_Identifier (Unit)); 11512 Set_Date (Res, Date_Parsed); 11513 return Res; 11514 end Parse_Design_Unit; 11515 11516 -- [ LRM93 11.1 ] 11517 -- design_file ::= design_unit { design_unit } 11518 function Parse_Design_File return Iir_Design_File 11519 is 11520 Res : Iir_Design_File; 11521 Design, Last_Design : Iir_Design_Unit; 11522 begin 11523 -- The first token. 11524 pragma Assert (Current_Token = Tok_Invalid); 11525 Scan; 11526 11527 Res := Create_Iir (Iir_Kind_Design_File); 11528 Set_Location (Res); 11529 11530 Last_Design := Null_Iir; 11531 while Current_Token /= Tok_Eof loop 11532 Design := Parse_Design_Unit; 11533 Set_Design_File (Design, Res); 11534 11535 -- Append unit to the design file. 11536 if Last_Design = Null_Iir then 11537 Set_First_Design_Unit (Res, Design); 11538 else 11539 Set_Chain (Last_Design, Design); 11540 end if; 11541 Last_Design := Design; 11542 Set_Last_Design_Unit (Res, Last_Design); 11543 end loop; 11544 11545 if Last_Design = Null_Iir then 11546 Error_Msg_Parse ("design file is empty (no design unit found)"); 11547 end if; 11548 11549 return Res; 11550 end Parse_Design_File; 11551end Vhdl.Parse; 11552