gcc/ada/fmap.adb

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