gcc/ada/sinput-p.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S I N P U T . P                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.9 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-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 Ada.Unchecked_Conversion;
  30
  31 with GNAT.OS_Lib; use GNAT.OS_Lib;
  32 with Namet;       use Namet;
  33 with Opt;         use Opt;
  34 with System;      use System;
  35
  36 package body Sinput.P is
  37
  38    First : Boolean := True;
  39    --  Flag used when Load_Project_File is called the first time,
  40    --  to set Main_Source_File.
  41    --  The flag is reset to False at the first call to Load_Project_File
  42
  43    -----------------------
  44    -- Load_Project_File --
  45    -----------------------
  46
  47    function Load_Project_File (Path : String) return Source_File_Index is
  48       Src  : Source_Buffer_Ptr;
  49       X    : Source_File_Index;
  50       Lo   : Source_Ptr;
  51       Hi   : Source_Ptr;
  52
  53       Source_File_FD : File_Descriptor;
  54       --  The file descriptor for the current source file. A negative value
  55       --  indicates failure to open the specified source file.
  56
  57       Len : Integer;
  58       --  Length of file. Assume no more than 2 gigabytes of source!
  59
  60       Actual_Len : Integer;
  61
  62       Path_Id : Name_Id;
  63       File_Id : Name_Id;
  64
  65    begin
  66       if Path = "" then
  67          return No_Source_File;
  68       end if;
  69
  70       Source_File.Increment_Last;
  71       X := Source_File.Last;
  72
  73       if First then
  74          Main_Source_File := X;
  75          First := False;
  76       end if;
  77
  78       if X = Source_File.First then
  79          Lo := First_Source_Ptr;
  80       else
  81          Lo := Source_File.Table (X - 1).Source_Last + 1;
  82       end if;
  83
  84       Name_Len := Path'Length;
  85       Name_Buffer (1 .. Name_Len) := Path;
  86       Path_Id := Name_Find;
  87       Name_Buffer (Name_Len + 1) := ASCII.NUL;
  88
  89       --  Open the source FD, note that we open in binary mode, because as
  90       --  documented in the spec, the caller is expected to handle either
  91       --  DOS or Unix mode files, and there is no point in wasting time on
  92       --  text translation when it is not required.
  93
  94       Source_File_FD := Open_Read (Name_Buffer'Address, Binary);
  95
  96       if Source_File_FD = Invalid_FD then
  97          Source_File.Decrement_Last;
  98          return No_Source_File;
  99
 100       end if;
 101
 102       Len := Integer (File_Length (Source_File_FD));
 103
 104       --  Set Hi so that length is one more than the physical length,
 105       --  allowing for the extra EOF character at the end of the buffer
 106
 107       Hi := Lo + Source_Ptr (Len);
 108
 109       --  Do the actual read operation
 110
 111       declare
 112          subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
 113          --  Physical buffer allocated
 114
 115          type Actual_Source_Ptr is access Actual_Source_Buffer;
 116          --  This is the pointer type for the physical buffer allocated
 117
 118          Actual_Ptr : Actual_Source_Ptr := new Actual_Source_Buffer;
 119          --  And this is the actual physical buffer
 120
 121       begin
 122          --  Allocate source buffer, allowing extra character at end for EOF
 123
 124          --  Some systems (e.g. VMS) have file types that require one
 125          --  read per line, so read until we get the Len bytes or until
 126          --  there are no more characters.
 127
 128          Hi := Lo;
 129          loop
 130             Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
 131             Hi := Hi + Source_Ptr (Actual_Len);
 132             exit when Actual_Len = Len or Actual_Len <= 0;
 133          end loop;
 134
 135          Actual_Ptr (Hi) := EOF;
 136
 137          --  Now we need to work out the proper virtual origin pointer to
 138          --  return. This is exactly Actual_Ptr (0)'Address, but we have
 139          --  to be careful to suppress checks to compute this address.
 140
 141          declare
 142             pragma Suppress (All_Checks);
 143
 144             function To_Source_Buffer_Ptr is new
 145               Ada.Unchecked_Conversion (Address, Source_Buffer_Ptr);
 146
 147          begin
 148             Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
 149          end;
 150       end;
 151
 152       --  Read is complete, get time stamp and close file and we are done
 153
 154       Close (Source_File_FD);
 155
 156       --  Get the file name, without path information
 157
 158       declare
 159          Index : Positive := Path'Last;
 160
 161       begin
 162          while Index > Path'First loop
 163             exit when Path (Index - 1) = '/';
 164             exit when Path (Index - 1) = Directory_Separator;
 165             Index := Index - 1;
 166          end loop;
 167
 168          Name_Len := Path'Last - Index + 1;
 169          Name_Buffer (1 .. Name_Len) := Path (Index .. Path'Last);
 170          File_Id := Name_Find;
 171       end;
 172
 173       declare
 174          S : Source_File_Record renames Source_File.Table (X);
 175
 176       begin
 177          S := (Debug_Source_Name   => Path_Id,
 178                File_Name           => File_Id,
 179                First_Mapped_Line   => No_Line_Number,
 180                Full_File_Name      => Path_Id,
 181                Full_Ref_Name       => Path_Id,
 182                Identifier_Casing   => Unknown,
 183                Instantiation       => No_Location,
 184                Keyword_Casing      => Unknown,
 185                Last_Source_Line    => 1,
 186                License             => Unknown,
 187                Lines_Table         => null,
 188                Lines_Table_Max     => 1,
 189                Logical_Lines_Table => null,
 190                Num_SRef_Pragmas    => 0,
 191                Reference_Name      => File_Id,
 192                Sloc_Adjust         => 0,
 193                Source_Checksum     => 0,
 194                Source_First        => Lo,
 195                Source_Last         => Hi,
 196                Source_Text         => Src,
 197                Template            => No_Source_File,
 198                Time_Stamp          => Empty_Time_Stamp);
 199
 200          Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
 201          S.Lines_Table (1) := Lo;
 202       end;
 203
 204       return X;
 205    end Load_Project_File;
 206
 207    --------------------------------
 208    -- Restore_Project_Scan_State --
 209    --------------------------------
 210
 211    procedure Restore_Project_Scan_State
 212      (Saved_State : in Saved_Project_Scan_State)
 213    is
 214    begin
 215       Restore_Scan_State (Saved_State.Scan_State);
 216       Source              := Saved_State.Source;
 217       Current_Source_File := Saved_State.Current_Source_File;
 218    end Restore_Project_Scan_State;
 219
 220    -----------------------------
 221    -- Save_Project_Scan_State --
 222    -----------------------------
 223
 224    procedure Save_Project_Scan_State
 225      (Saved_State : out Saved_Project_Scan_State)
 226    is
 227    begin
 228       Save_Scan_State (Saved_State.Scan_State);
 229       Saved_State.Source              := Source;
 230       Saved_State.Current_Source_File := Current_Source_File;
 231    end Save_Project_Scan_State;
 232
 233 end Sinput.P;