gcc/ada/fmap.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 F M A P                                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2001, 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,  59 Temple Place - Suite 330,  Boston, --
  20 -- MA 02111-1307, USA.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with GNAT.OS_Lib; use GNAT.OS_Lib;
  28 with Namet;       use Namet;
  29 with Opt;         use Opt;
  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    type Mapping is record
  47       Uname : Unit_Name_Type;
  48       Fname : File_Name_Type;
  49    end record;
  50
  51    package File_Mapping is new Table.Table (
  52      Table_Component_Type => Mapping,
  53      Table_Index_Type     => Int,
  54      Table_Low_Bound      => 0,
  55      Table_Initial        => 1_000,
  56      Table_Increment      => 1_000,
  57      Table_Name           => "Fmap.File_Mapping");
  58    --  Mapping table to map unit names to file names.
  59
  60    package Path_Mapping is new Table.Table (
  61      Table_Component_Type => Mapping,
  62      Table_Index_Type     => Int,
  63      Table_Low_Bound      => 0,
  64      Table_Initial        => 1_000,
  65      Table_Increment      => 1_000,
  66      Table_Name           => "Fmap.Path_Mapping");
  67    --  Mapping table to map file names to path names
  68
  69    type Header_Num is range 0 .. 1_000;
  70
  71    function Hash (F : Unit_Name_Type) return Header_Num;
  72    --  Function used to compute hash of unit name
  73
  74    No_Entry : constant Int := -1;
  75    --  Signals no entry in following table
  76
  77    package Unit_Hash_Table is new GNAT.HTable.Simple_HTable (
  78      Header_Num => Header_Num,
  79      Element    => Int,
  80      No_Element => No_Entry,
  81      Key        => Unit_Name_Type,
  82      Hash       => Hash,
  83      Equal      => "=");
  84    --  Hash table to map unit names to file names. Used in conjunction with
  85    --  table File_Mapping above.
  86
  87    package File_Hash_Table is new GNAT.HTable.Simple_HTable (
  88      Header_Num => Header_Num,
  89      Element    => Int,
  90      No_Element => No_Entry,
  91      Key        => File_Name_Type,
  92      Hash       => Hash,
  93      Equal      => "=");
  94    --  Hash table to map file names to path names. Used in conjunction with
  95    --  table Path_Mapping above.
  96
  97    Last_In_Table : Int := 0;
  98
  99    ---------------------
 100    -- Add_To_File_Map --
 101    ---------------------
 102
 103    procedure Add_To_File_Map
 104      (Unit_Name : Unit_Name_Type;
 105       File_Name : File_Name_Type;
 106       Path_Name : File_Name_Type)
 107    is
 108    begin
 109       File_Mapping.Increment_Last;
 110       Unit_Hash_Table.Set (Unit_Name, File_Mapping.Last);
 111       File_Mapping.Table (File_Mapping.Last) :=
 112         (Uname => Unit_Name, Fname => File_Name);
 113       Path_Mapping.Increment_Last;
 114       File_Hash_Table.Set (File_Name, Path_Mapping.Last);
 115       Path_Mapping.Table (Path_Mapping.Last) :=
 116         (Uname => Unit_Name, Fname => Path_Name);
 117    end Add_To_File_Map;
 118
 119    ----------
 120    -- Hash --
 121    ----------
 122
 123    function Hash (F : Unit_Name_Type) return Header_Num is
 124    begin
 125       return Header_Num (Int (F) rem Header_Num'Range_Length);
 126    end Hash;
 127
 128    ----------------
 129    -- Initialize --
 130    ----------------
 131
 132    procedure Initialize (File_Name : String) is
 133       Src : Source_Buffer_Ptr;
 134       Hi  : Source_Ptr;
 135       BS  : Big_String_Ptr;
 136       SP  : String_Ptr;
 137
 138       First : Positive := 1;
 139       Last  : Natural  := 0;
 140
 141       Uname : Unit_Name_Type;
 142       Fname : Name_Id;
 143       Pname : Name_Id;
 144
 145       The_Mapping : Mapping;
 146
 147       procedure Empty_Tables;
 148       --  Remove all entries in case of incorrect mapping file
 149
 150       procedure Get_Line;
 151       --  Get a line from the mapping file
 152
 153       procedure Report_Truncated;
 154       --  Report a warning when the mapping file is truncated
 155       --  (number of lines is not a multiple of 3).
 156
 157       ------------------
 158       -- Empty_Tables --
 159       ------------------
 160
 161       procedure Empty_Tables is
 162       begin
 163          Unit_Hash_Table.Reset;
 164          File_Hash_Table.Reset;
 165          Path_Mapping.Set_Last (0);
 166          File_Mapping.Set_Last (0);
 167          Last_In_Table := 0;
 168       end Empty_Tables;
 169
 170       --------------
 171       -- Get_Line --
 172       --------------
 173
 174       procedure Get_Line is
 175          use ASCII;
 176
 177       begin
 178          First := Last + 1;
 179
 180          --  If not at the end of file, skip the end of line
 181
 182          while First < SP'Last
 183            and then (SP (First) = CR
 184                      or else SP (First) = LF
 185                      or else SP (First) = EOF)
 186          loop
 187             First := First + 1;
 188          end loop;
 189
 190          --  If not at the end of file, find the end of this new line
 191
 192          if First < SP'Last and then SP (First) /= EOF then
 193             Last := First;
 194
 195             while Last < SP'Last
 196               and then SP (Last + 1) /= CR
 197               and then SP (Last + 1) /= LF
 198               and then SP (Last + 1) /= EOF
 199             loop
 200                Last := Last + 1;
 201             end loop;
 202
 203          end if;
 204       end Get_Line;
 205
 206       ----------------------
 207       -- Report_Truncated --
 208       ----------------------
 209
 210       procedure Report_Truncated is
 211       begin
 212          if not Quiet_Output then
 213             Write_Str ("warning: mapping file """);
 214             Write_Str (File_Name);
 215             Write_Line (""" is truncated");
 216          end if;
 217       end Report_Truncated;
 218
 219    --  Start of procedure Initialize
 220
 221    begin
 222       Empty_Tables;
 223       Name_Len := File_Name'Length;
 224       Name_Buffer (1 .. Name_Len) := File_Name;
 225       Read_Source_File (Name_Enter, 0, Hi, Src, Config);
 226
 227       if Src = null then
 228          if not Quiet_Output then
 229             Write_Str ("warning: could not read mapping file """);
 230             Write_Str (File_Name);
 231             Write_Line ("""");
 232          end if;
 233
 234       else
 235          BS := To_Big_String_Ptr (Src);
 236          SP := BS (1 .. Natural (Hi))'Unrestricted_Access;
 237
 238          loop
 239             --  Get the unit name
 240
 241             Get_Line;
 242
 243             --  Exit if end of file has been reached
 244
 245             exit when First > Last;
 246
 247             pragma Assert (Last >= First + 2);
 248             pragma Assert (SP (Last - 1) = '%');
 249             pragma Assert (SP (Last) = 's' or else SP (Last) = 'b');
 250
 251             Name_Len := Last - First + 1;
 252             Name_Buffer (1 .. Name_Len) := SP (First .. Last);
 253             Uname := Name_Find;
 254
 255             --  Get the file name
 256
 257             Get_Line;
 258
 259             --  If end of line has been reached, file is truncated
 260
 261             if First > Last then
 262                Report_Truncated;
 263                Empty_Tables;
 264                return;
 265             end if;
 266
 267             Name_Len := Last - First + 1;
 268             Name_Buffer (1 .. Name_Len) := SP (First .. Last);
 269             Fname := Name_Find;
 270
 271             --  Get the path name
 272
 273             Get_Line;
 274
 275             --  If end of line has been reached, file is truncated
 276
 277             if First > Last then
 278                Report_Truncated;
 279                Empty_Tables;
 280                return;
 281             end if;
 282
 283             Name_Len := Last - First + 1;
 284             Name_Buffer (1 .. Name_Len) := SP (First .. Last);
 285             Pname := Name_Find;
 286
 287             --  Check for duplicate entries
 288
 289             if Unit_Hash_Table.Get (Uname) /= No_Entry then
 290                if not Quiet_Output then
 291                   Write_Str ("warning: duplicate entry """);
 292                   Write_Str (Get_Name_String (Uname));
 293                   Write_Str (""" in mapping file """);
 294                   Write_Str (File_Name);
 295                   Write_Line ("""");
 296                   The_Mapping :=
 297                     File_Mapping.Table (Unit_Hash_Table.Get (Uname));
 298                   Write_Line (Get_Name_String (The_Mapping.Uname));
 299                   Write_Line (Get_Name_String (The_Mapping.Fname));
 300                end if;
 301
 302                Empty_Tables;
 303                return;
 304             end if;
 305
 306             if File_Hash_Table.Get (Fname) /= No_Entry then
 307                if not Quiet_Output then
 308                   Write_Str ("warning: duplicate entry """);
 309                   Write_Str (Get_Name_String (Fname));
 310                   Write_Str (""" in mapping file """);
 311                   Write_Str (File_Name);
 312                   Write_Line ("""");
 313                   The_Mapping :=
 314                     Path_Mapping.Table (File_Hash_Table.Get (Fname));
 315                   Write_Line (Get_Name_String (The_Mapping.Uname));
 316                   Write_Line (Get_Name_String (The_Mapping.Fname));
 317                end if;
 318
 319                Empty_Tables;
 320                return;
 321             end if;
 322
 323             --  Add the mappings for this unit name
 324
 325             Add_To_File_Map (Uname, Fname, Pname);
 326          end loop;
 327       end if;
 328
 329       --  Record the length of the two mapping tables
 330
 331       Last_In_Table := File_Mapping.Last;
 332
 333    end Initialize;
 334
 335    ----------------------
 336    -- Mapped_File_Name --
 337    ----------------------
 338
 339    function Mapped_File_Name (Unit : Unit_Name_Type) return File_Name_Type is
 340       The_Index : constant Int := Unit_Hash_Table.Get (Unit);
 341
 342    begin
 343       if The_Index = No_Entry then
 344          return No_File;
 345       else
 346          return File_Mapping.Table (The_Index).Fname;
 347       end if;
 348    end Mapped_File_Name;
 349
 350    ----------------------
 351    -- Mapped_Path_Name --
 352    ----------------------
 353
 354    function Mapped_Path_Name (File : File_Name_Type) return File_Name_Type is
 355       Index : Int := No_Entry;
 356
 357    begin
 358       Index := File_Hash_Table.Get (File);
 359
 360       if Index = No_Entry then
 361          return No_File;
 362       else
 363          return Path_Mapping.Table (Index).Fname;
 364       end if;
 365    end Mapped_Path_Name;
 366
 367    -------------------------
 368    -- Update_Mapping_File --
 369    -------------------------
 370
 371    procedure Update_Mapping_File (File_Name : String) is
 372       File : File_Descriptor;
 373
 374       procedure Put_Line (Name : Name_Id);
 375       --  Put Name as a line in the Mapping File
 376
 377       --------------
 378       -- Put_Line --
 379       --------------
 380
 381       procedure Put_Line (Name : Name_Id) is
 382          N_Bytes : Integer;
 383       begin
 384          Get_Name_String (Name);
 385          Name_Len := Name_Len + 1;
 386          Name_Buffer (Name_Len) := ASCII.LF;
 387          N_Bytes := Write (File, Name_Buffer (1)'Address, Name_Len);
 388
 389          if N_Bytes < Name_Len then
 390             Fail ("disk full");
 391          end if;
 392
 393       end Put_Line;
 394
 395    --  Start of Update_Mapping_File
 396
 397    begin
 398
 399       --  Only Update if there are new entries in the mappings
 400
 401       if Last_In_Table < File_Mapping.Last then
 402
 403          --  If the tables have been emptied, recreate the file.
 404          --  Otherwise, append to it.
 405
 406          if Last_In_Table = 0 then
 407             declare
 408                Discard : Boolean;
 409
 410             begin
 411                Delete_File (File_Name, Discard);
 412             end;
 413
 414             File := Create_File (File_Name, Binary);
 415
 416          else
 417             File := Open_Read_Write (Name => File_Name, Fmode => Binary);
 418          end if;
 419
 420          if File /= Invalid_FD then
 421             if Last_In_Table > 0 then
 422                Lseek (File, 0, Seek_End);
 423             end if;
 424
 425             for Unit in Last_In_Table + 1 .. File_Mapping.Last loop
 426                Put_Line (File_Mapping.Table (Unit).Uname);
 427                Put_Line (File_Mapping.Table (Unit).Fname);
 428                Put_Line (Path_Mapping.Table (Unit).Fname);
 429             end loop;
 430
 431             Close (File);
 432
 433          elsif not Quiet_Output then
 434             Write_Str ("warning: could not open mapping file """);
 435             Write_Str (File_Name);
 436             Write_Line (""" for update");
 437          end if;
 438
 439       end if;
 440    end Update_Mapping_File;
 441
 442 end Fmap;