gcc/ada/namet.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                N A M E T                                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 --  WARNING: There is a C version of this package. Any changes to this
  33 --  source file must be properly reflected in the C header file namet.h
  34 --  which is created manually from namet.ads and namet.adb.
  35
  36 with Debug;    use Debug;
  37 with Opt;      use Opt;
  38 with Output;   use Output;
  39 with Tree_IO;  use Tree_IO;
  40 with Widechar; use Widechar;
  41
  42 package body Namet is
  43
  44    Name_Chars_Reserve   : constant := 5000;
  45    Name_Entries_Reserve : constant := 100;
  46    --  The names table is locked during gigi processing, since gigi assumes
  47    --  that the table does not move. After returning from gigi, the names
  48    --  table is unlocked again, since writing library file information needs
  49    --  to generate some extra names. To avoid the inefficiency of always
  50    --  reallocating during this second unlocked phase, we reserve a bit of
  51    --  extra space before doing the release call.
  52
  53    Hash_Num : constant Int := 2**12;
  54    --  Number of headers in the hash table. Current hash algorithm is closely
  55    --  tailored to this choice, so it can only be changed if a corresponding
  56    --  change is made to the hash algorithm.
  57
  58    Hash_Max : constant Int := Hash_Num - 1;
  59    --  Indexes in the hash header table run from 0 to Hash_Num - 1
  60
  61    subtype Hash_Index_Type is Int range 0 .. Hash_Max;
  62    --  Range of hash index values
  63
  64    Hash_Table : array (Hash_Index_Type) of Name_Id;
  65    --  The hash table is used to locate existing entries in the names table.
  66    --  The entries point to the first names table entry whose hash value
  67    --  matches the hash code. Then subsequent names table entries with the
  68    --  same hash code value are linked through the Hash_Link fields.
  69
  70    -----------------------
  71    -- Local Subprograms --
  72    -----------------------
  73
  74    function Hash return Hash_Index_Type;
  75    pragma Inline (Hash);
  76    --  Compute hash code for name stored in Name_Buffer (length in Name_Len)
  77
  78    procedure Strip_Qualification_And_Suffixes;
  79    --  Given an encoded entity name in Name_Buffer, remove package body
  80    --  suffix as described for Strip_Package_Body_Suffix, and also remove
  81    --  all qualification, i.e. names followed by two underscores. The
  82    --  contents of Name_Buffer is modified by this call, and on return
  83    --  Name_Buffer and Name_Len reflect the stripped name.
  84
  85    -----------------------------
  86    -- Add_Char_To_Name_Buffer --
  87    -----------------------------
  88
  89    procedure Add_Char_To_Name_Buffer (C : Character) is
  90    begin
  91       if Name_Len < Name_Buffer'Last then
  92          Name_Len := Name_Len + 1;
  93          Name_Buffer (Name_Len) := C;
  94       end if;
  95    end Add_Char_To_Name_Buffer;
  96
  97    ----------------------------
  98    -- Add_Nat_To_Name_Buffer --
  99    ----------------------------
 100
 101    procedure Add_Nat_To_Name_Buffer (V : Nat) is
 102    begin
 103       if V >= 10 then
 104          Add_Nat_To_Name_Buffer (V / 10);
 105       end if;
 106
 107       Add_Char_To_Name_Buffer (Character'Val (Character'Pos ('0') + V rem 10));
 108    end Add_Nat_To_Name_Buffer;
 109
 110    ----------------------------
 111    -- Add_Str_To_Name_Buffer --
 112    ----------------------------
 113
 114    procedure Add_Str_To_Name_Buffer (S : String) is
 115    begin
 116       for J in S'Range loop
 117          Add_Char_To_Name_Buffer (S (J));
 118       end loop;
 119    end Add_Str_To_Name_Buffer;
 120
 121    --------------
 122    -- Finalize --
 123    --------------
 124
 125    procedure Finalize is
 126       Max_Chain_Length : constant := 50;
 127       --  Max length of chains for which specific information is output
 128
 129       F : array (Int range 0 .. Max_Chain_Length) of Int;
 130       --  N'th entry is number of chains of length N
 131
 132       Probes : Int := 0;
 133       --  Used to compute average number of probes
 134
 135       Nsyms : Int := 0;
 136       --  Number of symbols in table
 137
 138    begin
 139       if Debug_Flag_H then
 140          for J in F'Range loop
 141             F (J) := 0;
 142          end loop;
 143
 144          for J in Hash_Index_Type loop
 145             if Hash_Table (J) = No_Name then
 146                F (0) := F (0) + 1;
 147
 148             else
 149                Write_Str ("Hash_Table (");
 150                Write_Int (J);
 151                Write_Str (") has ");
 152
 153                declare
 154                   C : Int := 1;
 155                   N : Name_Id;
 156                   S : Int;
 157
 158                begin
 159                   C := 0;
 160                   N := Hash_Table (J);
 161
 162                   while N /= No_Name loop
 163                      N := Name_Entries.Table (N).Hash_Link;
 164                      C := C + 1;
 165                   end loop;
 166
 167                   Write_Int (C);
 168                   Write_Str (" entries");
 169                   Write_Eol;
 170
 171                   if C < Max_Chain_Length then
 172                      F (C) := F (C) + 1;
 173                   else
 174                      F (Max_Chain_Length) := F (Max_Chain_Length) + 1;
 175                   end if;
 176
 177                   N := Hash_Table (J);
 178
 179                   while N /= No_Name loop
 180                      S := Name_Entries.Table (N).Name_Chars_Index;
 181                      Write_Str ("      ");
 182
 183                      for J in 1 .. Name_Entries.Table (N).Name_Len loop
 184                         Write_Char (Name_Chars.Table (S + Int (J)));
 185                      end loop;
 186
 187                      Write_Eol;
 188                      N := Name_Entries.Table (N).Hash_Link;
 189                   end loop;
 190                end;
 191             end if;
 192          end loop;
 193
 194          Write_Eol;
 195
 196          for J in Int range 0 .. Max_Chain_Length loop
 197             if F (J) /= 0 then
 198                Write_Str ("Number of hash chains of length ");
 199
 200                if J < 10 then
 201                   Write_Char (' ');
 202                end if;
 203
 204                Write_Int (J);
 205
 206                if J = Max_Chain_Length then
 207                   Write_Str (" or greater");
 208                end if;
 209
 210                Write_Str (" = ");
 211                Write_Int (F (J));
 212                Write_Eol;
 213
 214                if J /= 0 then
 215                   Nsyms := Nsyms + F (J);
 216                   Probes := Probes + F (J) * (1 + J) * 100;
 217                end if;
 218             end if;
 219          end loop;
 220
 221          Write_Eol;
 222          Write_Str ("Average number of probes for lookup = ");
 223          Probes := Probes / Nsyms;
 224          Write_Int (Probes / 200);
 225          Write_Char ('.');
 226          Probes := (Probes mod 200) / 2;
 227          Write_Char (Character'Val (48 + Probes / 10));
 228          Write_Char (Character'Val (48 + Probes mod 10));
 229          Write_Eol;
 230          Write_Eol;
 231       end if;
 232    end Finalize;
 233
 234    -----------------------------
 235    -- Get_Decoded_Name_String --
 236    -----------------------------
 237
 238    procedure Get_Decoded_Name_String (Id : Name_Id) is
 239       C : Character;
 240       P : Natural;
 241
 242    begin
 243       Get_Name_String (Id);
 244
 245       --  Skip scan if we already know there are no encodings
 246
 247       if Name_Entries.Table (Id).Name_Has_No_Encodings then
 248          return;
 249       end if;
 250
 251       --  Quick loop to see if there is anything special to do
 252
 253       P := 1;
 254       loop
 255          if P = Name_Len then
 256             Name_Entries.Table (Id).Name_Has_No_Encodings := True;
 257             return;
 258
 259          else
 260             C := Name_Buffer (P);
 261
 262             exit when
 263               C = 'U' or else
 264               C = 'W' or else
 265               C = 'Q' or else
 266               C = 'O';
 267
 268             P := P + 1;
 269          end if;
 270       end loop;
 271
 272       --  Here we have at least some encoding that we must decode
 273
 274       Decode : declare
 275          New_Len : Natural;
 276          Old     : Positive;
 277          New_Buf : String (1 .. Name_Buffer'Last);
 278
 279          procedure Copy_One_Character;
 280          --  Copy a character from Name_Buffer to New_Buf. Includes case
 281          --  of copying a Uhh,Whhhh,WWhhhhhhhh sequence and decoding it.
 282
 283          function Hex (N : Natural) return Word;
 284          --  Scans past N digits using Old pointer and returns hex value
 285
 286          procedure Insert_Character (C : Character);
 287          --  Insert a new character into output decoded name
 288
 289          ------------------------
 290          -- Copy_One_Character --
 291          ------------------------
 292
 293          procedure Copy_One_Character is
 294             C : Character;
 295
 296          begin
 297             C := Name_Buffer (Old);
 298
 299             --  U (upper half insertion case)
 300
 301             if C = 'U'
 302               and then Old < Name_Len
 303               and then Name_Buffer (Old + 1) not in 'A' .. 'Z'
 304               and then Name_Buffer (Old + 1) /= '_'
 305             then
 306                Old := Old + 1;
 307
 308                --  If we have upper half encoding, then we have to set an
 309                --  appropriate wide character sequence for this character.
 310
 311                if Upper_Half_Encoding then
 312                   Widechar.Set_Wide (Char_Code (Hex (2)), New_Buf, New_Len);
 313
 314                   --  For other encoding methods, upper half characters can
 315                   --  simply use their normal representation.
 316
 317                else
 318                   Insert_Character (Character'Val (Hex (2)));
 319                end if;
 320
 321             --  WW (wide wide character insertion)
 322
 323             elsif C = 'W'
 324               and then Old < Name_Len
 325               and then Name_Buffer (Old + 1) = 'W'
 326             then
 327                Old := Old + 2;
 328                Widechar.Set_Wide (Char_Code (Hex (8)), New_Buf, New_Len);
 329
 330             --  W (wide character insertion)
 331
 332             elsif C = 'W'
 333               and then Old < Name_Len
 334               and then Name_Buffer (Old + 1) not in 'A' .. 'Z'
 335               and then Name_Buffer (Old + 1) /= '_'
 336             then
 337                Old := Old + 1;
 338                Widechar.Set_Wide (Char_Code (Hex (4)), New_Buf, New_Len);
 339
 340             --  Any other character is copied unchanged
 341
 342             else
 343                Insert_Character (C);
 344                Old := Old + 1;
 345             end if;
 346          end Copy_One_Character;
 347
 348          ---------
 349          -- Hex --
 350          ---------
 351
 352          function Hex (N : Natural) return Word is
 353             T : Word := 0;
 354             C : Character;
 355
 356          begin
 357             for J in 1 .. N loop
 358                C := Name_Buffer (Old);
 359                Old := Old + 1;
 360
 361                pragma Assert (C in '0' .. '9' or else C in 'a' .. 'f');
 362
 363                if C <= '9' then
 364                   T := 16 * T + Character'Pos (C) - Character'Pos ('0');
 365                else -- C in 'a' .. 'f'
 366                   T := 16 * T + Character'Pos (C) - (Character'Pos ('a') - 10);
 367                end if;
 368             end loop;
 369
 370             return T;
 371          end Hex;
 372
 373          ----------------------
 374          -- Insert_Character --
 375          ----------------------
 376
 377          procedure Insert_Character (C : Character) is
 378          begin
 379             New_Len := New_Len + 1;
 380             New_Buf (New_Len) := C;
 381          end Insert_Character;
 382
 383       --  Start of processing for Decode
 384
 385       begin
 386          New_Len := 0;
 387          Old := 1;
 388
 389          --  Loop through characters of name
 390
 391          while Old <= Name_Len loop
 392
 393             --  Case of character literal, put apostrophes around character
 394
 395             if Name_Buffer (Old) = 'Q'
 396               and then Old < Name_Len
 397             then
 398                Old := Old + 1;
 399                Insert_Character (''');
 400                Copy_One_Character;
 401                Insert_Character (''');
 402
 403             --  Case of operator name
 404
 405             elsif Name_Buffer (Old) = 'O'
 406               and then Old < Name_Len
 407               and then Name_Buffer (Old + 1) not in 'A' .. 'Z'
 408               and then Name_Buffer (Old + 1) /= '_'
 409             then
 410                Old := Old + 1;
 411
 412                declare
 413                   --  This table maps the 2nd and 3rd characters of the name
 414                   --  into the required output. Two blanks means leave the
 415                   --  name alone
 416
 417                   Map : constant String :=
 418                      "ab  " &               --  Oabs         => "abs"
 419                      "ad+ " &               --  Oadd         => "+"
 420                      "an  " &               --  Oand         => "and"
 421                      "co& " &               --  Oconcat      => "&"
 422                      "di/ " &               --  Odivide      => "/"
 423                      "eq= " &               --  Oeq          => "="
 424                      "ex**" &               --  Oexpon       => "**"
 425                      "gt> " &               --  Ogt          => ">"
 426                      "ge>=" &               --  Oge          => ">="
 427                      "le<=" &               --  Ole          => "<="
 428                      "lt< " &               --  Olt          => "<"
 429                      "mo  " &               --  Omod         => "mod"
 430                      "mu* " &               --  Omutliply    => "*"
 431                      "ne/=" &               --  One          => "/="
 432                      "no  " &               --  Onot         => "not"
 433                      "or  " &               --  Oor          => "or"
 434                      "re  " &               --  Orem         => "rem"
 435                      "su- " &               --  Osubtract    => "-"
 436                      "xo  ";                --  Oxor         => "xor"
 437
 438                   J : Integer;
 439
 440                begin
 441                   Insert_Character ('"');
 442
 443                   --  Search the map. Note that this loop must terminate, if
 444                   --  not we have some kind of internal error, and a constraint
 445                   --  error may be raised.
 446
 447                   J := Map'First;
 448                   loop
 449                      exit when Name_Buffer (Old) = Map (J)
 450                        and then Name_Buffer (Old + 1) = Map (J + 1);
 451                      J := J + 4;
 452                   end loop;
 453
 454                   --  Special operator name
 455
 456                   if Map (J + 2) /= ' ' then
 457                      Insert_Character (Map (J + 2));
 458
 459                      if Map (J + 3) /= ' ' then
 460                         Insert_Character (Map (J + 3));
 461                      end if;
 462
 463                      Insert_Character ('"');
 464
 465                      --  Skip past original operator name in input
 466
 467                      while Old <= Name_Len
 468                        and then Name_Buffer (Old) in 'a' .. 'z'
 469                      loop
 470                         Old := Old + 1;
 471                      end loop;
 472
 473                   --  For other operator names, leave them in lower case,
 474                   --  surrounded by apostrophes
 475
 476                   else
 477                      --  Copy original operator name from input to output
 478
 479                      while Old <= Name_Len
 480                         and then Name_Buffer (Old) in 'a' .. 'z'
 481                      loop
 482                         Copy_One_Character;
 483                      end loop;
 484
 485                      Insert_Character ('"');
 486                   end if;
 487                end;
 488
 489             --  Else copy one character and keep going
 490
 491             else
 492                Copy_One_Character;
 493             end if;
 494          end loop;
 495
 496          --  Copy new buffer as result
 497
 498          Name_Len := New_Len;
 499          Name_Buffer (1 .. New_Len) := New_Buf (1 .. New_Len);
 500       end Decode;
 501    end Get_Decoded_Name_String;
 502
 503    -------------------------------------------
 504    -- Get_Decoded_Name_String_With_Brackets --
 505    -------------------------------------------
 506
 507    procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id) is
 508       P : Natural;
 509
 510    begin
 511       --  Case of operator name, normal decoding is fine
 512
 513       if Name_Buffer (1) = 'O' then
 514          Get_Decoded_Name_String (Id);
 515
 516       --  For character literals, normal decoding is fine
 517
 518       elsif Name_Buffer (1) = 'Q' then
 519          Get_Decoded_Name_String (Id);
 520
 521       --  Only remaining issue is U/W/WW sequences
 522
 523       else
 524          Get_Name_String (Id);
 525
 526          P := 1;
 527          while P < Name_Len loop
 528             if Name_Buffer (P + 1) in 'A' .. 'Z' then
 529                P := P + 1;
 530
 531             --  Uhh encoding
 532
 533             elsif Name_Buffer (P) = 'U' then
 534                for J in reverse P + 3 .. P + Name_Len loop
 535                   Name_Buffer (J + 3) := Name_Buffer (J);
 536                end loop;
 537
 538                Name_Len := Name_Len + 3;
 539                Name_Buffer (P + 3) := Name_Buffer (P + 2);
 540                Name_Buffer (P + 2) := Name_Buffer (P + 1);
 541                Name_Buffer (P)     := '[';
 542                Name_Buffer (P + 1) := '"';
 543                Name_Buffer (P + 4) := '"';
 544                Name_Buffer (P + 5) := ']';
 545                P := P + 6;
 546
 547             --  WWhhhhhhhh encoding
 548
 549             elsif Name_Buffer (P) = 'W'
 550               and then P + 9 <= Name_Len
 551               and then Name_Buffer (P + 1) = 'W'
 552               and then Name_Buffer (P + 2) not in 'A' .. 'Z'
 553               and then Name_Buffer (P + 2) /= '_'
 554             then
 555                Name_Buffer (P + 12 .. Name_Len + 2) :=
 556                  Name_Buffer (P + 10 .. Name_Len);
 557                Name_Buffer (P)     := '[';
 558                Name_Buffer (P + 1) := '"';
 559                Name_Buffer (P + 10) := '"';
 560                Name_Buffer (P + 11) := ']';
 561                Name_Len := Name_Len + 2;
 562                P := P + 12;
 563
 564             --  Whhhh encoding
 565
 566             elsif Name_Buffer (P) = 'W'
 567               and then P < Name_Len
 568               and then Name_Buffer (P + 1) not in 'A' .. 'Z'
 569               and then Name_Buffer (P + 1) /= '_'
 570             then
 571                Name_Buffer (P + 8 .. P + Name_Len + 3) :=
 572                  Name_Buffer (P + 5 .. Name_Len);
 573                Name_Buffer (P + 2 .. P + 5) := Name_Buffer (P + 1 .. P + 4);
 574                Name_Buffer (P)     := '[';
 575                Name_Buffer (P + 1) := '"';
 576                Name_Buffer (P + 6) := '"';
 577                Name_Buffer (P + 7) := ']';
 578                Name_Len := Name_Len + 3;
 579                P := P + 8;
 580
 581             else
 582                P := P + 1;
 583             end if;
 584          end loop;
 585       end if;
 586    end Get_Decoded_Name_String_With_Brackets;
 587
 588    ------------------------
 589    -- Get_Last_Two_Chars --
 590    ------------------------
 591
 592    procedure Get_Last_Two_Chars (N : Name_Id; C1, C2 : out Character) is
 593       NE  : Name_Entry renames Name_Entries.Table (N);
 594       NEL : constant Int := Int (NE.Name_Len);
 595
 596    begin
 597       if NEL >= 2 then
 598          C1 := Name_Chars.Table (NE.Name_Chars_Index + NEL - 1);
 599          C2 := Name_Chars.Table (NE.Name_Chars_Index + NEL - 0);
 600       else
 601          C1 := ASCII.NUL;
 602          C2 := ASCII.NUL;
 603       end if;
 604    end Get_Last_Two_Chars;
 605
 606    ---------------------
 607    -- Get_Name_String --
 608    ---------------------
 609
 610    --  Procedure version leaving result in Name_Buffer, length in Name_Len
 611
 612    procedure Get_Name_String (Id : Name_Id) is
 613       S : Int;
 614
 615    begin
 616       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
 617
 618       S := Name_Entries.Table (Id).Name_Chars_Index;
 619       Name_Len := Natural (Name_Entries.Table (Id).Name_Len);
 620
 621       for J in 1 .. Name_Len loop
 622          Name_Buffer (J) := Name_Chars.Table (S + Int (J));
 623       end loop;
 624    end Get_Name_String;
 625
 626    ---------------------
 627    -- Get_Name_String --
 628    ---------------------
 629
 630    --  Function version returning a string
 631
 632    function Get_Name_String (Id : Name_Id) return String is
 633       S : Int;
 634
 635    begin
 636       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
 637       S := Name_Entries.Table (Id).Name_Chars_Index;
 638
 639       declare
 640          R : String (1 .. Natural (Name_Entries.Table (Id).Name_Len));
 641
 642       begin
 643          for J in R'Range loop
 644             R (J) := Name_Chars.Table (S + Int (J));
 645          end loop;
 646
 647          return R;
 648       end;
 649    end Get_Name_String;
 650
 651    --------------------------------
 652    -- Get_Name_String_And_Append --
 653    --------------------------------
 654
 655    procedure Get_Name_String_And_Append (Id : Name_Id) is
 656       S : Int;
 657
 658    begin
 659       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
 660
 661       S := Name_Entries.Table (Id).Name_Chars_Index;
 662
 663       for J in 1 .. Natural (Name_Entries.Table (Id).Name_Len) loop
 664          Name_Len := Name_Len + 1;
 665          Name_Buffer (Name_Len) := Name_Chars.Table (S + Int (J));
 666       end loop;
 667    end Get_Name_String_And_Append;
 668
 669    -------------------------
 670    -- Get_Name_Table_Byte --
 671    -------------------------
 672
 673    function Get_Name_Table_Byte (Id : Name_Id) return Byte is
 674    begin
 675       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
 676       return Name_Entries.Table (Id).Byte_Info;
 677    end Get_Name_Table_Byte;
 678
 679    -------------------------
 680    -- Get_Name_Table_Info --
 681    -------------------------
 682
 683    function Get_Name_Table_Info (Id : Name_Id) return Int is
 684    begin
 685       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
 686       return Name_Entries.Table (Id).Int_Info;
 687    end Get_Name_Table_Info;
 688
 689    -----------------------------------------
 690    -- Get_Unqualified_Decoded_Name_String --
 691    -----------------------------------------
 692
 693    procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id) is
 694    begin
 695       Get_Decoded_Name_String (Id);
 696       Strip_Qualification_And_Suffixes;
 697    end Get_Unqualified_Decoded_Name_String;
 698
 699    ---------------------------------
 700    -- Get_Unqualified_Name_String --
 701    ---------------------------------
 702
 703    procedure Get_Unqualified_Name_String (Id : Name_Id) is
 704    begin
 705       Get_Name_String (Id);
 706       Strip_Qualification_And_Suffixes;
 707    end Get_Unqualified_Name_String;
 708
 709    ----------
 710    -- Hash --
 711    ----------
 712
 713    function Hash return Hash_Index_Type is
 714    begin
 715       --  For the cases of 1-12 characters, all characters participate in the
 716       --  hash. The positioning is randomized, with the bias that characters
 717       --  later on participate fully (i.e. are added towards the right side).
 718
 719       case Name_Len is
 720
 721          when 0 =>
 722             return 0;
 723
 724          when 1 =>
 725             return
 726                Character'Pos (Name_Buffer (1));
 727
 728          when 2 =>
 729             return ((
 730               Character'Pos (Name_Buffer (1))) * 64 +
 731               Character'Pos (Name_Buffer (2))) mod Hash_Num;
 732
 733          when 3 =>
 734             return (((
 735               Character'Pos (Name_Buffer (1))) * 16 +
 736               Character'Pos (Name_Buffer (3))) * 16 +
 737               Character'Pos (Name_Buffer (2))) mod Hash_Num;
 738
 739          when 4 =>
 740             return ((((
 741               Character'Pos (Name_Buffer (1))) * 8 +
 742               Character'Pos (Name_Buffer (2))) * 8 +
 743               Character'Pos (Name_Buffer (3))) * 8 +
 744               Character'Pos (Name_Buffer (4))) mod Hash_Num;
 745
 746          when 5 =>
 747             return (((((
 748               Character'Pos (Name_Buffer (4))) * 8 +
 749               Character'Pos (Name_Buffer (1))) * 4 +
 750               Character'Pos (Name_Buffer (3))) * 4 +
 751               Character'Pos (Name_Buffer (5))) * 8 +
 752               Character'Pos (Name_Buffer (2))) mod Hash_Num;
 753
 754          when 6 =>
 755             return ((((((
 756               Character'Pos (Name_Buffer (5))) * 4 +
 757               Character'Pos (Name_Buffer (1))) * 4 +
 758               Character'Pos (Name_Buffer (4))) * 4 +
 759               Character'Pos (Name_Buffer (2))) * 4 +
 760               Character'Pos (Name_Buffer (6))) * 4 +
 761               Character'Pos (Name_Buffer (3))) mod Hash_Num;
 762
 763          when 7 =>
 764             return (((((((
 765               Character'Pos (Name_Buffer (4))) * 4 +
 766               Character'Pos (Name_Buffer (3))) * 4 +
 767               Character'Pos (Name_Buffer (1))) * 4 +
 768               Character'Pos (Name_Buffer (2))) * 2 +
 769               Character'Pos (Name_Buffer (5))) * 2 +
 770               Character'Pos (Name_Buffer (7))) * 2 +
 771               Character'Pos (Name_Buffer (6))) mod Hash_Num;
 772
 773          when 8 =>
 774             return ((((((((
 775               Character'Pos (Name_Buffer (2))) * 4 +
 776               Character'Pos (Name_Buffer (1))) * 4 +
 777               Character'Pos (Name_Buffer (3))) * 2 +
 778               Character'Pos (Name_Buffer (5))) * 2 +
 779               Character'Pos (Name_Buffer (7))) * 2 +
 780               Character'Pos (Name_Buffer (6))) * 2 +
 781               Character'Pos (Name_Buffer (4))) * 2 +
 782               Character'Pos (Name_Buffer (8))) mod Hash_Num;
 783
 784          when 9 =>
 785             return (((((((((
 786               Character'Pos (Name_Buffer (2))) * 4 +
 787               Character'Pos (Name_Buffer (1))) * 4 +
 788               Character'Pos (Name_Buffer (3))) * 4 +
 789               Character'Pos (Name_Buffer (4))) * 2 +
 790               Character'Pos (Name_Buffer (8))) * 2 +
 791               Character'Pos (Name_Buffer (7))) * 2 +
 792               Character'Pos (Name_Buffer (5))) * 2 +
 793               Character'Pos (Name_Buffer (6))) * 2 +
 794               Character'Pos (Name_Buffer (9))) mod Hash_Num;
 795
 796          when 10 =>
 797             return ((((((((((
 798               Character'Pos (Name_Buffer (01))) * 2 +
 799               Character'Pos (Name_Buffer (02))) * 2 +
 800               Character'Pos (Name_Buffer (08))) * 2 +
 801               Character'Pos (Name_Buffer (03))) * 2 +
 802               Character'Pos (Name_Buffer (04))) * 2 +
 803               Character'Pos (Name_Buffer (09))) * 2 +
 804               Character'Pos (Name_Buffer (06))) * 2 +
 805               Character'Pos (Name_Buffer (05))) * 2 +
 806               Character'Pos (Name_Buffer (07))) * 2 +
 807               Character'Pos (Name_Buffer (10))) mod Hash_Num;
 808
 809          when 11 =>
 810             return (((((((((((
 811               Character'Pos (Name_Buffer (05))) * 2 +
 812               Character'Pos (Name_Buffer (01))) * 2 +
 813               Character'Pos (Name_Buffer (06))) * 2 +
 814               Character'Pos (Name_Buffer (09))) * 2 +
 815               Character'Pos (Name_Buffer (07))) * 2 +
 816               Character'Pos (Name_Buffer (03))) * 2 +
 817               Character'Pos (Name_Buffer (08))) * 2 +
 818               Character'Pos (Name_Buffer (02))) * 2 +
 819               Character'Pos (Name_Buffer (10))) * 2 +
 820               Character'Pos (Name_Buffer (04))) * 2 +
 821               Character'Pos (Name_Buffer (11))) mod Hash_Num;
 822
 823          when 12 =>
 824             return ((((((((((((
 825               Character'Pos (Name_Buffer (03))) * 2 +
 826               Character'Pos (Name_Buffer (02))) * 2 +
 827               Character'Pos (Name_Buffer (05))) * 2 +
 828               Character'Pos (Name_Buffer (01))) * 2 +
 829               Character'Pos (Name_Buffer (06))) * 2 +
 830               Character'Pos (Name_Buffer (04))) * 2 +
 831               Character'Pos (Name_Buffer (08))) * 2 +
 832               Character'Pos (Name_Buffer (11))) * 2 +
 833               Character'Pos (Name_Buffer (07))) * 2 +
 834               Character'Pos (Name_Buffer (09))) * 2 +
 835               Character'Pos (Name_Buffer (10))) * 2 +
 836               Character'Pos (Name_Buffer (12))) mod Hash_Num;
 837
 838          --  Names longer than 12 characters are handled by taking the first
 839          --  6 odd numbered characters and the last 6 even numbered characters.
 840
 841          when others => declare
 842                Even_Name_Len : constant Integer := (Name_Len) / 2 * 2;
 843          begin
 844             return ((((((((((((
 845               Character'Pos (Name_Buffer (01))) * 2 +
 846               Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
 847               Character'Pos (Name_Buffer (03))) * 2 +
 848               Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
 849               Character'Pos (Name_Buffer (05))) * 2 +
 850               Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
 851               Character'Pos (Name_Buffer (07))) * 2 +
 852               Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
 853               Character'Pos (Name_Buffer (09))) * 2 +
 854               Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
 855               Character'Pos (Name_Buffer (11))) * 2 +
 856               Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
 857          end;
 858       end case;
 859    end Hash;
 860
 861    ----------------
 862    -- Initialize --
 863    ----------------
 864
 865    procedure Initialize is
 866    begin
 867       null;
 868    end Initialize;
 869
 870    ----------------------
 871    -- Is_Internal_Name --
 872    ----------------------
 873
 874    --  Version taking an argument
 875
 876    function Is_Internal_Name (Id : Name_Id) return Boolean is
 877    begin
 878       Get_Name_String (Id);
 879       return Is_Internal_Name;
 880    end Is_Internal_Name;
 881
 882    ----------------------
 883    -- Is_Internal_Name --
 884    ----------------------
 885
 886    --  Version taking its input from Name_Buffer
 887
 888    function Is_Internal_Name return Boolean is
 889    begin
 890       if Name_Buffer (1) = '_'
 891         or else Name_Buffer (Name_Len) = '_'
 892       then
 893          return True;
 894
 895       else
 896          --  Test backwards, because we only want to test the last entity
 897          --  name if the name we have is qualified with other entities.
 898
 899          for J in reverse 1 .. Name_Len loop
 900             if Is_OK_Internal_Letter (Name_Buffer (J)) then
 901                return True;
 902
 903             --  Quit if we come to terminating double underscore (note that
 904             --  if the current character is an underscore, we know that
 905             --  there is a previous character present, since we already
 906             --  filtered out the case of Name_Buffer (1) = '_' above.
 907
 908             elsif Name_Buffer (J) = '_'
 909               and then Name_Buffer (J - 1) = '_'
 910               and then Name_Buffer (J - 2) /= '_'
 911             then
 912                return False;
 913             end if;
 914          end loop;
 915       end if;
 916
 917       return False;
 918    end Is_Internal_Name;
 919
 920    ---------------------------
 921    -- Is_OK_Internal_Letter --
 922    ---------------------------
 923
 924    function Is_OK_Internal_Letter (C : Character) return Boolean is
 925    begin
 926       return C in 'A' .. 'Z'
 927         and then C /= 'O'
 928         and then C /= 'Q'
 929         and then C /= 'U'
 930         and then C /= 'W'
 931         and then C /= 'X';
 932    end Is_OK_Internal_Letter;
 933
 934    ----------------------
 935    -- Is_Operator_Name --
 936    ----------------------
 937
 938    function Is_Operator_Name (Id : Name_Id) return Boolean is
 939       S : Int;
 940    begin
 941       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
 942       S := Name_Entries.Table (Id).Name_Chars_Index;
 943       return Name_Chars.Table (S + 1) = 'O';
 944    end Is_Operator_Name;
 945
 946    -------------------
 947    -- Is_Valid_Name --
 948    -------------------
 949
 950    function Is_Valid_Name (Id : Name_Id) return Boolean is
 951    begin
 952       return Id in Name_Entries.First .. Name_Entries.Last;
 953    end Is_Valid_Name;
 954
 955    --------------------
 956    -- Length_Of_Name --
 957    --------------------
 958
 959    function Length_Of_Name (Id : Name_Id) return Nat is
 960    begin
 961       return Int (Name_Entries.Table (Id).Name_Len);
 962    end Length_Of_Name;
 963
 964    ----------
 965    -- Lock --
 966    ----------
 967
 968    procedure Lock is
 969    begin
 970       Name_Chars.Set_Last (Name_Chars.Last + Name_Chars_Reserve);
 971       Name_Entries.Set_Last (Name_Entries.Last + Name_Entries_Reserve);
 972       Name_Chars.Locked := True;
 973       Name_Entries.Locked := True;
 974       Name_Chars.Release;
 975       Name_Entries.Release;
 976    end Lock;
 977
 978    ------------------------
 979    -- Name_Chars_Address --
 980    ------------------------
 981
 982    function Name_Chars_Address return System.Address is
 983    begin
 984       return Name_Chars.Table (0)'Address;
 985    end Name_Chars_Address;
 986
 987    ----------------
 988    -- Name_Enter --
 989    ----------------
 990
 991    function Name_Enter return Name_Id is
 992    begin
 993       Name_Entries.Append
 994         ((Name_Chars_Index      => Name_Chars.Last,
 995           Name_Len              => Short (Name_Len),
 996           Byte_Info             => 0,
 997           Int_Info              => 0,
 998           Name_Has_No_Encodings => False,
 999           Hash_Link             => No_Name));
1000
1001       --  Set corresponding string entry in the Name_Chars table
1002
1003       for J in 1 .. Name_Len loop
1004          Name_Chars.Append (Name_Buffer (J));
1005       end loop;
1006
1007       Name_Chars.Append (ASCII.NUL);
1008
1009       return Name_Entries.Last;
1010    end Name_Enter;
1011
1012    --------------------------
1013    -- Name_Entries_Address --
1014    --------------------------
1015
1016    function Name_Entries_Address return System.Address is
1017    begin
1018       return Name_Entries.Table (First_Name_Id)'Address;
1019    end Name_Entries_Address;
1020
1021    ------------------------
1022    -- Name_Entries_Count --
1023    ------------------------
1024
1025    function Name_Entries_Count return Nat is
1026    begin
1027       return Int (Name_Entries.Last - Name_Entries.First + 1);
1028    end Name_Entries_Count;
1029
1030    ---------------
1031    -- Name_Find --
1032    ---------------
1033
1034    function Name_Find return Name_Id is
1035       New_Id : Name_Id;
1036       --  Id of entry in hash search, and value to be returned
1037
1038       S : Int;
1039       --  Pointer into string table
1040
1041       Hash_Index : Hash_Index_Type;
1042       --  Computed hash index
1043
1044    begin
1045       --  Quick handling for one character names
1046
1047       if Name_Len = 1 then
1048          return Name_Id (First_Name_Id + Character'Pos (Name_Buffer (1)));
1049
1050       --  Otherwise search hash table for existing matching entry
1051
1052       else
1053          Hash_Index := Namet.Hash;
1054          New_Id := Hash_Table (Hash_Index);
1055
1056          if New_Id = No_Name then
1057             Hash_Table (Hash_Index) := Name_Entries.Last + 1;
1058
1059          else
1060             Search : loop
1061                if Name_Len /=
1062                  Integer (Name_Entries.Table (New_Id).Name_Len)
1063                then
1064                   goto No_Match;
1065                end if;
1066
1067                S := Name_Entries.Table (New_Id).Name_Chars_Index;
1068
1069                for J in 1 .. Name_Len loop
1070                   if Name_Chars.Table (S + Int (J)) /= Name_Buffer (J) then
1071                      goto No_Match;
1072                   end if;
1073                end loop;
1074
1075                return New_Id;
1076
1077                --  Current entry in hash chain does not match
1078
1079                <<No_Match>>
1080                   if Name_Entries.Table (New_Id).Hash_Link /= No_Name then
1081                      New_Id := Name_Entries.Table (New_Id).Hash_Link;
1082                   else
1083                      Name_Entries.Table (New_Id).Hash_Link :=
1084                        Name_Entries.Last + 1;
1085                      exit Search;
1086                   end if;
1087             end loop Search;
1088          end if;
1089
1090          --  We fall through here only if a matching entry was not found in the
1091          --  hash table. We now create a new entry in the names table. The hash
1092          --  link pointing to the new entry (Name_Entries.Last+1) has been set.
1093
1094          Name_Entries.Append
1095            ((Name_Chars_Index      => Name_Chars.Last,
1096              Name_Len              => Short (Name_Len),
1097              Hash_Link             => No_Name,
1098              Name_Has_No_Encodings => False,
1099              Int_Info              => 0,
1100              Byte_Info             => 0));
1101
1102          --  Set corresponding string entry in the Name_Chars table
1103
1104          for J in 1 .. Name_Len loop
1105             Name_Chars.Append (Name_Buffer (J));
1106          end loop;
1107
1108          Name_Chars.Append (ASCII.NUL);
1109
1110          return Name_Entries.Last;
1111       end if;
1112    end Name_Find;
1113
1114    ------------------
1115    -- Reinitialize --
1116    ------------------
1117
1118    procedure Reinitialize is
1119    begin
1120       Name_Chars.Init;
1121       Name_Entries.Init;
1122
1123       --  Initialize entries for one character names
1124
1125       for C in Character loop
1126          Name_Entries.Append
1127            ((Name_Chars_Index      => Name_Chars.Last,
1128              Name_Len              => 1,
1129              Byte_Info             => 0,
1130              Int_Info              => 0,
1131              Name_Has_No_Encodings => True,
1132              Hash_Link             => No_Name));
1133
1134          Name_Chars.Append (C);
1135          Name_Chars.Append (ASCII.NUL);
1136       end loop;
1137
1138       --  Clear hash table
1139
1140       for J in Hash_Index_Type loop
1141          Hash_Table (J) := No_Name;
1142       end loop;
1143    end Reinitialize;
1144
1145    ----------------------
1146    -- Reset_Name_Table --
1147    ----------------------
1148
1149    procedure Reset_Name_Table is
1150    begin
1151       for J in First_Name_Id .. Name_Entries.Last loop
1152          Name_Entries.Table (J).Int_Info  := 0;
1153          Name_Entries.Table (J).Byte_Info := 0;
1154       end loop;
1155    end Reset_Name_Table;
1156
1157    --------------------------------
1158    -- Set_Character_Literal_Name --
1159    --------------------------------
1160
1161    procedure Set_Character_Literal_Name (C : Char_Code) is
1162    begin
1163       Name_Buffer (1) := 'Q';
1164       Name_Len := 1;
1165       Store_Encoded_Character (C);
1166    end Set_Character_Literal_Name;
1167
1168    -------------------------
1169    -- Set_Name_Table_Byte --
1170    -------------------------
1171
1172    procedure Set_Name_Table_Byte (Id : Name_Id; Val : Byte) is
1173    begin
1174       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
1175       Name_Entries.Table (Id).Byte_Info := Val;
1176    end Set_Name_Table_Byte;
1177
1178    -------------------------
1179    -- Set_Name_Table_Info --
1180    -------------------------
1181
1182    procedure Set_Name_Table_Info (Id : Name_Id; Val : Int) is
1183    begin
1184       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
1185       Name_Entries.Table (Id).Int_Info := Val;
1186    end Set_Name_Table_Info;
1187
1188    -----------------------------
1189    -- Store_Encoded_Character --
1190    -----------------------------
1191
1192    procedure Store_Encoded_Character (C : Char_Code) is
1193
1194       procedure Set_Hex_Chars (C : Char_Code);
1195       --  Stores given value, which is in the range 0 .. 255, as two hex
1196       --  digits (using lower case a-f) in Name_Buffer, incrementing Name_Len.
1197
1198       -------------------
1199       -- Set_Hex_Chars --
1200       -------------------
1201
1202       procedure Set_Hex_Chars (C : Char_Code) is
1203          Hexd : constant String := "0123456789abcdef";
1204          N    : constant Natural := Natural (C);
1205       begin
1206          Name_Buffer (Name_Len + 1) := Hexd (N / 16 + 1);
1207          Name_Buffer (Name_Len + 2) := Hexd (N mod 16 + 1);
1208          Name_Len := Name_Len + 2;
1209       end Set_Hex_Chars;
1210
1211    --  Start of processing for Store_Encoded_Character
1212
1213    begin
1214       Name_Len := Name_Len + 1;
1215
1216       if In_Character_Range (C) then
1217          declare
1218             CC : constant Character := Get_Character (C);
1219          begin
1220             if CC in 'a' .. 'z' or else CC in '0' .. '9' then
1221                Name_Buffer (Name_Len) := CC;
1222             else
1223                Name_Buffer (Name_Len) := 'U';
1224                Set_Hex_Chars (C);
1225             end if;
1226          end;
1227
1228       elsif In_Wide_Character_Range (C) then
1229          Name_Buffer (Name_Len) := 'W';
1230          Set_Hex_Chars (C / 256);
1231          Set_Hex_Chars (C mod 256);
1232
1233       else
1234          Name_Buffer (Name_Len) := 'W';
1235          Name_Len := Name_Len + 1;
1236          Name_Buffer (Name_Len) := 'W';
1237          Set_Hex_Chars (C / 2 ** 24);
1238          Set_Hex_Chars ((C / 2 ** 16) mod 256);
1239          Set_Hex_Chars ((C / 256) mod 256);
1240          Set_Hex_Chars (C mod 256);
1241       end if;
1242    end Store_Encoded_Character;
1243
1244    --------------------------------------
1245    -- Strip_Qualification_And_Suffixes --
1246    --------------------------------------
1247
1248    procedure Strip_Qualification_And_Suffixes is
1249       J : Integer;
1250
1251    begin
1252       --  Strip package body qualification string off end
1253
1254       for J in reverse 2 .. Name_Len loop
1255          if Name_Buffer (J) = 'X' then
1256             Name_Len := J - 1;
1257             exit;
1258          end if;
1259
1260          exit when Name_Buffer (J) /= 'b'
1261            and then Name_Buffer (J) /= 'n'
1262            and then Name_Buffer (J) /= 'p';
1263       end loop;
1264
1265       --  Find rightmost __ or $ separator if one exists. First we position
1266       --  to start the search. If we have a character constant, position
1267       --  just before it, otherwise position to last character but one
1268
1269       if Name_Buffer (Name_Len) = ''' then
1270          J := Name_Len - 2;
1271          while J > 0 and then Name_Buffer (J) /= ''' loop
1272             J := J - 1;
1273          end loop;
1274
1275       else
1276          J := Name_Len - 1;
1277       end if;
1278
1279       --  Loop to search for rightmost __ or $ (homonym) separator
1280
1281       while J > 1 loop
1282
1283          --  If $ separator, homonym separator, so strip it and keep looking
1284
1285          if Name_Buffer (J) = '$' then
1286             Name_Len := J - 1;
1287             J := Name_Len - 1;
1288
1289          --  Else check for __ found
1290
1291          elsif Name_Buffer (J) = '_' and then Name_Buffer (J + 1) = '_' then
1292
1293             --  Found __ so see if digit follows, and if so, this is a
1294             --  homonym separator, so strip it and keep looking.
1295
1296             if Name_Buffer (J + 2) in '0' .. '9' then
1297                Name_Len := J - 1;
1298                J := Name_Len - 1;
1299
1300             --  If not a homonym separator, then we simply strip the
1301             --  separator and everything that precedes it, and we are done
1302
1303             else
1304                Name_Buffer (1 .. Name_Len - J - 1) :=
1305                  Name_Buffer (J + 2 .. Name_Len);
1306                Name_Len := Name_Len - J - 1;
1307                exit;
1308             end if;
1309
1310          else
1311             J := J - 1;
1312          end if;
1313       end loop;
1314    end Strip_Qualification_And_Suffixes;
1315
1316    ---------------
1317    -- Tree_Read --
1318    ---------------
1319
1320    procedure Tree_Read is
1321    begin
1322       Name_Chars.Tree_Read;
1323       Name_Entries.Tree_Read;
1324
1325       Tree_Read_Data
1326         (Hash_Table'Address,
1327          Hash_Table'Length * (Hash_Table'Component_Size / Storage_Unit));
1328    end Tree_Read;
1329
1330    ----------------
1331    -- Tree_Write --
1332    ----------------
1333
1334    procedure Tree_Write is
1335    begin
1336       Name_Chars.Tree_Write;
1337       Name_Entries.Tree_Write;
1338
1339       Tree_Write_Data
1340         (Hash_Table'Address,
1341          Hash_Table'Length * (Hash_Table'Component_Size / Storage_Unit));
1342    end Tree_Write;
1343
1344    ------------
1345    -- Unlock --
1346    ------------
1347
1348    procedure Unlock is
1349    begin
1350       Name_Chars.Set_Last (Name_Chars.Last - Name_Chars_Reserve);
1351       Name_Entries.Set_Last (Name_Entries.Last - Name_Entries_Reserve);
1352       Name_Chars.Locked := False;
1353       Name_Entries.Locked := False;
1354       Name_Chars.Release;
1355       Name_Entries.Release;
1356    end Unlock;
1357
1358    --------
1359    -- wn --
1360    --------
1361
1362    procedure wn (Id : Name_Id) is
1363       S : Int;
1364
1365    begin
1366       if not Id'Valid then
1367          Write_Str ("<invalid name_id>");
1368
1369       elsif Id = No_Name then
1370          Write_Str ("<No_Name>");
1371
1372       elsif Id = Error_Name then
1373          Write_Str ("<Error_Name>");
1374
1375       else
1376          S := Name_Entries.Table (Id).Name_Chars_Index;
1377          Name_Len := Natural (Name_Entries.Table (Id).Name_Len);
1378
1379          for J in 1 .. Name_Len loop
1380             Write_Char (Name_Chars.Table (S + Int (J)));
1381          end loop;
1382       end if;
1383
1384       Write_Eol;
1385    end wn;
1386
1387    ----------------
1388    -- Write_Name --
1389    ----------------
1390
1391    procedure Write_Name (Id : Name_Id) is
1392    begin
1393       if Id >= First_Name_Id then
1394          Get_Name_String (Id);
1395          Write_Str (Name_Buffer (1 .. Name_Len));
1396       end if;
1397    end Write_Name;
1398
1399    ------------------------
1400    -- Write_Name_Decoded --
1401    ------------------------
1402
1403    procedure Write_Name_Decoded (Id : Name_Id) is
1404    begin
1405       if Id >= First_Name_Id then
1406          Get_Decoded_Name_String (Id);
1407          Write_Str (Name_Buffer (1 .. Name_Len));
1408       end if;
1409    end Write_Name_Decoded;
1410
1411 --  Package initialization, initialize tables
1412
1413 begin
1414    Reinitialize;
1415 end Namet;