1-- Tree node definitions. 2-- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with Ada.Unchecked_Conversion; 18with Tables; 19with Logging; use Logging; 20with Vhdl.Lists; use Vhdl.Lists; 21with Vhdl.Nodes_Meta; use Vhdl.Nodes_Meta; 22with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv; 23 24package body Vhdl.Nodes is 25 -- A simple type that needs only 2 bits. 26 type Bit2_Type is range 0 .. 2 ** 2 - 1; 27 28 type Kind_Type is range 0 .. 2 ** 9 - 1; 29 30 -- Format of a node. 31 type Format_Type is 32 ( 33 Format_Short, 34 Format_Medium 35 ); 36 37 -- Common fields are: 38 -- Flag1 : Boolean 39 -- Flag2 : Boolean 40 -- Flag3 : Boolean 41 -- Flag4 : Boolean 42 -- Flag5 : Boolean 43 -- Flag6 : Boolean 44 -- Flag7 : Boolean 45 -- Flag8 : Boolean 46 -- Flag9 : Boolean 47 -- Flag10 : Boolean 48 -- Flag11 : Boolean 49 -- Flag12 : Boolean 50 -- Flag13 : Boolean 51 -- Flag14 : Boolean 52 -- Flag15 : Boolean 53 -- Nkind : Kind_Type 54 -- State1 : Bit2_Type 55 -- State2 : Bit2_Type 56 -- Location : Location_Type 57 -- Field0 : Iir 58 -- Field1 : Iir 59 -- Field2 : Iir 60 -- Field3 : Iir 61 -- Field4 : Iir 62 -- Field5 : Iir 63 64 -- Fields of Format_Short: 65 66 -- Fields of Format_Medium: 67 -- State3 : Bit2_Type 68 -- State4 : Bit2_Type 69 -- Field6 : Iir (location) 70 -- Field7 : Iir (field0) 71 -- Field8 : Iir (field1) 72 -- Field9 : Iir (field2) 73 -- Field10 : Iir (field3) 74 -- Field11 : Iir (field4) 75 -- Field12 : Iir (field5) 76 77 function Create_Node (Format : Format_Type) return Node_Type; 78 procedure Free_Node (N : Node_Type); 79 80 function Get_Nkind (N : Node_Type) return Kind_Type; 81 pragma Inline (Get_Nkind); 82 procedure Set_Nkind (N : Node_Type; Kind : Kind_Type); 83 pragma Inline (Set_Nkind); 84 85 function Get_Field0 (N : Node_Type) return Node_Type; 86 pragma Inline (Get_Field0); 87 procedure Set_Field0 (N : Node_Type; V : Node_Type); 88 pragma Inline (Set_Field0); 89 90 function Get_Field1 (N : Node_Type) return Node_Type; 91 pragma Inline (Get_Field1); 92 procedure Set_Field1 (N : Node_Type; V : Node_Type); 93 pragma Inline (Set_Field1); 94 95 function Get_Field2 (N : Node_Type) return Node_Type; 96 pragma Inline (Get_Field2); 97 procedure Set_Field2 (N : Node_Type; V : Node_Type); 98 pragma Inline (Set_Field2); 99 100 function Get_Field3 (N : Node_Type) return Node_Type; 101 pragma Inline (Get_Field3); 102 procedure Set_Field3 (N : Node_Type; V : Node_Type); 103 pragma Inline (Set_Field3); 104 105 function Get_Field4 (N : Node_Type) return Node_Type; 106 pragma Inline (Get_Field4); 107 procedure Set_Field4 (N : Node_Type; V : Node_Type); 108 pragma Inline (Set_Field4); 109 110 111 function Get_Field5 (N : Node_Type) return Node_Type; 112 pragma Inline (Get_Field5); 113 procedure Set_Field5 (N : Node_Type; V : Node_Type); 114 pragma Inline (Set_Field5); 115 116 function Get_Field6 (N: Node_Type) return Node_Type; 117 pragma Inline (Get_Field6); 118 procedure Set_Field6 (N: Node_Type; Val: Node_Type); 119 pragma Inline (Set_Field6); 120 121 function Get_Field7 (N: Node_Type) return Node_Type; 122 pragma Inline (Get_Field7); 123 procedure Set_Field7 (N: Node_Type; Val: Node_Type); 124 pragma Inline (Set_Field7); 125 126 function Get_Field8 (N: Node_Type) return Node_Type; 127 pragma Inline (Get_Field8); 128 procedure Set_Field8 (N: Node_Type; Val: Node_Type); 129 pragma Inline (Set_Field8); 130 131 function Get_Field9 (N: Node_Type) return Node_Type; 132 pragma Inline (Get_Field9); 133 procedure Set_Field9 (N: Node_Type; Val: Node_Type); 134 pragma Inline (Set_Field9); 135 136 function Get_Field10 (N: Node_Type) return Node_Type; 137 pragma Inline (Get_Field10); 138 procedure Set_Field10 (N: Node_Type; Val: Node_Type); 139 pragma Inline (Set_Field10); 140 141 function Get_Field11 (N: Node_Type) return Node_Type; 142 pragma Inline (Get_Field11); 143 procedure Set_Field11 (N: Node_Type; Val: Node_Type); 144 pragma Inline (Set_Field11); 145 146 function Get_Field12 (N: Node_Type) return Node_Type; 147 pragma Inline (Get_Field12); 148 procedure Set_Field12 (N: Node_Type; Val: Node_Type); 149 pragma Inline (Set_Field12); 150 151 152 function Get_Flag1 (N : Node_Type) return Boolean; 153 pragma Inline (Get_Flag1); 154 procedure Set_Flag1 (N : Node_Type; V : Boolean); 155 pragma Inline (Set_Flag1); 156 157 function Get_Flag2 (N : Node_Type) return Boolean; 158 pragma Inline (Get_Flag2); 159 procedure Set_Flag2 (N : Node_Type; V : Boolean); 160 pragma Inline (Set_Flag2); 161 162 function Get_Flag3 (N : Node_Type) return Boolean; 163 pragma Inline (Get_Flag3); 164 procedure Set_Flag3 (N : Node_Type; V : Boolean); 165 pragma Inline (Set_Flag3); 166 167 function Get_Flag4 (N : Node_Type) return Boolean; 168 pragma Inline (Get_Flag4); 169 procedure Set_Flag4 (N : Node_Type; V : Boolean); 170 pragma Inline (Set_Flag4); 171 172 function Get_Flag5 (N : Node_Type) return Boolean; 173 pragma Inline (Get_Flag5); 174 procedure Set_Flag5 (N : Node_Type; V : Boolean); 175 pragma Inline (Set_Flag5); 176 177 function Get_Flag6 (N : Node_Type) return Boolean; 178 pragma Inline (Get_Flag6); 179 procedure Set_Flag6 (N : Node_Type; V : Boolean); 180 pragma Inline (Set_Flag6); 181 182 function Get_Flag7 (N : Node_Type) return Boolean; 183 pragma Inline (Get_Flag7); 184 procedure Set_Flag7 (N : Node_Type; V : Boolean); 185 pragma Inline (Set_Flag7); 186 187 function Get_Flag8 (N : Node_Type) return Boolean; 188 pragma Inline (Get_Flag8); 189 procedure Set_Flag8 (N : Node_Type; V : Boolean); 190 pragma Inline (Set_Flag8); 191 192 function Get_Flag9 (N : Node_Type) return Boolean; 193 pragma Inline (Get_Flag9); 194 procedure Set_Flag9 (N : Node_Type; V : Boolean); 195 pragma Inline (Set_Flag9); 196 197 function Get_Flag10 (N : Node_Type) return Boolean; 198 pragma Inline (Get_Flag10); 199 procedure Set_Flag10 (N : Node_Type; V : Boolean); 200 pragma Inline (Set_Flag10); 201 202 function Get_Flag11 (N : Node_Type) return Boolean; 203 pragma Inline (Get_Flag11); 204 procedure Set_Flag11 (N : Node_Type; V : Boolean); 205 pragma Inline (Set_Flag11); 206 207 function Get_Flag12 (N : Node_Type) return Boolean; 208 pragma Inline (Get_Flag12); 209 procedure Set_Flag12 (N : Node_Type; V : Boolean); 210 pragma Inline (Set_Flag12); 211 212 function Get_Flag13 (N : Node_Type) return Boolean; 213 pragma Inline (Get_Flag13); 214 procedure Set_Flag13 (N : Node_Type; V : Boolean); 215 pragma Inline (Set_Flag13); 216 217 function Get_Flag14 (N : Node_Type) return Boolean; 218 pragma Inline (Get_Flag14); 219 procedure Set_Flag14 (N : Node_Type; V : Boolean); 220 pragma Inline (Set_Flag14); 221 222 function Get_Flag15 (N : Node_Type) return Boolean; 223 pragma Inline (Get_Flag15); 224 procedure Set_Flag15 (N : Node_Type; V : Boolean); 225 pragma Inline (Set_Flag15); 226 227 228 function Get_State1 (N : Node_Type) return Bit2_Type; 229 pragma Inline (Get_State1); 230 procedure Set_State1 (N : Node_Type; V : Bit2_Type); 231 pragma Inline (Set_State1); 232 233 function Get_State2 (N : Node_Type) return Bit2_Type; 234 pragma Inline (Get_State2); 235 procedure Set_State2 (N : Node_Type; V : Bit2_Type); 236 pragma Inline (Set_State2); 237 238 function Get_State3 (N : Node_Type) return Bit2_Type; 239 pragma Inline (Get_State3); 240 procedure Set_State3 (N : Node_Type; V : Bit2_Type); 241 pragma Inline (Set_State3); 242 243 type Node_Record is record 244 -- First byte: 245 Format : Format_Type; 246 Flag1 : Boolean; 247 Flag2 : Boolean; 248 Flag3 : Boolean; 249 Flag4 : Boolean; 250 Flag5 : Boolean; 251 Flag6 : Boolean; 252 Flag7 : Boolean; 253 254 -- Second byte: 255 Flag8 : Boolean; 256 Flag9 : Boolean; 257 Flag10 : Boolean; 258 Flag11 : Boolean; 259 Flag12 : Boolean; 260 Flag13 : Boolean; 261 Flag14 : Boolean; 262 Flag15 : Boolean; 263 264 -- Third byte: 265 Flag16 : Boolean; 266 Flag17 : Boolean; 267 Flag18 : Boolean; 268 269 -- 2*2 = 4 bits 270 State1 : Bit2_Type; 271 State2 : Bit2_Type; 272 273 -- 9 bits 274 Kind : Kind_Type; 275 276 -- Location. 277 Location: Location_Type; 278 279 Field0 : Node_Type; 280 Field1 : Node_Type; 281 Field2 : Node_Type; 282 Field3 : Node_Type; 283 Field4 : Node_Type; 284 Field5 : Node_Type; 285 end record; 286 pragma Pack (Node_Record); 287 for Node_Record'Size use 8*32; 288 for Node_Record'Alignment use 4; 289 pragma Suppress_Initialization (Node_Record); 290 291 Init_Node : constant Node_Record := Node_Record' 292 (Format => Format_Short, 293 Kind => 0, 294 State1 | State2 => 0, 295 Location => Location_Nil, 296 Field0 | Field1 | Field2 | Field3 | Field4 | Field5 => Null_Node, 297 others => False); 298 299 -- Suppress the access check of the table base. This is really safe to 300 -- suppress this check because the table base cannot be null. 301 pragma Suppress (Access_Check); 302 303 -- Suppress the index check on the table. 304 -- Could be done during non-debug, since this may catch errors (reading 305 -- Null_Node or Error_Node). 306 --pragma Suppress (Index_Check); 307 308 package Nodet is new Tables 309 (Table_Component_Type => Node_Record, 310 Table_Index_Type => Node_Type, 311 Table_Low_Bound => 2, 312 Table_Initial => 1024); 313 314 function Get_Last_Node return Iir is 315 begin 316 return Nodet.Last; 317 end Get_Last_Node; 318 319 Free_Chain : Node_Type := Null_Node; 320 321 function Create_Node (Format : Format_Type) return Node_Type 322 is 323 Res : Node_Type; 324 begin 325 case Format is 326 when Format_Medium => 327 -- Allocate a first node. 328 Nodet.Increment_Last; 329 Res := Nodet.Last; 330 -- Check alignment. 331 if Res mod 2 = 1 then 332 Set_Field1 (Res, Free_Chain); 333 Free_Chain := Res; 334 Nodet.Increment_Last; 335 Res := Nodet.Last; 336 end if; 337 -- Allocate the second node. 338 Nodet.Increment_Last; 339 Nodet.Table (Res) := Init_Node; 340 Nodet.Table (Res).Format := Format_Medium; 341 Nodet.Table (Res + 1) := Init_Node; 342 when Format_Short => 343 -- Check from free pool 344 if Free_Chain = Null_Node then 345 Nodet.Increment_Last; 346 Res := Nodet.Last; 347 else 348 Res := Free_Chain; 349 Free_Chain := Get_Field1 (Res); 350 end if; 351 Nodet.Table (Res) := Init_Node; 352 end case; 353 return Res; 354 end Create_Node; 355 356 type Free_Node_Hook_Array is 357 array (Natural range 1 .. 8) of Free_Iir_Hook; 358 Nbr_Free_Hooks : Natural := 0; 359 360 Free_Hooks : Free_Node_Hook_Array; 361 362 procedure Register_Free_Hook (Hook : Free_Iir_Hook) is 363 begin 364 if Nbr_Free_Hooks >= Free_Hooks'Last then 365 -- Not enough room in Free_Hooks. 366 raise Internal_Error; 367 end if; 368 Nbr_Free_Hooks := Nbr_Free_Hooks + 1; 369 Free_Hooks (Nbr_Free_Hooks) := Hook; 370 end Register_Free_Hook; 371 372 procedure Free_Node (N : Node_Type) is 373 begin 374 if N = Null_Node then 375 return; 376 end if; 377 378 -- Call hooks. 379 for I in Free_Hooks'First .. Nbr_Free_Hooks loop 380 Free_Hooks (I).all (N); 381 end loop; 382 383 -- Really free the node. 384 Set_Nkind (N, 0); 385 Set_Field1 (N, Free_Chain); 386 Free_Chain := N; 387 if Nodet.Table (N).Format = Format_Medium then 388 Set_Field1 (N + 1, Free_Chain); 389 Free_Chain := N + 1; 390 end if; 391 end Free_Node; 392 393 procedure Free_Iir (Target : Iir) renames Free_Node; 394 395 function Next_Node (N : Node_Type) return Node_Type is 396 begin 397 case Nodet.Table (N).Format is 398 when Format_Medium => 399 return N + 2; 400 when Format_Short => 401 return N + 1; 402 end case; 403 end Next_Node; 404 405 function Get_Nkind (N : Node_Type) return Kind_Type is 406 begin 407 return Nodet.Table (N).Kind; 408 end Get_Nkind; 409 410 procedure Set_Nkind (N : Node_Type; Kind : Kind_Type) is 411 begin 412 Nodet.Table (N).Kind := Kind; 413 end Set_Nkind; 414 415 416 procedure Set_Location (N : Iir; Location: Location_Type) is 417 begin 418 Nodet.Table (N).Location := Location; 419 end Set_Location; 420 421 function Get_Location (N: Iir) return Location_Type is 422 begin 423 return Nodet.Table (N).Location; 424 end Get_Location; 425 426 427 procedure Set_Field0 (N : Node_Type; V : Node_Type) is 428 begin 429 Nodet.Table (N).Field0 := V; 430 end Set_Field0; 431 432 function Get_Field0 (N : Node_Type) return Node_Type is 433 begin 434 return Nodet.Table (N).Field0; 435 end Get_Field0; 436 437 438 function Get_Field1 (N : Node_Type) return Node_Type is 439 begin 440 return Nodet.Table (N).Field1; 441 end Get_Field1; 442 443 procedure Set_Field1 (N : Node_Type; V : Node_Type) is 444 begin 445 Nodet.Table (N).Field1 := V; 446 end Set_Field1; 447 448 function Get_Field2 (N : Node_Type) return Node_Type is 449 begin 450 return Nodet.Table (N).Field2; 451 end Get_Field2; 452 453 procedure Set_Field2 (N : Node_Type; V : Node_Type) is 454 begin 455 Nodet.Table (N).Field2 := V; 456 end Set_Field2; 457 458 function Get_Field3 (N : Node_Type) return Node_Type is 459 begin 460 return Nodet.Table (N).Field3; 461 end Get_Field3; 462 463 procedure Set_Field3 (N : Node_Type; V : Node_Type) is 464 begin 465 Nodet.Table (N).Field3 := V; 466 end Set_Field3; 467 468 function Get_Field4 (N : Node_Type) return Node_Type is 469 begin 470 return Nodet.Table (N).Field4; 471 end Get_Field4; 472 473 procedure Set_Field4 (N : Node_Type; V : Node_Type) is 474 begin 475 Nodet.Table (N).Field4 := V; 476 end Set_Field4; 477 478 function Get_Field5 (N : Node_Type) return Node_Type is 479 begin 480 return Nodet.Table (N).Field5; 481 end Get_Field5; 482 483 procedure Set_Field5 (N : Node_Type; V : Node_Type) is 484 begin 485 Nodet.Table (N).Field5 := V; 486 end Set_Field5; 487 488 function Get_Field6 (N: Node_Type) return Node_Type is 489 begin 490 return Node_Type (Nodet.Table (N + 1).Location); 491 end Get_Field6; 492 493 procedure Set_Field6 (N: Node_Type; Val: Node_Type) is 494 begin 495 Nodet.Table (N + 1).Location := Location_Type (Val); 496 end Set_Field6; 497 498 function Get_Field7 (N: Node_Type) return Node_Type is 499 begin 500 return Nodet.Table (N + 1).Field0; 501 end Get_Field7; 502 503 procedure Set_Field7 (N: Node_Type; Val: Node_Type) is 504 begin 505 Nodet.Table (N + 1).Field0 := Val; 506 end Set_Field7; 507 508 function Get_Field8 (N: Node_Type) return Node_Type is 509 begin 510 return Nodet.Table (N + 1).Field1; 511 end Get_Field8; 512 513 procedure Set_Field8 (N: Node_Type; Val: Node_Type) is 514 begin 515 Nodet.Table (N + 1).Field1 := Val; 516 end Set_Field8; 517 518 function Get_Field9 (N: Node_Type) return Node_Type is 519 begin 520 return Nodet.Table (N + 1).Field2; 521 end Get_Field9; 522 523 procedure Set_Field9 (N: Node_Type; Val: Node_Type) is 524 begin 525 Nodet.Table (N + 1).Field2 := Val; 526 end Set_Field9; 527 528 function Get_Field10 (N: Node_Type) return Node_Type is 529 begin 530 return Nodet.Table (N + 1).Field3; 531 end Get_Field10; 532 533 procedure Set_Field10 (N: Node_Type; Val: Node_Type) is 534 begin 535 Nodet.Table (N + 1).Field3 := Val; 536 end Set_Field10; 537 538 function Get_Field11 (N: Node_Type) return Node_Type is 539 begin 540 return Nodet.Table (N + 1).Field4; 541 end Get_Field11; 542 543 procedure Set_Field11 (N: Node_Type; Val: Node_Type) is 544 begin 545 Nodet.Table (N + 1).Field4 := Val; 546 end Set_Field11; 547 548 function Get_Field12 (N: Node_Type) return Node_Type is 549 begin 550 return Nodet.Table (N + 1).Field5; 551 end Get_Field12; 552 553 procedure Set_Field12 (N: Node_Type; Val: Node_Type) is 554 begin 555 Nodet.Table (N + 1).Field5 := Val; 556 end Set_Field12; 557 558 559 function Get_Flag1 (N : Node_Type) return Boolean is 560 begin 561 return Nodet.Table (N).Flag1; 562 end Get_Flag1; 563 564 procedure Set_Flag1 (N : Node_Type; V : Boolean) is 565 begin 566 Nodet.Table (N).Flag1 := V; 567 end Set_Flag1; 568 569 function Get_Flag2 (N : Node_Type) return Boolean is 570 begin 571 return Nodet.Table (N).Flag2; 572 end Get_Flag2; 573 574 procedure Set_Flag2 (N : Node_Type; V : Boolean) is 575 begin 576 Nodet.Table (N).Flag2 := V; 577 end Set_Flag2; 578 579 function Get_Flag3 (N : Node_Type) return Boolean is 580 begin 581 return Nodet.Table (N).Flag3; 582 end Get_Flag3; 583 584 procedure Set_Flag3 (N : Node_Type; V : Boolean) is 585 begin 586 Nodet.Table (N).Flag3 := V; 587 end Set_Flag3; 588 589 function Get_Flag4 (N : Node_Type) return Boolean is 590 begin 591 return Nodet.Table (N).Flag4; 592 end Get_Flag4; 593 594 procedure Set_Flag4 (N : Node_Type; V : Boolean) is 595 begin 596 Nodet.Table (N).Flag4 := V; 597 end Set_Flag4; 598 599 function Get_Flag5 (N : Node_Type) return Boolean is 600 begin 601 return Nodet.Table (N).Flag5; 602 end Get_Flag5; 603 604 procedure Set_Flag5 (N : Node_Type; V : Boolean) is 605 begin 606 Nodet.Table (N).Flag5 := V; 607 end Set_Flag5; 608 609 function Get_Flag6 (N : Node_Type) return Boolean is 610 begin 611 return Nodet.Table (N).Flag6; 612 end Get_Flag6; 613 614 procedure Set_Flag6 (N : Node_Type; V : Boolean) is 615 begin 616 Nodet.Table (N).Flag6 := V; 617 end Set_Flag6; 618 619 function Get_Flag7 (N : Node_Type) return Boolean is 620 begin 621 return Nodet.Table (N).Flag7; 622 end Get_Flag7; 623 624 procedure Set_Flag7 (N : Node_Type; V : Boolean) is 625 begin 626 Nodet.Table (N).Flag7 := V; 627 end Set_Flag7; 628 629 function Get_Flag8 (N : Node_Type) return Boolean is 630 begin 631 return Nodet.Table (N).Flag8; 632 end Get_Flag8; 633 634 procedure Set_Flag8 (N : Node_Type; V : Boolean) is 635 begin 636 Nodet.Table (N).Flag8 := V; 637 end Set_Flag8; 638 639 function Get_Flag9 (N : Node_Type) return Boolean is 640 begin 641 return Nodet.Table (N).Flag9; 642 end Get_Flag9; 643 644 procedure Set_Flag9 (N : Node_Type; V : Boolean) is 645 begin 646 Nodet.Table (N).Flag9 := V; 647 end Set_Flag9; 648 649 function Get_Flag10 (N : Node_Type) return Boolean is 650 begin 651 return Nodet.Table (N).Flag10; 652 end Get_Flag10; 653 654 procedure Set_Flag10 (N : Node_Type; V : Boolean) is 655 begin 656 Nodet.Table (N).Flag10 := V; 657 end Set_Flag10; 658 659 function Get_Flag11 (N : Node_Type) return Boolean is 660 begin 661 return Nodet.Table (N).Flag11; 662 end Get_Flag11; 663 664 procedure Set_Flag11 (N : Node_Type; V : Boolean) is 665 begin 666 Nodet.Table (N).Flag11 := V; 667 end Set_Flag11; 668 669 function Get_Flag12 (N : Node_Type) return Boolean is 670 begin 671 return Nodet.Table (N).Flag12; 672 end Get_Flag12; 673 674 procedure Set_Flag12 (N : Node_Type; V : Boolean) is 675 begin 676 Nodet.Table (N).Flag12 := V; 677 end Set_Flag12; 678 679 function Get_Flag13 (N : Node_Type) return Boolean is 680 begin 681 return Nodet.Table (N).Flag13; 682 end Get_Flag13; 683 684 procedure Set_Flag13 (N : Node_Type; V : Boolean) is 685 begin 686 Nodet.Table (N).Flag13 := V; 687 end Set_Flag13; 688 689 function Get_Flag14 (N : Node_Type) return Boolean is 690 begin 691 return Nodet.Table (N).Flag14; 692 end Get_Flag14; 693 694 procedure Set_Flag14 (N : Node_Type; V : Boolean) is 695 begin 696 Nodet.Table (N).Flag14 := V; 697 end Set_Flag14; 698 699 function Get_Flag15 (N : Node_Type) return Boolean is 700 begin 701 return Nodet.Table (N).Flag15; 702 end Get_Flag15; 703 704 procedure Set_Flag15 (N : Node_Type; V : Boolean) is 705 begin 706 Nodet.Table (N).Flag15 := V; 707 end Set_Flag15; 708 709 710 function Get_State1 (N : Node_Type) return Bit2_Type is 711 begin 712 return Nodet.Table (N).State1; 713 end Get_State1; 714 715 procedure Set_State1 (N : Node_Type; V : Bit2_Type) is 716 begin 717 Nodet.Table (N).State1 := V; 718 end Set_State1; 719 720 function Get_State2 (N : Node_Type) return Bit2_Type is 721 begin 722 return Nodet.Table (N).State2; 723 end Get_State2; 724 725 procedure Set_State2 (N : Node_Type; V : Bit2_Type) is 726 begin 727 Nodet.Table (N).State2 := V; 728 end Set_State2; 729 730 function Get_State3 (N : Node_Type) return Bit2_Type is 731 begin 732 return Nodet.Table (N + 1).State1; 733 end Get_State3; 734 735 procedure Set_State3 (N : Node_Type; V : Bit2_Type) is 736 begin 737 Nodet.Table (N + 1).State1 := V; 738 end Set_State3; 739 740 procedure Initialize is 741 begin 742 Nodet.Init; 743 end Initialize; 744 745 procedure Finalize is 746 begin 747 Nodet.Free; 748 end Finalize; 749 750 function Is_Null (Node : Iir) return Boolean is 751 begin 752 return Node = Null_Iir; 753 end Is_Null; 754 755 function Is_Null_List (Node : Iir_List) return Boolean is 756 begin 757 return Node = Null_Iir_List; 758 end Is_Null_List; 759 760 function Is_Valid (Node : Iir) return Boolean is 761 begin 762 return Node /= Null_Iir; 763 end Is_Valid; 764 765 --------------------------------------------------- 766 -- General subprograms that operate on every iir -- 767 --------------------------------------------------- 768 769 function Get_Format (Kind : Iir_Kind) return Format_Type; 770 771 function Create_Iir (Kind : Iir_Kind) return Iir 772 is 773 Res : Iir; 774 Format : Format_Type; 775 begin 776 Format := Get_Format (Kind); 777 Res := Create_Node (Format); 778 Set_Nkind (Res, Iir_Kind'Pos (Kind)); 779 return Res; 780 end Create_Iir; 781 782 -- Statistics. 783 procedure Disp_Stats 784 is 785 type Num_Array is array (Iir_Kind) of Natural; 786 Num : Num_Array := (others => 0); 787 type Format_Array is array (Format_Type) of Natural; 788 Formats : Format_Array := (others => 0); 789 Kind : Iir_Kind; 790 I : Iir; 791 Last_I : Iir; 792 Format : Format_Type; 793 begin 794 I := Error_Node + 1; 795 Last_I := Get_Last_Node; 796 while I < Last_I loop 797 Kind := Get_Kind (I); 798 Num (Kind) := Num (Kind) + 1; 799 Format := Get_Format (Kind); 800 Formats (Format) := Formats (Format) + 1; 801 I := Next_Node (I); 802 end loop; 803 804 Log_Line ("Stats per iir_kind:"); 805 for J in Iir_Kind loop 806 if Num (J) /= 0 then 807 Log_Line (' ' & Iir_Kind'Image (J) & ':' 808 & Natural'Image (Num (J))); 809 end if; 810 end loop; 811 Log_Line ("Stats per formats:"); 812 for J in Format_Type loop 813 Log_Line (' ' & Format_Type'Image (J) & ':' 814 & Natural'Image (Formats (J))); 815 end loop; 816 end Disp_Stats; 817 818 function Kind_In (K : Iir_Kind; K1, K2 : Iir_Kind) return Boolean is 819 begin 820 return K = K1 or K = K2; 821 end Kind_In; 822 823 function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions) 824 return Boolean is 825 begin 826 case Func is 827 when Iir_Predefined_Bit_And 828 | Iir_Predefined_Bit_Or 829 | Iir_Predefined_Bit_Nand 830 | Iir_Predefined_Bit_Nor 831 | Iir_Predefined_Boolean_And 832 | Iir_Predefined_Boolean_Or 833 | Iir_Predefined_Boolean_Nand 834 | Iir_Predefined_Boolean_Nor => 835 return True; 836 when others => 837 return False; 838 end case; 839 end Iir_Predefined_Shortcut_P; 840 841 function Create_Iir_Error return Iir 842 is 843 Res : Iir; 844 begin 845 Res := Create_Node (Format_Short); 846 Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error)); 847 return Res; 848 end Create_Iir_Error; 849 850 procedure Location_Copy (Target : Iir; Src : Iir) is 851 begin 852 Set_Location (Target, Get_Location (Src)); 853 end Location_Copy; 854 855 -- Get kind 856 function Get_Kind (N : Iir) return Iir_Kind 857 is 858 -- Speed up: avoid to check that nkind is in the bounds of Iir_Kind. 859 pragma Suppress (Range_Check); 860 begin 861 pragma Assert (N /= Null_Iir); 862 return Iir_Kind'Val (Get_Nkind (N)); 863 end Get_Kind; 864 865 function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion 866 (Source => Time_Stamp_Id, Target => Iir); 867 868 function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion 869 (Source => Iir, Target => Time_Stamp_Id); 870 871 function File_Checksum_Id_To_Iir is new Ada.Unchecked_Conversion 872 (Source => File_Checksum_Id, Target => Iir); 873 874 function Iir_To_File_Checksum_Id is new Ada.Unchecked_Conversion 875 (Source => Iir, Target => File_Checksum_Id); 876 877 function Iir_To_Iir_List is new Ada.Unchecked_Conversion 878 (Source => Iir, Target => Iir_List); 879 function Iir_List_To_Iir is new Ada.Unchecked_Conversion 880 (Source => Iir_List, Target => Iir); 881 882 function Iir_To_Iir_Flist is new Ada.Unchecked_Conversion 883 (Source => Iir, Target => Iir_Flist); 884 function Iir_Flist_To_Iir is new Ada.Unchecked_Conversion 885 (Source => Iir_Flist, Target => Iir); 886 887 function Iir_To_Token_Type (N : Iir) return Token_Type is 888 begin 889 return Token_Type'Val (N); 890 end Iir_To_Token_Type; 891 892 function Token_Type_To_Iir (T : Token_Type) return Iir is 893 begin 894 return Token_Type'Pos (T); 895 end Token_Type_To_Iir; 896 897-- function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is 898-- begin 899-- return Iir_Index32 (N); 900-- end Iir_To_Iir_Index32; 901 902-- function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is 903-- begin 904-- return Iir_Index32'Pos (V); 905-- end Iir_Index32_To_Iir; 906 907 function Iir_To_Name_Id (N : Iir) return Name_Id is 908 begin 909 return Iir'Pos (N); 910 end Iir_To_Name_Id; 911 pragma Inline (Iir_To_Name_Id); 912 913 function Name_Id_To_Iir (V : Name_Id) return Iir is 914 begin 915 return Name_Id'Pos (V); 916 end Name_Id_To_Iir; 917 918 function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion 919 (Source => Iir, Target => Iir_Int32); 920 921 function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion 922 (Source => Iir_Int32, Target => Iir); 923 924 function Iir_To_Source_Ptr (N : Iir) return Source_Ptr is 925 begin 926 return Source_Ptr (N); 927 end Iir_To_Source_Ptr; 928 929 function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is 930 begin 931 return Iir (P); 932 end Source_Ptr_To_Iir; 933 934 function Iir_To_Source_File_Entry is new Ada.Unchecked_Conversion 935 (Source => Iir, Target => Source_File_Entry); 936 function Source_File_Entry_To_Iir is new Ada.Unchecked_Conversion 937 (Source => Source_File_Entry, Target => Iir); 938 939 function Boolean_To_Iir_Delay_Mechanism is new Ada.Unchecked_Conversion 940 (Source => Boolean, Target => Iir_Delay_Mechanism); 941 function Iir_Delay_Mechanism_To_Boolean is new Ada.Unchecked_Conversion 942 (Source => Iir_Delay_Mechanism, Target => Boolean); 943 944 function Boolean_To_Iir_Force_Mode is new Ada.Unchecked_Conversion 945 (Source => Boolean, Target => Iir_Force_Mode); 946 function Iir_Force_Mode_To_Boolean is new Ada.Unchecked_Conversion 947 (Source => Iir_Force_Mode, Target => Boolean); 948 949 function Boolean_To_Iir_Signal_Kind is new Ada.Unchecked_Conversion 950 (Source => Boolean, Target => Iir_Signal_Kind); 951 function Iir_Signal_Kind_To_Boolean is new Ada.Unchecked_Conversion 952 (Source => Iir_Signal_Kind, Target => Boolean); 953 954 function Boolean_To_Direction_Type is new Ada.Unchecked_Conversion 955 (Source => Boolean, Target => Direction_Type); 956 function Direction_Type_To_Boolean is new Ada.Unchecked_Conversion 957 (Source => Direction_Type, Target => Boolean); 958 959 function Iir_To_String8_Id is new Ada.Unchecked_Conversion 960 (Source => Iir, Target => String8_Id); 961 function String8_Id_To_Iir is new Ada.Unchecked_Conversion 962 (Source => String8_Id, Target => Iir); 963 964 function Iir_To_Int32 is new Ada.Unchecked_Conversion 965 (Source => Iir, Target => Int32); 966 function Int32_To_Iir is new Ada.Unchecked_Conversion 967 (Source => Int32, Target => Iir); 968 969 function Iir_To_PSL_Node is new Ada.Unchecked_Conversion 970 (Source => Iir, Target => PSL_Node); 971 972 function PSL_Node_To_Iir is new Ada.Unchecked_Conversion 973 (Source => PSL_Node, Target => Iir); 974 975 function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion 976 (Source => Iir, Target => PSL_NFA); 977 978 function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion 979 (Source => PSL_NFA, Target => Iir); 980 981 -- Subprograms 982end Vhdl.Nodes; 983