Subversion Repositories openrisc

------------------------------------------------------------------------------

------------------------------------------------------------------------------

--                                                                          --

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                                                                          --

--                                N A M E T                                 --

--                                N A M E T                                 --

--                                                                          --

--                                                                          --

--                                 B o d y                                  --

--                                 B o d y                                  --

--                                                                          --

--                                                                          --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --

--                                                                          --

--                                                                          --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- GNAT is free software;  you can  redistribute it  and/or modify it under --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- terms of the  GNU General Public License as published  by the Free Soft- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

--                                                                          --

--                                                                          --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- version 3.1, as published by the Free Software Foundation.               --

-- version 3.1, as published by the Free Software Foundation.               --

--                                                                          --

--                                                                          --

-- You should have received a copy of the GNU General Public License and    --

-- You should have received a copy of the GNU General Public License and    --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- <http://www.gnu.org/licenses/>.                                          --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

--                                                                          --

------------------------------------------------------------------------------

------------------------------------------------------------------------------

--  WARNING: There is a C version of this package. Any changes to this

--  WARNING: There is a C version of this package. Any changes to this

--  source file must be properly reflected in the C header file namet.h

--  source file must be properly reflected in the C header file namet.h

--  which is created manually from namet.ads and namet.adb.

--  which is created manually from namet.ads and namet.adb.

with Debug;    use Debug;

with Debug;    use Debug;

with Opt;      use Opt;

with Opt;      use Opt;

with Output;   use Output;

with Output;   use Output;

with Tree_IO;  use Tree_IO;

with Tree_IO;  use Tree_IO;

with Widechar; use Widechar;

with Widechar; use Widechar;

package body Namet is

package body Namet is

   Name_Chars_Reserve   : constant := 5000;

   Name_Chars_Reserve   : constant := 5000;

   Name_Entries_Reserve : constant := 100;

   Name_Entries_Reserve : constant := 100;

   --  The names table is locked during gigi processing, since gigi assumes

   --  The names table is locked during gigi processing, since gigi assumes

   --  that the table does not move. After returning from gigi, the names

   --  that the table does not move. After returning from gigi, the names

   --  table is unlocked again, since writing library file information needs

   --  table is unlocked again, since writing library file information needs

   --  to generate some extra names. To avoid the inefficiency of always

   --  to generate some extra names. To avoid the inefficiency of always

   --  reallocating during this second unlocked phase, we reserve a bit of

   --  reallocating during this second unlocked phase, we reserve a bit of

   --  extra space before doing the release call.

   --  extra space before doing the release call.

   Hash_Num : constant Int := 2**12;

   Hash_Num : constant Int := 2**12;

   --  Number of headers in the hash table. Current hash algorithm is closely

   --  Number of headers in the hash table. Current hash algorithm is closely

   --  tailored to this choice, so it can only be changed if a corresponding

   --  tailored to this choice, so it can only be changed if a corresponding

   --  change is made to the hash algorithm.

   --  change is made to the hash algorithm.

   Hash_Max : constant Int := Hash_Num - 1;

   Hash_Max : constant Int := Hash_Num - 1;

   --  Indexes in the hash header table run from 0 to Hash_Num - 1

   --  Indexes in the hash header table run from 0 to Hash_Num - 1

   subtype Hash_Index_Type is Int range 0 .. Hash_Max;

   subtype Hash_Index_Type is Int range 0 .. Hash_Max;

   --  Range of hash index values

   --  Range of hash index values

   Hash_Table : array (Hash_Index_Type) of Name_Id;

   Hash_Table : array (Hash_Index_Type) of Name_Id;

   --  The hash table is used to locate existing entries in the names table.

   --  The hash table is used to locate existing entries in the names table.

   --  The entries point to the first names table entry whose hash value

   --  The entries point to the first names table entry whose hash value

   --  matches the hash code. Then subsequent names table entries with the

   --  matches the hash code. Then subsequent names table entries with the

   --  same hash code value are linked through the Hash_Link fields.

   --  same hash code value are linked through the Hash_Link fields.

   -----------------------

   -----------------------

   -- Local Subprograms --

   -- Local Subprograms --

   -----------------------

   -----------------------

   function Hash return Hash_Index_Type;

   function Hash return Hash_Index_Type;

   pragma Inline (Hash);

   pragma Inline (Hash);

   --  Compute hash code for name stored in Name_Buffer (length in Name_Len)

   --  Compute hash code for name stored in Name_Buffer (length in Name_Len)

   procedure Strip_Qualification_And_Suffixes;

   procedure Strip_Qualification_And_Suffixes;

   --  Given an encoded entity name in Name_Buffer, remove package body

   --  Given an encoded entity name in Name_Buffer, remove package body

   --  suffix as described for Strip_Package_Body_Suffix, and also remove

   --  suffix as described for Strip_Package_Body_Suffix, and also remove

   --  all qualification, i.e. names followed by two underscores. The

   --  all qualification, i.e. names followed by two underscores. The

   --  contents of Name_Buffer is modified by this call, and on return

   --  contents of Name_Buffer is modified by this call, and on return

   --  Name_Buffer and Name_Len reflect the stripped name.

   --  Name_Buffer and Name_Len reflect the stripped name.

   -----------------------------

   -----------------------------

   -- Add_Char_To_Name_Buffer --

   -- Add_Char_To_Name_Buffer --

   -----------------------------

   -----------------------------

   procedure Add_Char_To_Name_Buffer (C : Character) is

   procedure Add_Char_To_Name_Buffer (C : Character) is

   begin

   begin

      if Name_Len < Name_Buffer'Last then

      if Name_Len < Name_Buffer'Last then

         Name_Len := Name_Len + 1;

         Name_Len := Name_Len + 1;

         Name_Buffer (Name_Len) := C;

         Name_Buffer (Name_Len) := C;

      end if;

      end if;

   end Add_Char_To_Name_Buffer;

   end Add_Char_To_Name_Buffer;

   ----------------------------

   ----------------------------

   -- Add_Nat_To_Name_Buffer --

   -- Add_Nat_To_Name_Buffer --

   ----------------------------

   ----------------------------

   procedure Add_Nat_To_Name_Buffer (V : Nat) is

   procedure Add_Nat_To_Name_Buffer (V : Nat) is

   begin

   begin

      if V >= 10 then

      if V >= 10 then

         Add_Nat_To_Name_Buffer (V / 10);

         Add_Nat_To_Name_Buffer (V / 10);

      end if;

      end if;

      Add_Char_To_Name_Buffer (Character'Val (Character'Pos ('0') + V rem 10));

      Add_Char_To_Name_Buffer (Character'Val (Character'Pos ('0') + V rem 10));

   end Add_Nat_To_Name_Buffer;

   end Add_Nat_To_Name_Buffer;

   ----------------------------

   ----------------------------

   -- Add_Str_To_Name_Buffer --

   -- Add_Str_To_Name_Buffer --

   ----------------------------

   ----------------------------

   procedure Add_Str_To_Name_Buffer (S : String) is

   procedure Add_Str_To_Name_Buffer (S : String) is

   begin

   begin

      for J in S'Range loop

      for J in S'Range loop

         Add_Char_To_Name_Buffer (S (J));

         Add_Char_To_Name_Buffer (S (J));

      end loop;

      end loop;

   end Add_Str_To_Name_Buffer;

   end Add_Str_To_Name_Buffer;

   --------------

   --------------

   -- Finalize --

   -- Finalize --

   --------------

   --------------

   procedure Finalize is

   procedure Finalize is

      Max_Chain_Length : constant := 50;

      Max_Chain_Length : constant := 50;

      --  Max length of chains for which specific information is output

      --  Max length of chains for which specific information is output

      F : array (Int range 0 .. Max_Chain_Length) of Int;

      F : array (Int range 0 .. Max_Chain_Length) of Int;

      --  N'th entry is number of chains of length N

      --  N'th entry is number of chains of length N

      Probes : Int := 0;

      Probes : Int := 0;

      --  Used to compute average number of probes

      --  Used to compute average number of probes

      Nsyms : Int := 0;

      Nsyms : Int := 0;

      --  Number of symbols in table

      --  Number of symbols in table

   begin

   begin

      if Debug_Flag_H then

      if Debug_Flag_H then

         for J in F'Range loop

         for J in F'Range loop

            F (J) := 0;

            F (J) := 0;

         end loop;

         end loop;

         for J in Hash_Index_Type loop

         for J in Hash_Index_Type loop

            if Hash_Table (J) = No_Name then

            if Hash_Table (J) = No_Name then

               F (0) := F (0) + 1;

               F (0) := F (0) + 1;

            else

            else

               Write_Str ("Hash_Table (");

               Write_Str ("Hash_Table (");

               Write_Int (J);

               Write_Int (J);

               Write_Str (") has ");

               Write_Str (") has ");

               declare

               declare

                  C : Int := 1;

                  C : Int := 1;

                  N : Name_Id;

                  N : Name_Id;

                  S : Int;

                  S : Int;

               begin

               begin

                  C := 0;

                  C := 0;

                  N := Hash_Table (J);

                  N := Hash_Table (J);

                  while N /= No_Name loop

                  while N /= No_Name loop

                     N := Name_Entries.Table (N).Hash_Link;

                     N := Name_Entries.Table (N).Hash_Link;

                     C := C + 1;

                     C := C + 1;

                  end loop;

                  end loop;

                  Write_Int (C);

                  Write_Int (C);

                  Write_Str (" entries");

                  Write_Str (" entries");

                  Write_Eol;

                  Write_Eol;

                  if C < Max_Chain_Length then

                  if C < Max_Chain_Length then

                     F (C) := F (C) + 1;

                     F (C) := F (C) + 1;

                  else

                  else

                     F (Max_Chain_Length) := F (Max_Chain_Length) + 1;

                     F (Max_Chain_Length) := F (Max_Chain_Length) + 1;

                  end if;

                  end if;

                  N := Hash_Table (J);

                  N := Hash_Table (J);

                  while N /= No_Name loop

                  while N /= No_Name loop

                     S := Name_Entries.Table (N).Name_Chars_Index;

                     S := Name_Entries.Table (N).Name_Chars_Index;

                     Write_Str ("      ");

                     Write_Str ("      ");

                     for J in 1 .. Name_Entries.Table (N).Name_Len loop

                     for J in 1 .. Name_Entries.Table (N).Name_Len loop

                        Write_Char (Name_Chars.Table (S + Int (J)));

                        Write_Char (Name_Chars.Table (S + Int (J)));

                     end loop;

                     end loop;

                     Write_Eol;

                     Write_Eol;

                     N := Name_Entries.Table (N).Hash_Link;

                     N := Name_Entries.Table (N).Hash_Link;

                  end loop;

                  end loop;

               end;

               end;

            end if;

            end if;

         end loop;

         end loop;

         Write_Eol;

         Write_Eol;

         for J in Int range 0 .. Max_Chain_Length loop

         for J in Int range 0 .. Max_Chain_Length loop

            if F (J) /= 0 then

            if F (J) /= 0 then

               Write_Str ("Number of hash chains of length ");

               Write_Str ("Number of hash chains of length ");

               if J < 10 then

               if J < 10 then

                  Write_Char (' ');

                  Write_Char (' ');

               end if;

               end if;

               Write_Int (J);

               Write_Int (J);

               if J = Max_Chain_Length then

               if J = Max_Chain_Length then

                  Write_Str (" or greater");

                  Write_Str (" or greater");

               end if;

               end if;

               Write_Str (" = ");

               Write_Str (" = ");

               Write_Int (F (J));

               Write_Int (F (J));

               Write_Eol;

               Write_Eol;

               if J /= 0 then

               if J /= 0 then

                  Nsyms := Nsyms + F (J);

                  Nsyms := Nsyms + F (J);

                  Probes := Probes + F (J) * (1 + J) * 100;

                  Probes := Probes + F (J) * (1 + J) * 100;

               end if;

               end if;

            end if;

            end if;

         end loop;

         end loop;

         Write_Eol;

         Write_Eol;

         Write_Str ("Average number of probes for lookup = ");

         Write_Str ("Average number of probes for lookup = ");

         Probes := Probes / Nsyms;

         Probes := Probes / Nsyms;

         Write_Int (Probes / 200);

         Write_Int (Probes / 200);

         Write_Char ('.');

         Write_Char ('.');

         Probes := (Probes mod 200) / 2;

         Probes := (Probes mod 200) / 2;

         Write_Char (Character'Val (48 + Probes / 10));

         Write_Char (Character'Val (48 + Probes / 10));

         Write_Char (Character'Val (48 + Probes mod 10));

         Write_Char (Character'Val (48 + Probes mod 10));

         Write_Eol;

         Write_Eol;

         Write_Eol;

         Write_Eol;

      end if;

      end if;

   end Finalize;

   end Finalize;

   -----------------------------

   -----------------------------

   -- Get_Decoded_Name_String --

   -- Get_Decoded_Name_String --

   -----------------------------

   -----------------------------

   procedure Get_Decoded_Name_String (Id : Name_Id) is

   procedure Get_Decoded_Name_String (Id : Name_Id) is

      C : Character;

      C : Character;

      P : Natural;

      P : Natural;

   begin

   begin

      Get_Name_String (Id);

      Get_Name_String (Id);

      --  Skip scan if we already know there are no encodings

      --  Skip scan if we already know there are no encodings

      if Name_Entries.Table (Id).Name_Has_No_Encodings then

      if Name_Entries.Table (Id).Name_Has_No_Encodings then

         return;

         return;

      end if;

      end if;

      --  Quick loop to see if there is anything special to do

      --  Quick loop to see if there is anything special to do

      P := 1;

      P := 1;

      loop

      loop

         if P = Name_Len then

         if P = Name_Len then

            Name_Entries.Table (Id).Name_Has_No_Encodings := True;

            Name_Entries.Table (Id).Name_Has_No_Encodings := True;

            return;

            return;

         else

         else

            C := Name_Buffer (P);

            C := Name_Buffer (P);

            exit when

            exit when

              C = 'U' or else

              C = 'U' or else

              C = 'W' or else

              C = 'W' or else

              C = 'Q' or else

              C = 'Q' or else

              C = 'O';

              C = 'O';

            P := P + 1;

            P := P + 1;

         end if;

         end if;

      end loop;

      end loop;

      --  Here we have at least some encoding that we must decode

      --  Here we have at least some encoding that we must decode

      Decode : declare

      Decode : declare

         New_Len : Natural;

         New_Len : Natural;

         Old     : Positive;

         Old     : Positive;

         New_Buf : String (1 .. Name_Buffer'Last);

         New_Buf : String (1 .. Name_Buffer'Last);

         procedure Copy_One_Character;

         procedure Copy_One_Character;

         --  Copy a character from Name_Buffer to New_Buf. Includes case

         --  Copy a character from Name_Buffer to New_Buf. Includes case

         --  of copying a Uhh,Whhhh,WWhhhhhhhh sequence and decoding it.

         --  of copying a Uhh,Whhhh,WWhhhhhhhh sequence and decoding it.

         function Hex (N : Natural) return Word;

         function Hex (N : Natural) return Word;

         --  Scans past N digits using Old pointer and returns hex value

         --  Scans past N digits using Old pointer and returns hex value

         procedure Insert_Character (C : Character);

         procedure Insert_Character (C : Character);

         --  Insert a new character into output decoded name

         --  Insert a new character into output decoded name

         ------------------------

         ------------------------

         -- Copy_One_Character --

         -- Copy_One_Character --

         ------------------------

         ------------------------

         procedure Copy_One_Character is

         procedure Copy_One_Character is

            C : Character;

            C : Character;

         begin

         begin

            C := Name_Buffer (Old);

            C := Name_Buffer (Old);

            --  U (upper half insertion case)

            --  U (upper half insertion case)

            if C = 'U'

            if C = 'U'

              and then Old < Name_Len

              and then Old < Name_Len

              and then Name_Buffer (Old + 1) not in 'A' .. 'Z'

              and then Name_Buffer (Old + 1) not in 'A' .. 'Z'

              and then Name_Buffer (Old + 1) /= '_'

              and then Name_Buffer (Old + 1) /= '_'

            then

            then

               Old := Old + 1;

               Old := Old + 1;

               --  If we have upper half encoding, then we have to set an

               --  If we have upper half encoding, then we have to set an

               --  appropriate wide character sequence for this character.

               --  appropriate wide character sequence for this character.

               if Upper_Half_Encoding then

               if Upper_Half_Encoding then

                  Widechar.Set_Wide (Char_Code (Hex (2)), New_Buf, New_Len);

                  Widechar.Set_Wide (Char_Code (Hex (2)), New_Buf, New_Len);

                  --  For other encoding methods, upper half characters can

                  --  For other encoding methods, upper half characters can

                  --  simply use their normal representation.

                  --  simply use their normal representation.

               else

               else

                  Insert_Character (Character'Val (Hex (2)));

                  Insert_Character (Character'Val (Hex (2)));

               end if;

               end if;

            --  WW (wide wide character insertion)

            --  WW (wide wide character insertion)

            elsif C = 'W'

            elsif C = 'W'

              and then Old < Name_Len

              and then Old < Name_Len

              and then Name_Buffer (Old + 1) = 'W'

              and then Name_Buffer (Old + 1) = 'W'

            then

            then

               Old := Old + 2;

               Old := Old + 2;

               Widechar.Set_Wide (Char_Code (Hex (8)), New_Buf, New_Len);

               Widechar.Set_Wide (Char_Code (Hex (8)), New_Buf, New_Len);

            --  W (wide character insertion)

            --  W (wide character insertion)

            elsif C = 'W'

            elsif C = 'W'

              and then Old < Name_Len

              and then Old < Name_Len

              and then Name_Buffer (Old + 1) not in 'A' .. 'Z'

              and then Name_Buffer (Old + 1) not in 'A' .. 'Z'

              and then Name_Buffer (Old + 1) /= '_'

              and then Name_Buffer (Old + 1) /= '_'

            then

            then

               Old := Old + 1;

               Old := Old + 1;

               Widechar.Set_Wide (Char_Code (Hex (4)), New_Buf, New_Len);

               Widechar.Set_Wide (Char_Code (Hex (4)), New_Buf, New_Len);

            --  Any other character is copied unchanged

            --  Any other character is copied unchanged

            else

            else

               Insert_Character (C);

               Insert_Character (C);

               Old := Old + 1;

               Old := Old + 1;

            end if;

            end if;

         end Copy_One_Character;

         end Copy_One_Character;

         ---------

         ---------

         -- Hex --

         -- Hex --

         ---------

         ---------

         function Hex (N : Natural) return Word is

         function Hex (N : Natural) return Word is

            T : Word := 0;

            T : Word := 0;

            C : Character;

            C : Character;

         begin

         begin

            for J in 1 .. N loop

            for J in 1 .. N loop

               C := Name_Buffer (Old);

               C := Name_Buffer (Old);

               Old := Old + 1;

               Old := Old + 1;

               pragma Assert (C in '0' .. '9' or else C in 'a' .. 'f');

               pragma Assert (C in '0' .. '9' or else C in 'a' .. 'f');

               if C <= '9' then

               if C <= '9' then

                  T := 16 * T + Character'Pos (C) - Character'Pos ('0');

                  T := 16 * T + Character'Pos (C) - Character'Pos ('0');

               else -- C in 'a' .. 'f'

               else -- C in 'a' .. 'f'

                  T := 16 * T + Character'Pos (C) - (Character'Pos ('a') - 10);

                  T := 16 * T + Character'Pos (C) - (Character'Pos ('a') - 10);

               end if;

               end if;

            end loop;

            end loop;

            return T;

            return T;

         end Hex;

         end Hex;

         ----------------------

         ----------------------

         -- Insert_Character --

         -- Insert_Character --

         ----------------------

         ----------------------

         procedure Insert_Character (C : Character) is

         procedure Insert_Character (C : Character) is

         begin

         begin

            New_Len := New_Len + 1;

            New_Len := New_Len + 1;

            New_Buf (New_Len) := C;

            New_Buf (New_Len) := C;

         end Insert_Character;

         end Insert_Character;

      --  Start of processing for Decode

      --  Start of processing for Decode

      begin

      begin

         New_Len := 0;

         New_Len := 0;

         Old := 1;

         Old := 1;

         --  Loop through characters of name

         --  Loop through characters of name

         while Old <= Name_Len loop

         while Old <= Name_Len loop

            --  Case of character literal, put apostrophes around character

            --  Case of character literal, put apostrophes around character

            if Name_Buffer (Old) = 'Q'

            if Name_Buffer (Old) = 'Q'

              and then Old < Name_Len

              and then Old < Name_Len

            then

            then

               Old := Old + 1;

               Old := Old + 1;

               Insert_Character (''');

               Insert_Character (''');

               Copy_One_Character;

               Copy_One_Character;

               Insert_Character (''');

               Insert_Character (''');

            --  Case of operator name

            --  Case of operator name

            elsif Name_Buffer (Old) = 'O'

            elsif Name_Buffer (Old) = 'O'

              and then Old < Name_Len

              and then Old < Name_Len

              and then Name_Buffer (Old + 1) not in 'A' .. 'Z'

              and then Name_Buffer (Old + 1) not in 'A' .. 'Z'

              and then Name_Buffer (Old + 1) /= '_'

              and then Name_Buffer (Old + 1) /= '_'

            then

            then

               Old := Old + 1;

               Old := Old + 1;

               declare

               declare

                  --  This table maps the 2nd and 3rd characters of the name

                  --  This table maps the 2nd and 3rd characters of the name

                  --  into the required output. Two blanks means leave the

                  --  into the required output. Two blanks means leave the

                  --  name alone

                  --  name alone

                  Map : constant String :=

                  Map : constant String :=

                     "ab  " &               --  Oabs         => "abs"

                     "ab  " &               --  Oabs         => "abs"

                     "ad+ " &               --  Oadd         => "+"

                     "ad+ " &               --  Oadd         => "+"

                     "an  " &               --  Oand         => "and"

                     "an  " &               --  Oand         => "and"

                     "co& " &               --  Oconcat      => "&"

                     "co& " &               --  Oconcat      => "&"

                     "di/ " &               --  Odivide      => "/"

                     "di/ " &               --  Odivide      => "/"

                     "eq= " &               --  Oeq          => "="

                     "eq= " &               --  Oeq          => "="

                     "ex**" &               --  Oexpon       => "**"

                     "ex**" &               --  Oexpon       => "**"

                     "gt> " &               --  Ogt          => ">"

                     "gt> " &               --  Ogt          => ">"

                     "ge>=" &               --  Oge          => ">="

                     "ge>=" &               --  Oge          => ">="

                     "le<=" &               --  Ole          => "<="

                     "le<=" &               --  Ole          => "<="

                     "lt< " &               --  Olt          => "<"

                     "lt< " &               --  Olt          => "<"

                     "mo  " &               --  Omod         => "mod"

                     "mo  " &               --  Omod         => "mod"

                     "mu* " &               --  Omutliply    => "*"

                     "mu* " &               --  Omutliply    => "*"

                     "ne/=" &               --  One          => "/="

                     "ne/=" &               --  One          => "/="

                     "no  " &               --  Onot         => "not"

                     "no  " &               --  Onot         => "not"

                     "or  " &               --  Oor          => "or"

                     "or  " &               --  Oor          => "or"

                     "re  " &               --  Orem         => "rem"

                     "re  " &               --  Orem         => "rem"

                     "su- " &               --  Osubtract    => "-"

                     "su- " &               --  Osubtract    => "-"

                     "xo  ";                --  Oxor         => "xor"

                     "xo  ";                --  Oxor         => "xor"

                  J : Integer;

                  J : Integer;

               begin

               begin

                  Insert_Character ('"');

                  Insert_Character ('"');

                  --  Search the map. Note that this loop must terminate, if

                  --  Search the map. Note that this loop must terminate, if

                  --  not we have some kind of internal error, and a constraint

                  --  not we have some kind of internal error, and a constraint

                  --  error may be raised.

                  --  error may be raised.

                  J := Map'First;

                  J := Map'First;

                  loop

                  loop

                     exit when Name_Buffer (Old) = Map (J)

                     exit when Name_Buffer (Old) = Map (J)

                       and then Name_Buffer (Old + 1) = Map (J + 1);

                       and then Name_Buffer (Old + 1) = Map (J + 1);

                     J := J + 4;

                     J := J + 4;

                  end loop;

                  end loop;

                  --  Special operator name

                  --  Special operator name

                  if Map (J + 2) /= ' ' then

                  if Map (J + 2) /= ' ' then

                     Insert_Character (Map (J + 2));

                     Insert_Character (Map (J + 2));

                     if Map (J + 3) /= ' ' then

                     if Map (J + 3) /= ' ' then

                        Insert_Character (Map (J + 3));

                        Insert_Character (Map (J + 3));

                     end if;

                     end if;

                     Insert_Character ('"');

                     Insert_Character ('"');

                     --  Skip past original operator name in input

                     --  Skip past original operator name in input

                     while Old <= Name_Len

                     while Old <= Name_Len

                       and then Name_Buffer (Old) in 'a' .. 'z'

                       and then Name_Buffer (Old) in 'a' .. 'z'

                     loop

                     loop

                        Old := Old + 1;

                        Old := Old + 1;

                     end loop;

                     end loop;

                  --  For other operator names, leave them in lower case,

                  --  For other operator names, leave them in lower case,

                  --  surrounded by apostrophes

                  --  surrounded by apostrophes

                  else

                  else

                     --  Copy original operator name from input to output

                     --  Copy original operator name from input to output

                     while Old <= Name_Len

                     while Old <= Name_Len

                        and then Name_Buffer (Old) in 'a' .. 'z'

                        and then Name_Buffer (Old) in 'a' .. 'z'

                     loop

                     loop

                        Copy_One_Character;

                        Copy_One_Character;

                     end loop;

                     end loop;

                     Insert_Character ('"');

                     Insert_Character ('"');

                  end if;

                  end if;

               end;

               end;

            --  Else copy one character and keep going

            --  Else copy one character and keep going

            else

            else

               Copy_One_Character;

               Copy_One_Character;

            end if;

            end if;

         end loop;

         end loop;

         --  Copy new buffer as result

         --  Copy new buffer as result

         Name_Len := New_Len;

         Name_Len := New_Len;

         Name_Buffer (1 .. New_Len) := New_Buf (1 .. New_Len);

         Name_Buffer (1 .. New_Len) := New_Buf (1 .. New_Len);

      end Decode;

      end Decode;

   end Get_Decoded_Name_String;

   end Get_Decoded_Name_String;

   -------------------------------------------

   -------------------------------------------

   -- Get_Decoded_Name_String_With_Brackets --

   -- Get_Decoded_Name_String_With_Brackets --

   -------------------------------------------

   -------------------------------------------

   procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id) is

   procedure Get_Decoded_Name_String_With_Brackets (Id : Name_Id) is

      P : Natural;

      P : Natural;

   begin

   begin

      --  Case of operator name, normal decoding is fine

      --  Case of operator name, normal decoding is fine

      if Name_Buffer (1) = 'O' then

      if Name_Buffer (1) = 'O' then

         Get_Decoded_Name_String (Id);

         Get_Decoded_Name_String (Id);

      --  For character literals, normal decoding is fine

      --  For character literals, normal decoding is fine

      elsif Name_Buffer (1) = 'Q' then

      elsif Name_Buffer (1) = 'Q' then

         Get_Decoded_Name_String (Id);

         Get_Decoded_Name_String (Id);

      --  Only remaining issue is U/W/WW sequences

      --  Only remaining issue is U/W/WW sequences

      else

      else

         Get_Name_String (Id);

         Get_Name_String (Id);

         P := 1;

         P := 1;

         while P < Name_Len loop

         while P < Name_Len loop

            if Name_Buffer (P + 1) in 'A' .. 'Z' then

            if Name_Buffer (P + 1) in 'A' .. 'Z' then

               P := P + 1;

               P := P + 1;

            --  Uhh encoding

            --  Uhh encoding

            elsif Name_Buffer (P) = 'U' then

            elsif Name_Buffer (P) = 'U' then

               for J in reverse P + 3 .. P + Name_Len loop

               for J in reverse P + 3 .. P + Name_Len loop

                  Name_Buffer (J + 3) := Name_Buffer (J);

                  Name_Buffer (J + 3) := Name_Buffer (J);

               end loop;

               end loop;

               Name_Len := Name_Len + 3;

               Name_Len := Name_Len + 3;

               Name_Buffer (P + 3) := Name_Buffer (P + 2);

               Name_Buffer (P + 3) := Name_Buffer (P + 2);

               Name_Buffer (P + 2) := Name_Buffer (P + 1);

               Name_Buffer (P + 2) := Name_Buffer (P + 1);

               Name_Buffer (P)     := '[';

               Name_Buffer (P)     := '[';

               Name_Buffer (P + 1) := '"';

               Name_Buffer (P + 1) := '"';

               Name_Buffer (P + 4) := '"';

               Name_Buffer (P + 4) := '"';

               Name_Buffer (P + 5) := ']';

               Name_Buffer (P + 5) := ']';

               P := P + 6;

               P := P + 6;

            --  WWhhhhhhhh encoding

            --  WWhhhhhhhh encoding

            elsif Name_Buffer (P) = 'W'

            elsif Name_Buffer (P) = 'W'

              and then P + 9 <= Name_Len

              and then P + 9 <= Name_Len

              and then Name_Buffer (P + 1) = 'W'

              and then Name_Buffer (P + 1) = 'W'

              and then Name_Buffer (P + 2) not in 'A' .. 'Z'

              and then Name_Buffer (P + 2) not in 'A' .. 'Z'

              and then Name_Buffer (P + 2) /= '_'

              and then Name_Buffer (P + 2) /= '_'

            then

            then

               Name_Buffer (P + 12 .. Name_Len + 2) :=

               Name_Buffer (P + 12 .. Name_Len + 2) :=

                 Name_Buffer (P + 10 .. Name_Len);

                 Name_Buffer (P + 10 .. Name_Len);

               Name_Buffer (P)     := '[';

               Name_Buffer (P)     := '[';

               Name_Buffer (P + 1) := '"';

               Name_Buffer (P + 1) := '"';

               Name_Buffer (P + 10) := '"';

               Name_Buffer (P + 10) := '"';

               Name_Buffer (P + 11) := ']';

               Name_Buffer (P + 11) := ']';

               Name_Len := Name_Len + 2;

               Name_Len := Name_Len + 2;

               P := P + 12;

               P := P + 12;

            --  Whhhh encoding

            --  Whhhh encoding

            elsif Name_Buffer (P) = 'W'

            elsif Name_Buffer (P) = 'W'

              and then P < Name_Len

              and then P < Name_Len

              and then Name_Buffer (P + 1) not in 'A' .. 'Z'

              and then Name_Buffer (P + 1) not in 'A' .. 'Z'

              and then Name_Buffer (P + 1) /= '_'

              and then Name_Buffer (P + 1) /= '_'

            then

            then

               Name_Buffer (P + 8 .. P + Name_Len + 3) :=

               Name_Buffer (P + 8 .. P + Name_Len + 3) :=

                 Name_Buffer (P + 5 .. Name_Len);

                 Name_Buffer (P + 5 .. Name_Len);

               Name_Buffer (P + 2 .. P + 5) := Name_Buffer (P + 1 .. P + 4);

               Name_Buffer (P + 2 .. P + 5) := Name_Buffer (P + 1 .. P + 4);

               Name_Buffer (P)     := '[';

               Name_Buffer (P)     := '[';

               Name_Buffer (P + 1) := '"';

               Name_Buffer (P + 1) := '"';

               Name_Buffer (P + 6) := '"';

               Name_Buffer (P + 6) := '"';

               Name_Buffer (P + 7) := ']';

               Name_Buffer (P + 7) := ']';

               Name_Len := Name_Len + 3;

               Name_Len := Name_Len + 3;

               P := P + 8;

               P := P + 8;

            else

            else

               P := P + 1;

               P := P + 1;

            end if;

            end if;

         end loop;

         end loop;

      end if;

      end if;

   end Get_Decoded_Name_String_With_Brackets;

   end Get_Decoded_Name_String_With_Brackets;

   ------------------------

   ------------------------

   -- Get_Last_Two_Chars --

   -- Get_Last_Two_Chars --

   ------------------------

   ------------------------

   procedure Get_Last_Two_Chars (N : Name_Id; C1, C2 : out Character) is

   procedure Get_Last_Two_Chars (N : Name_Id; C1, C2 : out Character) is

      NE  : Name_Entry renames Name_Entries.Table (N);

      NE  : Name_Entry renames Name_Entries.Table (N);

      NEL : constant Int := Int (NE.Name_Len);

      NEL : constant Int := Int (NE.Name_Len);

   begin

   begin

      if NEL >= 2 then

      if NEL >= 2 then

         C1 := Name_Chars.Table (NE.Name_Chars_Index + NEL - 1);

         C1 := Name_Chars.Table (NE.Name_Chars_Index + NEL - 1);

         C2 := Name_Chars.Table (NE.Name_Chars_Index + NEL - 0);

         C2 := Name_Chars.Table (NE.Name_Chars_Index + NEL - 0);

      else

      else

         C1 := ASCII.NUL;

         C1 := ASCII.NUL;

         C2 := ASCII.NUL;

         C2 := ASCII.NUL;

      end if;

      end if;

   end Get_Last_Two_Chars;

   end Get_Last_Two_Chars;

   ---------------------

   ---------------------

   -- Get_Name_String --

   -- Get_Name_String --

   ---------------------

   ---------------------

   --  Procedure version leaving result in Name_Buffer, length in Name_Len

   --  Procedure version leaving result in Name_Buffer, length in Name_Len

   procedure Get_Name_String (Id : Name_Id) is

   procedure Get_Name_String (Id : Name_Id) is

      S : Int;

      S : Int;

   begin

   begin

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      S := Name_Entries.Table (Id).Name_Chars_Index;

      S := Name_Entries.Table (Id).Name_Chars_Index;

      Name_Len := Natural (Name_Entries.Table (Id).Name_Len);

      Name_Len := Natural (Name_Entries.Table (Id).Name_Len);

      for J in 1 .. Name_Len loop

      for J in 1 .. Name_Len loop

         Name_Buffer (J) := Name_Chars.Table (S + Int (J));

         Name_Buffer (J) := Name_Chars.Table (S + Int (J));

      end loop;

      end loop;

   end Get_Name_String;

   end Get_Name_String;

   ---------------------

   ---------------------

   -- Get_Name_String --

   -- Get_Name_String --

   ---------------------

   ---------------------

   --  Function version returning a string

   --  Function version returning a string

   function Get_Name_String (Id : Name_Id) return String is

   function Get_Name_String (Id : Name_Id) return String is

      S : Int;

      S : Int;

   begin

   begin

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      S := Name_Entries.Table (Id).Name_Chars_Index;

      S := Name_Entries.Table (Id).Name_Chars_Index;

      declare

      declare

         R : String (1 .. Natural (Name_Entries.Table (Id).Name_Len));

         R : String (1 .. Natural (Name_Entries.Table (Id).Name_Len));

      begin

      begin

         for J in R'Range loop

         for J in R'Range loop

            R (J) := Name_Chars.Table (S + Int (J));

            R (J) := Name_Chars.Table (S + Int (J));

         end loop;

         end loop;

         return R;

         return R;

      end;

      end;

   end Get_Name_String;

   end Get_Name_String;

   --------------------------------

   --------------------------------

   -- Get_Name_String_And_Append --

   -- Get_Name_String_And_Append --

   --------------------------------

   --------------------------------

   procedure Get_Name_String_And_Append (Id : Name_Id) is

   procedure Get_Name_String_And_Append (Id : Name_Id) is

      S : Int;

      S : Int;

   begin

   begin

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      S := Name_Entries.Table (Id).Name_Chars_Index;

      S := Name_Entries.Table (Id).Name_Chars_Index;

      for J in 1 .. Natural (Name_Entries.Table (Id).Name_Len) loop

      for J in 1 .. Natural (Name_Entries.Table (Id).Name_Len) loop

         Name_Len := Name_Len + 1;

         Name_Len := Name_Len + 1;

         Name_Buffer (Name_Len) := Name_Chars.Table (S + Int (J));

         Name_Buffer (Name_Len) := Name_Chars.Table (S + Int (J));

      end loop;

      end loop;

   end Get_Name_String_And_Append;

   end Get_Name_String_And_Append;

   -------------------------

   -------------------------

   -- Get_Name_Table_Byte --

   -- Get_Name_Table_Byte --

   -------------------------

   -------------------------

   function Get_Name_Table_Byte (Id : Name_Id) return Byte is

   function Get_Name_Table_Byte (Id : Name_Id) return Byte is

   begin

   begin

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      return Name_Entries.Table (Id).Byte_Info;

      return Name_Entries.Table (Id).Byte_Info;

   end Get_Name_Table_Byte;

   end Get_Name_Table_Byte;

   -------------------------

   -------------------------

   -- Get_Name_Table_Info --

   -- Get_Name_Table_Info --

   -------------------------

   -------------------------

   function Get_Name_Table_Info (Id : Name_Id) return Int is

   function Get_Name_Table_Info (Id : Name_Id) return Int is

   begin

   begin

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);

      return Name_Entries.Table (Id).Int_Info;

      return Name_Entries.Table (Id).Int_Info;

   end Get_Name_Table_Info;

   end Get_Name_Table_Info;

   -----------------------------------------

   -----------------------------------------

   -- Get_Unqualified_Decoded_Name_String --

   -- Get_Unqualified_Decoded_Name_String --

   -----------------------------------------

   -----------------------------------------

   procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id) is

   procedure Get_Unqualified_Decoded_Name_String (Id : Name_Id) is

   begin

   begin

      Get_Decoded_Name_String (Id);

      Get_Decoded_Name_String (Id);

      Strip_Qualification_And_Suffixes;

      Strip_Qualification_And_Suffixes;

   end Get_Unqualified_Decoded_Name_String;

   end Get_Unqualified_Decoded_Name_String;

   ---------------------------------

   ---------------------------------

   -- Get_Unqualified_Name_String --

   -- Get_Unqualified_Name_String --

   ---------------------------------

   ---------------------------------

   procedure Get_Unqualified_Name_String (Id : Name_Id) is

   procedure Get_Unqualified_Name_String (Id : Name_Id) is

   begin

   begin

      Get_Name_String (Id);

      Get_Name_String (Id);

      Strip_Qualification_And_Suffixes;

      Strip_Qualification_And_Suffixes;

   end Get_Unqualified_Name_String;

   end Get_Unqualified_Name_String;

   ----------

   ----------

   -- Hash --

   -- Hash --

   ----------

   ----------

   function Hash return Hash_Index_Type is

   function Hash return Hash_Index_Type is

   begin

   begin

      --  For the cases of 1-12 characters, all characters participate in the

      --  For the cases of 1-12 characters, all characters participate in the

      --  hash. The positioning is randomized, with the bias that characters

      --  hash. The positioning is randomized, with the bias that characters

      --  later on participate fully (i.e. are added towards the right side).

      --  later on participate fully (i.e. are added towards the right side).

      case Name_Len is

      case Name_Len is

         when 0 =>

         when 0 =>

            return 0;

            return 0;

         when 1 =>

         when 1 =>

            return

            return

               Character'Pos (Name_Buffer (1));

               Character'Pos (Name_Buffer (1));

         when 2 =>

         when 2 =>

            return ((

            return ((

              Character'Pos (Name_Buffer (1))) * 64 +

              Character'Pos (Name_Buffer (1))) * 64 +

              Character'Pos (Name_Buffer (2))) mod Hash_Num;

              Character'Pos (Name_Buffer (2))) mod Hash_Num;

         when 3 =>

         when 3 =>