1-- PSL - Nodes definition. This is in fact -*- Ada -*- 2-- Copyright (C) 2002-2016 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with Ada.Unchecked_Conversion; 18with Tables; 19with PSL.Errors; 20with PSL.Hash; 21with PSL.Nodes_Meta; use PSL.Nodes_Meta; 22 23package body PSL.Nodes is 24 -- Suppress the access check of the table base. This is really safe to 25 -- suppress this check because the table base cannot be null. 26 pragma Suppress (Access_Check); 27 28 -- Suppress the index check on the table. 29 -- Could be done during non-debug, since this may catch errors (reading 30 -- Null_Node. 31 --pragma Suppress (Index_Check); 32 33 type Format_Type is 34 ( 35 Format_Short 36 ); 37 38 -- Common fields are: 39 -- Flag1 : Boolean 40 -- Flag2 : Boolean 41 -- Flag3 : Boolean 42 -- Flag4 : Boolean 43 -- Flag5 : Boolean 44 -- Flag6 : Boolean 45 -- Nkind : Kind_Type 46 -- State1 : Bit2_Type 47 -- State2 : Bit2_Type 48 -- Location : Int32 49 -- Field1 : Node 50 -- Field2 : Node 51 -- Field3 : Node 52 -- Field4 : Node 53 54 -- Fields of Format_Short: 55 -- Field5 : Node 56 -- Field6 : Node 57 58 type State_Type is range 0 .. 3; 59 type Bit3_Type is range 0 .. 7; 60 61 type Node_Record is record 62 Kind : Nkind; 63 Flag1 : Boolean; 64 Flag2 : Boolean; 65 Flag3 : Boolean; 66 Flag4 : Boolean; 67 Flag5 : Boolean; 68 Flag6 : Boolean; 69 Flag7 : Boolean; 70 Flag8 : Boolean; 71 Flag9 : Boolean; 72 Flag10 : Boolean; 73 Flag11 : Boolean; 74 Flag12 : Boolean; 75 Flag13 : Boolean; 76 Flag14 : Boolean; 77 Flag15 : Boolean; 78 Flag16 : Boolean; 79 State1 : State_Type; 80 B3_1 : Bit3_Type; 81 Flag17 : Boolean; 82 Flag18 : Boolean; 83 Flag19 : Boolean; 84 85 Location : Int32; 86 Field1 : Node; 87 Field2 : Node; 88 Field3 : Node; 89 Field4 : Node; 90 Field5 : Node; 91 Field6 : Node; 92 end record; 93 pragma Pack (Node_Record); 94 for Node_Record'Size use 8 * 32; 95 96 package Nodet is new Tables 97 (Table_Component_Type => Node_Record, 98 Table_Index_Type => Node, 99 Table_Low_Bound => 1, 100 Table_Initial => 1024); 101 102 Init_Node : constant Node_Record := (Kind => N_Error, 103 Flag1 => False, 104 Flag2 => False, 105 State1 => 0, 106 B3_1 => 0, 107 Location => 0, 108 Field1 => 0, 109 Field2 => 0, 110 Field3 => 0, 111 Field4 => 0, 112 Field5 => 0, 113 Field6 => 0, 114 others => False); 115 116 Free_Nodes : Node := Null_Node; 117 118 119 function Get_Last_Node return Node is 120 begin 121 return Nodet.Last; 122 end Get_Last_Node; 123 124 function Node_To_Uns32 is new Ada.Unchecked_Conversion 125 (Source => Node, Target => Uns32); 126 127 function Uns32_To_Node is new Ada.Unchecked_Conversion 128 (Source => Uns32, Target => Node); 129 130 function Node_To_Int32 is new Ada.Unchecked_Conversion 131 (Source => Node, Target => Int32); 132 133 function Int32_To_Node is new Ada.Unchecked_Conversion 134 (Source => Int32, Target => Node); 135 136 function Node_To_NFA is new Ada.Unchecked_Conversion 137 (Source => Node, Target => NFA); 138 139 function NFA_To_Node is new Ada.Unchecked_Conversion 140 (Source => NFA, Target => Node); 141 142 function Node_To_HDL_Node is new Ada.Unchecked_Conversion 143 (Source => Node, Target => HDL_Node); 144 145 function HDL_Node_To_Node is new Ada.Unchecked_Conversion 146 (Source => HDL_Node, Target => Node); 147 148 procedure Set_Kind (N : Node; K : Nkind) is 149 begin 150 Nodet.Table (N).Kind := K; 151 end Set_Kind; 152 153 function Get_Kind (N : Node) return Nkind is 154 begin 155 return Nodet.Table (N).Kind; 156 end Get_Kind; 157 158 159 procedure Set_Flag1 (N : Node; Flag : Boolean) is 160 begin 161 Nodet.Table (N).Flag1 := Flag; 162 end Set_Flag1; 163 164 function Get_Flag1 (N : Node) return Boolean is 165 begin 166 return Nodet.Table (N).Flag1; 167 end Get_Flag1; 168 169 procedure Set_Flag2 (N : Node; Flag : Boolean) is 170 begin 171 Nodet.Table (N).Flag2 := Flag; 172 end Set_Flag2; 173 174 function Get_Flag2 (N : Node) return Boolean is 175 begin 176 return Nodet.Table (N).Flag2; 177 end Get_Flag2; 178 179 180 procedure Set_State1 (N : Node; S : State_Type) is 181 begin 182 Nodet.Table (N).State1 := S; 183 end Set_State1; 184 185 function Get_State1 (N : Node) return State_Type is 186 begin 187 return Nodet.Table (N).State1; 188 end Get_State1; 189 190 191 function Get_Location (N : Node) return Location_Type is 192 begin 193 return Location_Type (Nodet.Table (N).Location); 194 end Get_Location; 195 196 procedure Set_Location (N : Node; Loc : Location_Type) is 197 begin 198 Nodet.Table (N).Location := Int32 (Loc); 199 end Set_Location; 200 201 procedure Copy_Location (N : Node; Src : Node) is 202 begin 203 Set_Location (N, Get_Location (Src)); 204 end Copy_Location; 205 206 procedure Set_Field1 (N : Node; V : Node) is 207 begin 208 Nodet.Table (N).Field1 := V; 209 end Set_Field1; 210 211 function Get_Field1 (N : Node) return Node is 212 begin 213 return Nodet.Table (N).Field1; 214 end Get_Field1; 215 216 217 procedure Set_Field2 (N : Node; V : Node) is 218 begin 219 Nodet.Table (N).Field2 := V; 220 end Set_Field2; 221 222 function Get_Field2 (N : Node) return Node is 223 begin 224 return Nodet.Table (N).Field2; 225 end Get_Field2; 226 227 228 function Get_Field3 (N : Node) return Node is 229 begin 230 return Nodet.Table (N).Field3; 231 end Get_Field3; 232 233 procedure Set_Field3 (N : Node; V : Node) is 234 begin 235 Nodet.Table (N).Field3 := V; 236 end Set_Field3; 237 238 239 function Get_Field4 (N : Node) return Node is 240 begin 241 return Nodet.Table (N).Field4; 242 end Get_Field4; 243 244 procedure Set_Field4 (N : Node; V : Node) is 245 begin 246 Nodet.Table (N).Field4 := V; 247 end Set_Field4; 248 249 250 function Get_Field5 (N : Node) return Node is 251 begin 252 return Nodet.Table (N).Field5; 253 end Get_Field5; 254 255 procedure Set_Field5 (N : Node; V : Node) is 256 begin 257 Nodet.Table (N).Field5 := V; 258 end Set_Field5; 259 260 261 function Get_Field6 (N : Node) return Node is 262 begin 263 return Nodet.Table (N).Field6; 264 end Get_Field6; 265 266 procedure Set_Field6 (N : Node; V : Node) is 267 begin 268 Nodet.Table (N).Field6 := V; 269 end Set_Field6; 270 271 272 function Get_Format (Kind : Nkind) return Format_Type; 273 pragma Unreferenced (Get_Format); 274 275 function Create_Node (Kind : Nkind) return Node 276 is 277 Res : Node; 278 begin 279 if Free_Nodes /= Null_Node then 280 Res := Free_Nodes; 281 Free_Nodes := Get_Field1 (Res); 282 else 283 Nodet.Increment_Last; 284 Res := Nodet.Last; 285 end if; 286 Nodet.Table (Res) := Init_Node; 287 Set_Kind (Res, Kind); 288 return Res; 289 end Create_Node; 290 291 procedure Free_Node (N : Node) 292 is 293 begin 294 Set_Kind (N, N_Error); 295 Set_Field1 (N, Free_Nodes); 296 Free_Nodes := N; 297 end Free_Node; 298 299 procedure Failed (Msg : String; N : Node) 300 is 301 begin 302 Errors.Error_Kind (Msg, N); 303 end Failed; 304 305 procedure Init (Loc : Location_Type) is 306 begin 307 pragma Assert (Loc /= No_Location); 308 Nodet.Init; 309 310 if Create_Node (N_False) /= False_Node then 311 raise Internal_Error; 312 end if; 313 Set_Location (False_Node, Loc); 314 315 if Create_Node (N_True) /= True_Node then 316 raise Internal_Error; 317 end if; 318 Set_Location (True_Node, Loc); 319 320 if Create_Node (N_Number) /= One_Node then 321 raise Internal_Error; 322 end if; 323 Set_Value (One_Node, 1); 324 Set_Location (One_Node, Loc); 325 326 if Create_Node (N_EOS) /= EOS_Node then 327 raise Internal_Error; 328 end if; 329 Set_Hash (EOS_Node, 0); 330 Set_Location (EOS_Node, Loc); 331 PSL.Hash.Init; 332 end Init; 333 334 function Get_Psl_Type (N : Node) return PSL_Types is 335 begin 336 case Get_Kind (N) is 337 when N_And_Prop 338 | N_Or_Prop 339 | N_Paren_Prop 340 | N_Log_Imp_Prop 341 | N_Log_Equiv_Prop 342 | N_Always 343 | N_Never 344 | N_Eventually 345 | N_Next 346 | N_Next_E 347 | N_Next_A 348 | N_Next_Event 349 | N_Next_Event_A 350 | N_Next_Event_E 351 | N_Before 352 | N_Until 353 | N_Abort 354 | N_Strong 355 | N_Property_Parameter 356 | N_Property_Instance => 357 return Type_Property; 358 when N_Braced_SERE 359 | N_Concat_SERE 360 | N_Fusion_SERE 361 | N_Within_SERE 362 | N_Clocked_SERE 363 | N_Overlap_Imp_Seq 364 | N_Imp_Seq 365 | N_And_Seq 366 | N_Or_Seq 367 | N_Match_And_Seq 368 | N_Star_Repeat_Seq 369 | N_Goto_Repeat_Seq 370 | N_Equal_Repeat_Seq 371 | N_Plus_Repeat_Seq 372 | N_Clock_Event 373 | N_Sequence_Instance 374 | N_Endpoint_Instance 375 | N_Sequence_Parameter => 376 return Type_Sequence; 377 when N_Name => 378 return Get_Psl_Type (Get_Decl (N)); 379 when N_HDL_Expr => 380 -- FIXME. 381 return Type_Boolean; 382 when N_Or_Bool 383 | N_And_Bool 384 | N_Not_Bool 385 | N_Imp_Bool 386 | N_Equiv_Bool 387 | N_False 388 | N_True 389 | N_Boolean_Parameter 390 | N_Paren_Bool 391 | N_HDL_Bool => 392 return Type_Boolean; 393 when N_Number 394 | N_Const_Parameter => 395 return Type_Numeric; 396 when N_Vmode 397 | N_Vunit 398 | N_Vprop 399 | N_Hdl_Mod_Name 400 | N_Assert_Directive 401 | N_Sequence_Declaration 402 | N_Endpoint_Declaration 403 | N_Property_Declaration 404 | N_Actual 405 | N_Name_Decl 406 | N_Error 407 | N_EOS => 408 PSL.Errors.Error_Kind ("get_psl_type", N); 409 end case; 410 end Get_Psl_Type; 411 412 procedure Reference_Failed (Msg : String; N : Node) is 413 begin 414 Failed (Msg, N); 415 end Reference_Failed; 416 pragma Unreferenced (Reference_Failed); 417 418 -- Subprograms 419 function Get_Format (Kind : Nkind) return Format_Type is 420 begin 421 case Kind is 422 when N_Error 423 | N_Vmode 424 | N_Vunit 425 | N_Vprop 426 | N_Hdl_Mod_Name 427 | N_Assert_Directive 428 | N_Property_Declaration 429 | N_Sequence_Declaration 430 | N_Endpoint_Declaration 431 | N_Const_Parameter 432 | N_Boolean_Parameter 433 | N_Property_Parameter 434 | N_Sequence_Parameter 435 | N_Sequence_Instance 436 | N_Endpoint_Instance 437 | N_Property_Instance 438 | N_Actual 439 | N_Clock_Event 440 | N_Always 441 | N_Never 442 | N_Eventually 443 | N_Strong 444 | N_Imp_Seq 445 | N_Overlap_Imp_Seq 446 | N_Log_Imp_Prop 447 | N_Log_Equiv_Prop 448 | N_Next 449 | N_Next_A 450 | N_Next_E 451 | N_Next_Event 452 | N_Next_Event_A 453 | N_Next_Event_E 454 | N_Abort 455 | N_Until 456 | N_Before 457 | N_Or_Prop 458 | N_And_Prop 459 | N_Paren_Prop 460 | N_Braced_SERE 461 | N_Concat_SERE 462 | N_Fusion_SERE 463 | N_Within_SERE 464 | N_Clocked_SERE 465 | N_Match_And_Seq 466 | N_And_Seq 467 | N_Or_Seq 468 | N_Star_Repeat_Seq 469 | N_Goto_Repeat_Seq 470 | N_Plus_Repeat_Seq 471 | N_Equal_Repeat_Seq 472 | N_Paren_Bool 473 | N_Not_Bool 474 | N_And_Bool 475 | N_Or_Bool 476 | N_Imp_Bool 477 | N_Equiv_Bool 478 | N_HDL_Expr 479 | N_HDL_Bool 480 | N_False 481 | N_True 482 | N_EOS 483 | N_Name 484 | N_Name_Decl 485 | N_Number => 486 return Format_Short; 487 end case; 488 end Get_Format; 489 490 function Get_Identifier (N : Node) return Name_Id is 491 begin 492 pragma Assert (N /= Null_Node); 493 pragma Assert (Has_Identifier (Get_Kind (N)), 494 "no field Identifier"); 495 return Name_Id'Val (Get_Field1 (N)); 496 end Get_Identifier; 497 498 procedure Set_Identifier (N : Node; Id : Name_Id) is 499 begin 500 pragma Assert (N /= Null_Node); 501 pragma Assert (Has_Identifier (Get_Kind (N)), 502 "no field Identifier"); 503 Set_Field1 (N, Name_Id'Pos (Id)); 504 end Set_Identifier; 505 506 function Get_Label (N : Node) return Name_Id is 507 begin 508 pragma Assert (N /= Null_Node); 509 pragma Assert (Has_Label (Get_Kind (N)), 510 "no field Label"); 511 return Name_Id'Val (Get_Field1 (N)); 512 end Get_Label; 513 514 procedure Set_Label (N : Node; Id : Name_Id) is 515 begin 516 pragma Assert (N /= Null_Node); 517 pragma Assert (Has_Label (Get_Kind (N)), 518 "no field Label"); 519 Set_Field1 (N, Name_Id'Pos (Id)); 520 end Set_Label; 521 522 function Get_Chain (N : Node) return Node is 523 begin 524 pragma Assert (N /= Null_Node); 525 pragma Assert (Has_Chain (Get_Kind (N)), 526 "no field Chain"); 527 return Get_Field2 (N); 528 end Get_Chain; 529 530 procedure Set_Chain (N : Node; Chain : Node) is 531 begin 532 pragma Assert (N /= Null_Node); 533 pragma Assert (Has_Chain (Get_Kind (N)), 534 "no field Chain"); 535 Set_Field2 (N, Chain); 536 end Set_Chain; 537 538 function Get_Instance (N : Node) return Node is 539 begin 540 pragma Assert (N /= Null_Node); 541 pragma Assert (Has_Instance (Get_Kind (N)), 542 "no field Instance"); 543 return Get_Field3 (N); 544 end Get_Instance; 545 546 procedure Set_Instance (N : Node; Instance : Node) is 547 begin 548 pragma Assert (N /= Null_Node); 549 pragma Assert (Has_Instance (Get_Kind (N)), 550 "no field Instance"); 551 Set_Field3 (N, Instance); 552 end Set_Instance; 553 554 function Get_Prefix (N : Node) return Node is 555 begin 556 pragma Assert (N /= Null_Node); 557 pragma Assert (Has_Prefix (Get_Kind (N)), 558 "no field Prefix"); 559 return Get_Field2 (N); 560 end Get_Prefix; 561 562 procedure Set_Prefix (N : Node; Prefix : Node) is 563 begin 564 pragma Assert (N /= Null_Node); 565 pragma Assert (Has_Prefix (Get_Kind (N)), 566 "no field Prefix"); 567 Set_Field2 (N, Prefix); 568 end Set_Prefix; 569 570 function Get_Item_Chain (N : Node) return Node is 571 begin 572 pragma Assert (N /= Null_Node); 573 pragma Assert (Has_Item_Chain (Get_Kind (N)), 574 "no field Item_Chain"); 575 return Get_Field4 (N); 576 end Get_Item_Chain; 577 578 procedure Set_Item_Chain (N : Node; Item : Node) is 579 begin 580 pragma Assert (N /= Null_Node); 581 pragma Assert (Has_Item_Chain (Get_Kind (N)), 582 "no field Item_Chain"); 583 Set_Field4 (N, Item); 584 end Set_Item_Chain; 585 586 function Get_Property (N : Node) return Node is 587 begin 588 pragma Assert (N /= Null_Node); 589 pragma Assert (Has_Property (Get_Kind (N)), 590 "no field Property"); 591 return Get_Field4 (N); 592 end Get_Property; 593 594 procedure Set_Property (N : Node; Property : Node) is 595 begin 596 pragma Assert (N /= Null_Node); 597 pragma Assert (Has_Property (Get_Kind (N)), 598 "no field Property"); 599 Set_Field4 (N, Property); 600 end Set_Property; 601 602 function Get_String (N : Node) return Node is 603 begin 604 pragma Assert (N /= Null_Node); 605 pragma Assert (Has_String (Get_Kind (N)), 606 "no field String"); 607 return Get_Field3 (N); 608 end Get_String; 609 610 procedure Set_String (N : Node; Str : Node) is 611 begin 612 pragma Assert (N /= Null_Node); 613 pragma Assert (Has_String (Get_Kind (N)), 614 "no field String"); 615 Set_Field3 (N, Str); 616 end Set_String; 617 618 function Get_SERE (N : Node) return Node is 619 begin 620 pragma Assert (N /= Null_Node); 621 pragma Assert (Has_SERE (Get_Kind (N)), 622 "no field SERE"); 623 return Get_Field1 (N); 624 end Get_SERE; 625 626 procedure Set_SERE (N : Node; S : Node) is 627 begin 628 pragma Assert (N /= Null_Node); 629 pragma Assert (Has_SERE (Get_Kind (N)), 630 "no field SERE"); 631 Set_Field1 (N, S); 632 end Set_SERE; 633 634 function Get_Left (N : Node) return Node is 635 begin 636 pragma Assert (N /= Null_Node); 637 pragma Assert (Has_Left (Get_Kind (N)), 638 "no field Left"); 639 return Get_Field1 (N); 640 end Get_Left; 641 642 procedure Set_Left (N : Node; S : Node) is 643 begin 644 pragma Assert (N /= Null_Node); 645 pragma Assert (Has_Left (Get_Kind (N)), 646 "no field Left"); 647 Set_Field1 (N, S); 648 end Set_Left; 649 650 function Get_Right (N : Node) return Node is 651 begin 652 pragma Assert (N /= Null_Node); 653 pragma Assert (Has_Right (Get_Kind (N)), 654 "no field Right"); 655 return Get_Field2 (N); 656 end Get_Right; 657 658 procedure Set_Right (N : Node; S : Node) is 659 begin 660 pragma Assert (N /= Null_Node); 661 pragma Assert (Has_Right (Get_Kind (N)), 662 "no field Right"); 663 Set_Field2 (N, S); 664 end Set_Right; 665 666 function Get_Sequence (N : Node) return Node is 667 begin 668 pragma Assert (N /= Null_Node); 669 pragma Assert (Has_Sequence (Get_Kind (N)), 670 "no field Sequence"); 671 return Get_Field3 (N); 672 end Get_Sequence; 673 674 procedure Set_Sequence (N : Node; S : Node) is 675 begin 676 pragma Assert (N /= Null_Node); 677 pragma Assert (Has_Sequence (Get_Kind (N)), 678 "no field Sequence"); 679 Set_Field3 (N, S); 680 end Set_Sequence; 681 682 function Get_Strong_Flag (N : Node) return Boolean is 683 begin 684 pragma Assert (N /= Null_Node); 685 pragma Assert (Has_Strong_Flag (Get_Kind (N)), 686 "no field Strong_Flag"); 687 return Get_Flag1 (N); 688 end Get_Strong_Flag; 689 690 procedure Set_Strong_Flag (N : Node; B : Boolean) is 691 begin 692 pragma Assert (N /= Null_Node); 693 pragma Assert (Has_Strong_Flag (Get_Kind (N)), 694 "no field Strong_Flag"); 695 Set_Flag1 (N, B); 696 end Set_Strong_Flag; 697 698 function Get_Inclusive_Flag (N : Node) return Boolean is 699 begin 700 pragma Assert (N /= Null_Node); 701 pragma Assert (Has_Inclusive_Flag (Get_Kind (N)), 702 "no field Inclusive_Flag"); 703 return Get_Flag2 (N); 704 end Get_Inclusive_Flag; 705 706 procedure Set_Inclusive_Flag (N : Node; B : Boolean) is 707 begin 708 pragma Assert (N /= Null_Node); 709 pragma Assert (Has_Inclusive_Flag (Get_Kind (N)), 710 "no field Inclusive_Flag"); 711 Set_Flag2 (N, B); 712 end Set_Inclusive_Flag; 713 714 function Get_Low_Bound (N : Node) return Node is 715 begin 716 pragma Assert (N /= Null_Node); 717 pragma Assert (Has_Low_Bound (Get_Kind (N)), 718 "no field Low_Bound"); 719 return Get_Field1 (N); 720 end Get_Low_Bound; 721 722 procedure Set_Low_Bound (N : Node; S : Node) is 723 begin 724 pragma Assert (N /= Null_Node); 725 pragma Assert (Has_Low_Bound (Get_Kind (N)), 726 "no field Low_Bound"); 727 Set_Field1 (N, S); 728 end Set_Low_Bound; 729 730 function Get_High_Bound (N : Node) return Node is 731 begin 732 pragma Assert (N /= Null_Node); 733 pragma Assert (Has_High_Bound (Get_Kind (N)), 734 "no field High_Bound"); 735 return Get_Field2 (N); 736 end Get_High_Bound; 737 738 procedure Set_High_Bound (N : Node; S : Node) is 739 begin 740 pragma Assert (N /= Null_Node); 741 pragma Assert (Has_High_Bound (Get_Kind (N)), 742 "no field High_Bound"); 743 Set_Field2 (N, S); 744 end Set_High_Bound; 745 746 function Get_Number (N : Node) return Node is 747 begin 748 pragma Assert (N /= Null_Node); 749 pragma Assert (Has_Number (Get_Kind (N)), 750 "no field Number"); 751 return Get_Field1 (N); 752 end Get_Number; 753 754 procedure Set_Number (N : Node; S : Node) is 755 begin 756 pragma Assert (N /= Null_Node); 757 pragma Assert (Has_Number (Get_Kind (N)), 758 "no field Number"); 759 Set_Field1 (N, S); 760 end Set_Number; 761 762 function Get_Value (N : Node) return Uns32 is 763 begin 764 pragma Assert (N /= Null_Node); 765 pragma Assert (Has_Value (Get_Kind (N)), 766 "no field Value"); 767 return Node_To_Uns32 (Get_Field1 (N)); 768 end Get_Value; 769 770 procedure Set_Value (N : Node; Val : Uns32) is 771 begin 772 pragma Assert (N /= Null_Node); 773 pragma Assert (Has_Value (Get_Kind (N)), 774 "no field Value"); 775 Set_Field1 (N, Uns32_To_Node (Val)); 776 end Set_Value; 777 778 function Get_Boolean (N : Node) return Node is 779 begin 780 pragma Assert (N /= Null_Node); 781 pragma Assert (Has_Boolean (Get_Kind (N)), 782 "no field Boolean"); 783 return Get_Field3 (N); 784 end Get_Boolean; 785 786 procedure Set_Boolean (N : Node; B : Node) is 787 begin 788 pragma Assert (N /= Null_Node); 789 pragma Assert (Has_Boolean (Get_Kind (N)), 790 "no field Boolean"); 791 Set_Field3 (N, B); 792 end Set_Boolean; 793 794 function Get_Decl (N : Node) return Node is 795 begin 796 pragma Assert (N /= Null_Node); 797 pragma Assert (Has_Decl (Get_Kind (N)), 798 "no field Decl"); 799 return Get_Field2 (N); 800 end Get_Decl; 801 802 procedure Set_Decl (N : Node; D : Node) is 803 begin 804 pragma Assert (N /= Null_Node); 805 pragma Assert (Has_Decl (Get_Kind (N)), 806 "no field Decl"); 807 Set_Field2 (N, D); 808 end Set_Decl; 809 810 function Get_HDL_Node (N : Node) return HDL_Node is 811 begin 812 pragma Assert (N /= Null_Node); 813 pragma Assert (Has_HDL_Node (Get_Kind (N)), 814 "no field HDL_Node"); 815 return Node_To_HDL_Node (Get_Field1 (N)); 816 end Get_HDL_Node; 817 818 procedure Set_HDL_Node (N : Node; H : HDL_Node) is 819 begin 820 pragma Assert (N /= Null_Node); 821 pragma Assert (Has_HDL_Node (Get_Kind (N)), 822 "no field HDL_Node"); 823 Set_Field1 (N, HDL_Node_To_Node (H)); 824 end Set_HDL_Node; 825 826 function Get_Hash (N : Node) return Uns32 is 827 begin 828 pragma Assert (N /= Null_Node); 829 pragma Assert (Has_Hash (Get_Kind (N)), 830 "no field Hash"); 831 return Node_To_Uns32 (Get_Field5 (N)); 832 end Get_Hash; 833 834 procedure Set_Hash (N : Node; E : Uns32) is 835 begin 836 pragma Assert (N /= Null_Node); 837 pragma Assert (Has_Hash (Get_Kind (N)), 838 "no field Hash"); 839 Set_Field5 (N, Uns32_To_Node (E)); 840 end Set_Hash; 841 842 function Get_Hash_Link (N : Node) return Node is 843 begin 844 pragma Assert (N /= Null_Node); 845 pragma Assert (Has_Hash_Link (Get_Kind (N)), 846 "no field Hash_Link"); 847 return Get_Field6 (N); 848 end Get_Hash_Link; 849 850 procedure Set_Hash_Link (N : Node; E : Node) is 851 begin 852 pragma Assert (N /= Null_Node); 853 pragma Assert (Has_Hash_Link (Get_Kind (N)), 854 "no field Hash_Link"); 855 Set_Field6 (N, E); 856 end Set_Hash_Link; 857 858 function Get_HDL_Index (N : Node) return Int32 is 859 begin 860 pragma Assert (N /= Null_Node); 861 pragma Assert (Has_HDL_Index (Get_Kind (N)), 862 "no field HDL_Index"); 863 return Node_To_Int32 (Get_Field2 (N)); 864 end Get_HDL_Index; 865 866 procedure Set_HDL_Index (N : Node; Idx : Int32) is 867 begin 868 pragma Assert (N /= Null_Node); 869 pragma Assert (Has_HDL_Index (Get_Kind (N)), 870 "no field HDL_Index"); 871 Set_Field2 (N, Int32_To_Node (Idx)); 872 end Set_HDL_Index; 873 874 function Get_HDL_Hash (N : Node) return Node is 875 begin 876 pragma Assert (N /= Null_Node); 877 pragma Assert (Has_HDL_Hash (Get_Kind (N)), 878 "no field HDL_Hash"); 879 return Get_Field5 (N); 880 end Get_HDL_Hash; 881 882 procedure Set_HDL_Hash (N : Node; H : Node) is 883 begin 884 pragma Assert (N /= Null_Node); 885 pragma Assert (Has_HDL_Hash (Get_Kind (N)), 886 "no field HDL_Hash"); 887 Set_Field5 (N, H); 888 end Set_HDL_Hash; 889 890 function Get_Presence (N : Node) return PSL_Presence_Kind is 891 begin 892 pragma Assert (N /= Null_Node); 893 pragma Assert (Has_Presence (Get_Kind (N)), 894 "no field Presence"); 895 return PSL_Presence_Kind'Val (Get_State1 (N)); 896 end Get_Presence; 897 898 procedure Set_Presence (N : Node; P : PSL_Presence_Kind) is 899 begin 900 pragma Assert (N /= Null_Node); 901 pragma Assert (Has_Presence (Get_Kind (N)), 902 "no field Presence"); 903 Set_State1 (N, PSL_Presence_Kind'Pos (P)); 904 end Set_Presence; 905 906 function Get_NFA (N : Node) return NFA is 907 begin 908 pragma Assert (N /= Null_Node); 909 pragma Assert (Has_NFA (Get_Kind (N)), 910 "no field NFA"); 911 return Node_To_NFA (Get_Field5 (N)); 912 end Get_NFA; 913 914 procedure Set_NFA (N : Node; P : NFA) is 915 begin 916 pragma Assert (N /= Null_Node); 917 pragma Assert (Has_NFA (Get_Kind (N)), 918 "no field NFA"); 919 Set_Field5 (N, NFA_To_Node (P)); 920 end Set_NFA; 921 922 function Get_Parameter_List (N : Node) return Node is 923 begin 924 pragma Assert (N /= Null_Node); 925 pragma Assert (Has_Parameter_List (Get_Kind (N)), 926 "no field Parameter_List"); 927 return Get_Field5 (N); 928 end Get_Parameter_List; 929 930 procedure Set_Parameter_List (N : Node; E : Node) is 931 begin 932 pragma Assert (N /= Null_Node); 933 pragma Assert (Has_Parameter_List (Get_Kind (N)), 934 "no field Parameter_List"); 935 Set_Field5 (N, E); 936 end Set_Parameter_List; 937 938 function Get_Actual (N : Node) return Node is 939 begin 940 pragma Assert (N /= Null_Node); 941 pragma Assert (Has_Actual (Get_Kind (N)), 942 "no field Actual"); 943 return Get_Field3 (N); 944 end Get_Actual; 945 946 procedure Set_Actual (N : Node; E : Node) is 947 begin 948 pragma Assert (N /= Null_Node); 949 pragma Assert (Has_Actual (Get_Kind (N)), 950 "no field Actual"); 951 Set_Field3 (N, E); 952 end Set_Actual; 953 954 function Get_Formal (N : Node) return Node is 955 begin 956 pragma Assert (N /= Null_Node); 957 pragma Assert (Has_Formal (Get_Kind (N)), 958 "no field Formal"); 959 return Get_Field4 (N); 960 end Get_Formal; 961 962 procedure Set_Formal (N : Node; E : Node) is 963 begin 964 pragma Assert (N /= Null_Node); 965 pragma Assert (Has_Formal (Get_Kind (N)), 966 "no field Formal"); 967 Set_Field4 (N, E); 968 end Set_Formal; 969 970 function Get_Declaration (N : Node) return Node is 971 begin 972 pragma Assert (N /= Null_Node); 973 pragma Assert (Has_Declaration (Get_Kind (N)), 974 "no field Declaration"); 975 return Get_Field1 (N); 976 end Get_Declaration; 977 978 procedure Set_Declaration (N : Node; Decl : Node) is 979 begin 980 pragma Assert (N /= Null_Node); 981 pragma Assert (Has_Declaration (Get_Kind (N)), 982 "no field Declaration"); 983 Set_Field1 (N, Decl); 984 end Set_Declaration; 985 986 function Get_Association_Chain (N : Node) return Node is 987 begin 988 pragma Assert (N /= Null_Node); 989 pragma Assert (Has_Association_Chain (Get_Kind (N)), 990 "no field Association_Chain"); 991 return Get_Field2 (N); 992 end Get_Association_Chain; 993 994 procedure Set_Association_Chain (N : Node; Chain : Node) is 995 begin 996 pragma Assert (N /= Null_Node); 997 pragma Assert (Has_Association_Chain (Get_Kind (N)), 998 "no field Association_Chain"); 999 Set_Field2 (N, Chain); 1000 end Set_Association_Chain; 1001 1002 function Get_Global_Clock (N : Node) return Node is 1003 begin 1004 pragma Assert (N /= Null_Node); 1005 pragma Assert (Has_Global_Clock (Get_Kind (N)), 1006 "no field Global_Clock"); 1007 return Get_Field3 (N); 1008 end Get_Global_Clock; 1009 1010 procedure Set_Global_Clock (N : Node; Clock : Node) is 1011 begin 1012 pragma Assert (N /= Null_Node); 1013 pragma Assert (Has_Global_Clock (Get_Kind (N)), 1014 "no field Global_Clock"); 1015 Set_Field3 (N, Clock); 1016 end Set_Global_Clock; 1017 1018 1019end PSL.Nodes; 1020