gcc/ada/fmap.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 F M A P                                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.1 $
  10 --                                                                          --
  11 --            Copyright (C) 2001, Free Software Foundation, Inc.            --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Namet;  use Namet;
  30 with Osint;  use Osint;
  31 with Output; use Output;
  32 with Table;
  33
  34 with Unchecked_Conversion;
  35
  36 with GNAT.HTable;
  37
  38 package body Fmap is
  39
  40    subtype Big_String is String (Positive);
  41    type Big_String_Ptr is access all Big_String;
  42
  43    function To_Big_String_Ptr is new Unchecked_Conversion
  44      (Source_Buffer_Ptr, Big_String_Ptr);
  45
  46    package File_Mapping is new Table.Table (
  47      Table_Component_Type => File_Name_Type,
  48      Table_Index_Type     => Int,
  49      Table_Low_Bound      => 0,
  50      Table_Initial        => 1_000,
  51      Table_Increment      => 1_000,
  52      Table_Name           => "Fmap.File_Mapping");
  53    --  Mapping table to map unit names to file names.
  54
  55    package Path_Mapping is new Table.Table (
  56      Table_Component_Type => File_Name_Type,
  57      Table_Index_Type     => Int,
  58      Table_Low_Bound      => 0,
  59      Table_Initial        => 1_000,
  60      Table_Increment      => 1_000,
  61      Table_Name           => "Fmap.Path_Mapping");
  62    --  Mapping table to map file names to path names
  63
  64    type Header_Num is range 0 .. 1_000;
  65
  66    function Hash (F : Unit_Name_Type) return Header_Num;
  67    --  Function used to compute hash of unit name
  68
  69    No_Entry : constant Int := -1;
  70    --  Signals no entry in following table
  71
  72    package Unit_Hash_Table is new GNAT.HTable.Simple_HTable (
  73      Header_Num => Header_Num,
  74      Element    => Int,
  75      No_Element => No_Entry,
  76      Key        => Unit_Name_Type,
  77      Hash       => Hash,
  78      Equal      => "=");
  79    --  Hash table to map unit names to file names. Used in conjunction with
  80    --  table File_Mapping above.
  81
  82    package File_Hash_Table is new GNAT.HTable.Simple_HTable (
  83      Header_Num => Header_Num,
  84      Element    => Int,
  85      No_Element => No_Entry,
  86      Key        => File_Name_Type,
  87      Hash       => Hash,
  88      Equal      => "=");
  89    --  Hash table to map file names to path names. Used in conjunction with
  90    --  table Path_Mapping above.
  91
  92    ---------------------
  93    -- Add_To_File_Map --
  94    ---------------------
  95
  96    procedure Add_To_File_Map
  97      (Unit_Name : Unit_Name_Type;
  98       File_Name : File_Name_Type;
  99       Path_Name : File_Name_Type)
 100    is
 101    begin
 102       File_Mapping.Increment_Last;
 103       Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
 104       File_Mapping.Table (File_Mapping.Last) := File_Name;
 105       Path_Mapping.Increment_Last;
 106       File_Hash_Table.Set (File_Name, Path_Mapping.Last);
 107       Path_Mapping.Table (Path_Mapping.Last) := Path_Name;
 108    end Add_To_File_Map;
 109
 110    ----------
 111    -- Hash --
 112    ----------
 113
 114    function Hash (F : Unit_Name_Type) return Header_Num is
 115    begin
 116       return Header_Num (Int (F) rem Header_Num'Range_Length);
 117    end Hash;
 118
 119    ----------------
 120    -- Initialize --
 121    ----------------
 122
 123    procedure Initialize (File_Name : String) is
 124       Src : Source_Buffer_Ptr;
 125       Hi  : Source_Ptr;
 126       BS  : Big_String_Ptr;
 127       SP  : String_Ptr;
 128
 129       Deb : Positive := 1;
 130       Fin : Natural  := 0;
 131
 132       Uname : Unit_Name_Type;
 133       Fname : Name_Id;
 134       Pname : Name_Id;
 135
 136       procedure Empty_Tables;
 137       --  Remove all entries in case of incorrect mapping file
 138
 139       procedure Get_Line;
 140       --  Get a line from the mapping file
 141
 142       procedure Report_Truncated;
 143       --  Report a warning when the mapping file is truncated
 144       --  (number of lines is not a multiple of 3).
 145
 146       ------------------
 147       -- Empty_Tables --
 148       ------------------
 149
 150       procedure Empty_Tables is
 151       begin
 152          Unit_Hash_Table.Reset;
 153          File_Hash_Table.Reset;
 154          Path_Mapping.Set_Last (0);
 155          File_Mapping.Set_Last (0);
 156       end Empty_Tables;
 157
 158       --------------
 159       -- Get_Line --
 160       --------------
 161
 162       procedure Get_Line is
 163          use ASCII;
 164
 165       begin
 166          Deb := Fin + 1;
 167
 168          --  If not at the end of file, skip the end of line
 169
 170          while Deb < SP'Last
 171            and then (SP (Deb) = CR
 172                      or else SP (Deb) = LF
 173                      or else SP (Deb) = EOF)
 174          loop
 175             Deb := Deb + 1;
 176          end loop;
 177
 178          --  If not at the end of line, find the end of this new line
 179
 180          if Deb < SP'Last and then SP (Deb) /= EOF then
 181             Fin := Deb;
 182
 183             while Fin < SP'Last
 184               and then SP (Fin + 1) /= CR
 185               and then SP (Fin + 1) /= LF
 186               and then SP (Fin + 1) /= EOF
 187             loop
 188                Fin := Fin + 1;
 189             end loop;
 190
 191          end if;
 192       end Get_Line;
 193
 194       ----------------------
 195       -- Report_Truncated --
 196       ----------------------
 197
 198       procedure Report_Truncated is
 199       begin
 200          Write_Str ("warning: mapping file """);
 201          Write_Str (File_Name);
 202          Write_Line (""" is truncated");
 203       end Report_Truncated;
 204
 205    --  Start of procedure Initialize
 206
 207    begin
 208       Name_Len := File_Name'Length;
 209       Name_Buffer (1 .. Name_Len) := File_Name;
 210       Read_Source_File (Name_Enter, 0, Hi, Src, Config);
 211
 212       if Src = null then
 213          Write_Str ("warning: could not read mapping file """);
 214          Write_Str (File_Name);
 215          Write_Line ("""");
 216
 217       else
 218          BS := To_Big_String_Ptr (Src);
 219          SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
 220
 221          loop
 222             --  Get the unit name
 223
 224             Get_Line;
 225
 226             --  Exit if end of file has been reached
 227
 228             exit when Deb > Fin;
 229
 230             pragma Assert (Fin >= Deb + 2);
 231             pragma Assert (SP (Fin - 1) = '%');
 232             pragma Assert (SP (Fin) = 's' or else SP (Fin) = 'b');
 233
 234             Name_Len := Fin - Deb + 1;
 235             Name_Buffer (1 .. Name_Len) := SP (Deb .. Fin);
 236             Uname := Name_Find;
 237
 238             --  Get the file name
 239
 240             Get_Line;
 241
 242             --  If end of line has been reached, file is truncated
 243
 244             if Deb > Fin then
 245                Report_Truncated;
 246                Empty_Tables;
 247                return;
 248             end if;
 249
 250             Name_Len := Fin - Deb + 1;
 251             Name_Buffer (1 .. Name_Len) := SP (Deb .. Fin);
 252             Fname := Name_Find;
 253
 254             --  Get the path name
 255
 256             Get_Line;
 257
 258             --  If end of line has been reached, file is truncated
 259
 260             if Deb > Fin then
 261                Report_Truncated;
 262                Empty_Tables;
 263                return;
 264             end if;
 265
 266             Name_Len := Fin - Deb + 1;
 267             Name_Buffer (1 .. Name_Len) := SP (Deb .. Fin);
 268             Pname := Name_Find;
 269
 270             --  Check for duplicate entries
 271
 272             if Unit_Hash_Table.Get (Uname) /= No_Entry then
 273                Write_Str ("warning: duplicate entry """);
 274                Write_Str (Get_Name_String (Uname));
 275                Write_Str (""" in mapping file """);
 276                Write_Str (File_Name);
 277                Write_Line ("""");
 278                Empty_Tables;
 279                return;
 280             end if;
 281
 282             if File_Hash_Table.Get (Fname) /= No_Entry then
 283                Write_Str ("warning: duplicate entry """);
 284                Write_Str (Get_Name_String (Fname));
 285                Write_Str (""" in mapping file """);
 286                Write_Str (File_Name);
 287                Write_Line ("""");
 288                Empty_Tables;
 289                return;
 290             end if;
 291
 292             --  Add the mappings for this unit name
 293
 294             Add_To_File_Map (Uname, Fname, Pname);
 295          end loop;
 296       end if;
 297    end Initialize;
 298
 299    ----------------------
 300    -- Mapped_File_Name --
 301    ----------------------
 302
 303    function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
 304       The_Index : constant Int := Unit_Hash_Table.Get (Unit);
 305
 306    begin
 307       if The_Index = No_Entry then
 308          return No_File;
 309       else
 310          return File_Mapping.Table (The_Index);
 311       end if;
 312    end Mapped_File_Name;
 313
 314    ----------------------
 315    -- Mapped_Path_Name --
 316    ----------------------
 317
 318    function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
 319       Index : Int := No_Entry;
 320
 321    begin
 322       Index := File_Hash_Table.Get (File);
 323
 324       if Index = No_Entry then
 325          return No_File;
 326       else
 327          return Path_Mapping.Table (Index);
 328       end if;
 329    end Mapped_Path_Name;
 330
 331 end Fmap;