1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
27 with System
; use System
;
29 with Ada
.Unchecked_Conversion
;
31 pragma Warnings
(Off
);
32 -- This package is used also by gnatcoll
33 with System
.OS_Lib
; use System
.OS_Lib
;
36 package body Sinput
.C
is
42 function Load_File
(Path
: String) return Source_File_Index
is
43 Src
: Source_Buffer_Ptr
;
44 X
: Source_File_Index
;
48 Source_File_FD
: File_Descriptor
;
49 -- The file descriptor for the current source file. A negative value
50 -- indicates failure to open the specified source file.
53 -- Length of file. Assume no more than 2 gigabytes of source!
57 Path_Id
: File_Name_Type
;
58 File_Id
: File_Name_Type
;
62 return No_Source_File
;
65 Source_File
.Increment_Last
;
66 X
:= Source_File
.Last
;
68 if X
= Source_File
.First
then
69 Lo
:= First_Source_Ptr
;
71 Lo
:= Source_File
.Table
(X
- 1).Source_Last
+ 1;
74 Name_Len
:= Path
'Length;
75 Name_Buffer
(1 .. Name_Len
) := Path
;
77 Name_Buffer
(Name_Len
+ 1) := ASCII
.NUL
;
79 -- Open the source FD, note that we open in binary mode, because as
80 -- documented in the spec, the caller is expected to handle either
81 -- DOS or Unix mode files, and there is no point in wasting time on
82 -- text translation when it is not required.
84 Source_File_FD
:= Open_Read
(Name_Buffer
'Address, Binary
);
86 if Source_File_FD
= Invalid_FD
then
87 Source_File
.Decrement_Last
;
88 return No_Source_File
;
92 Len
:= Integer (File_Length
(Source_File_FD
));
94 -- Set Hi so that length is one more than the physical length,
95 -- allowing for the extra EOF character at the end of the buffer
97 Hi
:= Lo
+ Source_Ptr
(Len
);
99 -- Do the actual read operation
102 subtype Actual_Source_Buffer
is Source_Buffer
(Lo
.. Hi
);
103 -- Physical buffer allocated
105 type Actual_Source_Ptr
is access Actual_Source_Buffer
;
106 -- This is the pointer type for the physical buffer allocated
108 Actual_Ptr
: constant Actual_Source_Ptr
:= new Actual_Source_Buffer
;
109 -- And this is the actual physical buffer
112 -- Allocate source buffer, allowing extra character at end for EOF
114 -- Some systems (e.g. VMS) have file types that require one
115 -- read per line, so read until we get the Len bytes or until
116 -- there are no more characters.
120 Actual_Len
:= Read
(Source_File_FD
, Actual_Ptr
(Hi
)'Address, Len
);
121 Hi
:= Hi
+ Source_Ptr
(Actual_Len
);
122 exit when Actual_Len
= Len
or else Actual_Len
<= 0;
125 Actual_Ptr
(Hi
) := EOF
;
127 -- Now we need to work out the proper virtual origin pointer to
128 -- return. This is exactly Actual_Ptr (0)'Address, but we have
129 -- to be careful to suppress checks to compute this address.
132 pragma Suppress
(All_Checks
);
134 pragma Warnings
(Off
);
135 -- The following unchecked conversion is aliased safe, since it
136 -- is not used to create improperly aliased pointer values.
138 function To_Source_Buffer_Ptr
is new
139 Ada
.Unchecked_Conversion
(Address
, Source_Buffer_Ptr
);
141 pragma Warnings
(On
);
144 Src
:= To_Source_Buffer_Ptr
(Actual_Ptr
(0)'Address);
148 -- Read is complete, close the file and we are done (no need to test
149 -- status from close, since we have successfully read the file!)
151 Close
(Source_File_FD
);
153 -- Get the file name, without path information
156 Index
: Positive := Path
'Last;
159 while Index
> Path
'First loop
160 exit when Path
(Index
- 1) = '/';
161 exit when Path
(Index
- 1) = Directory_Separator
;
165 Name_Len
:= Path
'Last - Index
+ 1;
166 Name_Buffer
(1 .. Name_Len
) := Path
(Index
.. Path
'Last);
167 File_Id
:= Name_Find
;
171 S
: Source_File_Record
renames Source_File
.Table
(X
);
174 S
:= (Debug_Source_Name
=> File_Id
,
175 File_Name
=> File_Id
,
177 First_Mapped_Line
=> No_Line_Number
,
178 Full_Debug_Name
=> Path_Id
,
179 Full_File_Name
=> Path_Id
,
180 Full_Ref_Name
=> Path_Id
,
181 Instance
=> No_Instance_Id
,
182 Identifier_Casing
=> Unknown
,
183 Inlined_Call
=> No_Location
,
184 Inlined_Body
=> False,
185 Keyword_Casing
=> Unknown
,
186 Last_Source_Line
=> 1,
189 Lines_Table_Max
=> 1,
190 Logical_Lines_Table
=> null,
191 Num_SRef_Pragmas
=> 0,
192 Reference_Name
=> File_Id
,
194 Source_Checksum
=> 0,
198 Template
=> No_Source_File
,
200 Time_Stamp
=> Empty_Time_Stamp
);
202 Alloc_Line_Tables
(S
, Opt
.Table_Factor
* Alloc
.Lines_Initial
);
203 S
.Lines_Table
(1) := Lo
;
206 Set_Source_File_Index_Table
(X
);