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