1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Ada
.Unchecked_Conversion
;
30 with GNAT
.OS_Lib
; use GNAT
.OS_Lib
;
31 with Namet
; use Namet
;
33 with System
; use System
;
35 package body Sinput
.P
is
37 First
: Boolean := True;
38 -- Flag used when Load_Project_File is called the first time,
39 -- to set Main_Source_File.
40 -- The flag is reset to False at the first call to Load_Project_File
42 -----------------------
43 -- Load_Project_File --
44 -----------------------
46 function Load_Project_File
(Path
: String) return Source_File_Index
is
47 Src
: Source_Buffer_Ptr
;
48 X
: Source_File_Index
;
52 Source_File_FD
: File_Descriptor
;
53 -- The file descriptor for the current source file. A negative value
54 -- indicates failure to open the specified source file.
57 -- Length of file. Assume no more than 2 gigabytes of source!
66 return No_Source_File
;
69 Source_File
.Increment_Last
;
70 X
:= Source_File
.Last
;
73 Main_Source_File
:= X
;
77 if X
= Source_File
.First
then
78 Lo
:= First_Source_Ptr
;
80 Lo
:= Source_File
.Table
(X
- 1).Source_Last
+ 1;
83 Name_Len
:= Path
'Length;
84 Name_Buffer
(1 .. Name_Len
) := Path
;
86 Name_Buffer
(Name_Len
+ 1) := ASCII
.NUL
;
88 -- Open the source FD, note that we open in binary mode, because as
89 -- documented in the spec, the caller is expected to handle either
90 -- DOS or Unix mode files, and there is no point in wasting time on
91 -- text translation when it is not required.
93 Source_File_FD
:= Open_Read
(Name_Buffer
'Address, Binary
);
95 if Source_File_FD
= Invalid_FD
then
96 Source_File
.Decrement_Last
;
97 return No_Source_File
;
101 Len
:= Integer (File_Length
(Source_File_FD
));
103 -- Set Hi so that length is one more than the physical length,
104 -- allowing for the extra EOF character at the end of the buffer
106 Hi
:= Lo
+ Source_Ptr
(Len
);
108 -- Do the actual read operation
111 subtype Actual_Source_Buffer
is Source_Buffer
(Lo
.. Hi
);
112 -- Physical buffer allocated
114 type Actual_Source_Ptr
is access Actual_Source_Buffer
;
115 -- This is the pointer type for the physical buffer allocated
117 Actual_Ptr
: Actual_Source_Ptr
:= new Actual_Source_Buffer
;
118 -- And this is the actual physical buffer
121 -- Allocate source buffer, allowing extra character at end for EOF
123 -- Some systems (e.g. VMS) have file types that require one
124 -- read per line, so read until we get the Len bytes or until
125 -- there are no more characters.
129 Actual_Len
:= Read
(Source_File_FD
, Actual_Ptr
(Hi
)'Address, Len
);
130 Hi
:= Hi
+ Source_Ptr
(Actual_Len
);
131 exit when Actual_Len
= Len
or Actual_Len
<= 0;
134 Actual_Ptr
(Hi
) := EOF
;
136 -- Now we need to work out the proper virtual origin pointer to
137 -- return. This is exactly Actual_Ptr (0)'Address, but we have
138 -- to be careful to suppress checks to compute this address.
141 pragma Suppress
(All_Checks
);
143 function To_Source_Buffer_Ptr
is new
144 Ada
.Unchecked_Conversion
(Address
, Source_Buffer_Ptr
);
147 Src
:= To_Source_Buffer_Ptr
(Actual_Ptr
(0)'Address);
151 -- Read is complete, get time stamp and close file and we are done
153 Close
(Source_File_FD
);
155 -- Get the file name, without path information
158 Index
: Positive := Path
'Last;
161 while Index
> Path
'First loop
162 exit when Path
(Index
- 1) = '/';
163 exit when Path
(Index
- 1) = Directory_Separator
;
167 Name_Len
:= Path
'Last - Index
+ 1;
168 Name_Buffer
(1 .. Name_Len
) := Path
(Index
.. Path
'Last);
169 File_Id
:= Name_Find
;
173 S
: Source_File_Record
renames Source_File
.Table
(X
);
176 S
:= (Debug_Source_Name
=> Path_Id
,
177 File_Name
=> File_Id
,
178 First_Mapped_Line
=> No_Line_Number
,
179 Full_File_Name
=> Path_Id
,
180 Full_Ref_Name
=> Path_Id
,
181 Identifier_Casing
=> Unknown
,
182 Instantiation
=> No_Location
,
183 Keyword_Casing
=> Unknown
,
184 Last_Source_Line
=> 1,
187 Lines_Table_Max
=> 1,
188 Logical_Lines_Table
=> null,
189 Num_SRef_Pragmas
=> 0,
190 Reference_Name
=> File_Id
,
192 Source_Checksum
=> 0,
196 Template
=> No_Source_File
,
197 Time_Stamp
=> Empty_Time_Stamp
);
199 Alloc_Line_Tables
(S
, Opt
.Table_Factor
* Alloc
.Lines_Initial
);
200 S
.Lines_Table
(1) := Lo
;
204 end Load_Project_File
;
206 --------------------------------
207 -- Restore_Project_Scan_State --
208 --------------------------------
210 procedure Restore_Project_Scan_State
211 (Saved_State
: in Saved_Project_Scan_State
)
214 Restore_Scan_State
(Saved_State
.Scan_State
);
215 Source
:= Saved_State
.Source
;
216 Current_Source_File
:= Saved_State
.Current_Source_File
;
217 end Restore_Project_Scan_State
;
219 -----------------------------
220 -- Save_Project_Scan_State --
221 -----------------------------
223 procedure Save_Project_Scan_State
224 (Saved_State
: out Saved_Project_Scan_State
)
227 Save_Scan_State
(Saved_State
.Scan_State
);
228 Saved_State
.Source
:= Source
;
229 Saved_State
.Current_Source_File
:= Current_Source_File
;
230 end Save_Project_Scan_State
;