Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 1 | ------------------------------------------------------------------------------ |
| 2 | -- -- |
| 3 | -- GNAT COMPILER COMPONENTS -- |
| 4 | -- -- |
| 5 | -- S I N P U T . L -- |
| 6 | -- -- |
| 7 | -- B o d y -- |
| 8 | -- -- |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 9 | -- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 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 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. -- |
| 20 | -- -- |
| 21 | -- GNAT was originally developed by the GNAT team at New York University. -- |
| 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| 23 | -- -- |
| 24 | ------------------------------------------------------------------------------ |
| 25 | |
| 26 | with Alloc; |
| 27 | with Atree; use Atree; |
| 28 | with Debug; use Debug; |
| 29 | with Einfo; use Einfo; |
| 30 | with Errout; use Errout; |
| 31 | with Fname; use Fname; |
| 32 | with Hostparm; |
| 33 | with Lib; use Lib; |
| 34 | with Opt; use Opt; |
| 35 | with Osint; use Osint; |
| 36 | with Output; use Output; |
| 37 | with Prep; use Prep; |
| 38 | with Prepcomp; use Prepcomp; |
| 39 | with Scans; use Scans; |
| 40 | with Scn; use Scn; |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 41 | with Sem_Aux; use Sem_Aux; |
| 42 | with Sem_Util; use Sem_Util; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 43 | with Sinfo; use Sinfo; |
| 44 | with Snames; use Snames; |
| 45 | with System; use System; |
| 46 | |
| 47 | with System.OS_Lib; use System.OS_Lib; |
| 48 | |
| 49 | with Unchecked_Conversion; |
| 50 | |
| 51 | package body Sinput.L is |
| 52 | |
| 53 | Prep_Buffer : Text_Buffer_Ptr := null; |
| 54 | -- A buffer to temporarily stored the result of preprocessing a source. |
| 55 | -- It is only allocated if there is at least one source to preprocess. |
| 56 | |
| 57 | Prep_Buffer_Last : Text_Ptr := 0; |
| 58 | -- Index of the last significant character in Prep_Buffer |
| 59 | |
| 60 | Initial_Size_Of_Prep_Buffer : constant := 10_000; |
| 61 | -- Size of Prep_Buffer when it is first allocated |
| 62 | |
| 63 | -- When a file is to be preprocessed and the options to list symbols |
| 64 | -- has been selected (switch -s), Prep.List_Symbols is called with a |
| 65 | -- "foreword", a single line indicating what source the symbols apply to. |
| 66 | -- The following two constant String are the start and the end of this |
| 67 | -- foreword. |
| 68 | |
| 69 | Foreword_Start : constant String := |
| 70 | "Preprocessing Symbols for source """; |
| 71 | |
| 72 | Foreword_End : constant String := """"; |
| 73 | |
| 74 | ----------------- |
| 75 | -- Subprograms -- |
| 76 | ----------------- |
| 77 | |
| 78 | procedure Put_Char_In_Prep_Buffer (C : Character); |
| 79 | -- Add one character in Prep_Buffer, extending Prep_Buffer if need be. |
| 80 | -- Used to initialize the preprocessor. |
| 81 | |
| 82 | procedure New_EOL_In_Prep_Buffer; |
| 83 | -- Add an LF to Prep_Buffer (used to initialize the preprocessor) |
| 84 | |
| 85 | function Load_File |
| 86 | (N : File_Name_Type; |
| 87 | T : Osint.File_Type) return Source_File_Index; |
| 88 | -- Load a source file, a configuration pragmas file or a definition file |
| 89 | -- Coding also allows preprocessing file, but not a library file ??? |
| 90 | |
| 91 | ------------------------------- |
| 92 | -- Adjust_Instantiation_Sloc -- |
| 93 | ------------------------------- |
| 94 | |
| 95 | procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is |
| 96 | Loc : constant Source_Ptr := Sloc (N); |
| 97 | |
| 98 | begin |
| 99 | -- We only do the adjustment if the value is between the appropriate low |
| 100 | -- and high values. It is not clear that this should ever not be the |
| 101 | -- case, but in practice there seem to be some nodes that get copied |
| 102 | -- twice, and this is a defence against that happening. |
| 103 | |
| 104 | if A.Lo <= Loc and then Loc <= A.Hi then |
| 105 | Set_Sloc (N, Loc + A.Adjust); |
| 106 | end if; |
| 107 | end Adjust_Instantiation_Sloc; |
| 108 | |
| 109 | -------------------------------- |
| 110 | -- Complete_Source_File_Entry -- |
| 111 | -------------------------------- |
| 112 | |
| 113 | procedure Complete_Source_File_Entry is |
| 114 | CSF : constant Source_File_Index := Current_Source_File; |
| 115 | |
| 116 | begin |
| 117 | Trim_Lines_Table (CSF); |
| 118 | Source_File.Table (CSF).Source_Checksum := Checksum; |
| 119 | end Complete_Source_File_Entry; |
| 120 | |
| 121 | --------------------------------- |
| 122 | -- Create_Instantiation_Source -- |
| 123 | --------------------------------- |
| 124 | |
| 125 | procedure Create_Instantiation_Source |
| 126 | (Inst_Node : Entity_Id; |
| 127 | Template_Id : Entity_Id; |
| 128 | Inlined_Body : Boolean; |
| 129 | A : out Sloc_Adjustment) |
| 130 | is |
| 131 | Dnod : constant Node_Id := Declaration_Node (Template_Id); |
| 132 | Xold : Source_File_Index; |
| 133 | Xnew : Source_File_Index; |
| 134 | |
| 135 | begin |
| 136 | Xold := Get_Source_File_Index (Sloc (Template_Id)); |
| 137 | A.Lo := Source_File.Table (Xold).Source_First; |
| 138 | A.Hi := Source_File.Table (Xold).Source_Last; |
| 139 | |
| 140 | Source_File.Append (Source_File.Table (Xold)); |
| 141 | Xnew := Source_File.Last; |
| 142 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 143 | declare |
| 144 | Sold : Source_File_Record renames Source_File.Table (Xold); |
| 145 | Snew : Source_File_Record renames Source_File.Table (Xnew); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 146 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 147 | Inst_Spec : Node_Id; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 148 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 149 | begin |
| 150 | Snew.Inlined_Body := Inlined_Body; |
| 151 | Snew.Template := Xold; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 152 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 153 | -- For a genuine generic instantiation, assign new instance id. |
| 154 | -- For inlined bodies, we retain that of the template, but we |
| 155 | -- save the call location. |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 156 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 157 | if Inlined_Body then |
| 158 | Snew.Inlined_Call := Sloc (Inst_Node); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 159 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 160 | else |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 161 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 162 | -- If the spec has been instantiated already, and we are now |
| 163 | -- creating the instance source for the corresponding body now, |
| 164 | -- retrieve the instance id that was assigned to the spec, which |
| 165 | -- corresponds to the same instantiation sloc. |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 166 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 167 | Inst_Spec := Instance_Spec (Inst_Node); |
| 168 | if Present (Inst_Spec) then |
| 169 | declare |
| 170 | Inst_Spec_Ent : Entity_Id; |
| 171 | -- Instance spec entity |
| 172 | |
| 173 | Inst_Spec_Sloc : Source_Ptr; |
| 174 | -- Virtual sloc of the spec instance source |
| 175 | |
| 176 | Inst_Spec_Inst_Id : Instance_Id; |
| 177 | -- Instance id assigned to the instance spec |
| 178 | |
| 179 | begin |
| 180 | Inst_Spec_Ent := Defining_Entity (Inst_Spec); |
| 181 | |
| 182 | -- For a subprogram instantiation, we want the subprogram |
| 183 | -- instance, not the wrapper package. |
| 184 | |
| 185 | if Present (Related_Instance (Inst_Spec_Ent)) then |
| 186 | Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent); |
| 187 | end if; |
| 188 | |
| 189 | -- The specification of the instance entity has a virtual |
| 190 | -- sloc within the instance sloc range. |
| 191 | -- ??? But the Unit_Declaration_Node has the sloc of the |
| 192 | -- instantiation, which is somewhat of an oddity. |
| 193 | |
| 194 | Inst_Spec_Sloc := |
| 195 | Sloc (Specification (Unit_Declaration_Node |
| 196 | (Inst_Spec_Ent))); |
| 197 | Inst_Spec_Inst_Id := |
| 198 | Source_File.Table |
| 199 | (Get_Source_File_Index (Inst_Spec_Sloc)).Instance; |
| 200 | |
| 201 | pragma Assert |
| 202 | (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id)); |
| 203 | Snew.Instance := Inst_Spec_Inst_Id; |
| 204 | end; |
| 205 | |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 206 | else |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 207 | Instances.Append (Sloc (Inst_Node)); |
| 208 | Snew.Instance := Instances.Last; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 209 | end if; |
| 210 | end if; |
| 211 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 212 | -- Now we need to compute the new values of Source_First, |
| 213 | -- Source_Last and adjust the source file pointer to have the |
| 214 | -- correct virtual origin for the new range of values. |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 215 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 216 | Snew.Source_First := Source_File.Table (Xnew - 1).Source_Last + 1; |
| 217 | A.Adjust := Snew.Source_First - A.Lo; |
| 218 | Snew.Source_Last := A.Hi + A.Adjust; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 219 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 220 | Set_Source_File_Index_Table (Xnew); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 221 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 222 | Snew.Sloc_Adjust := Sold.Sloc_Adjust - A.Adjust; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 223 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 224 | if Debug_Flag_L then |
| 225 | Write_Eol; |
| 226 | Write_Str ("*** Create instantiation source for "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 227 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 228 | if Nkind (Dnod) in N_Proper_Body |
| 229 | and then Was_Originally_Stub (Dnod) |
| 230 | then |
| 231 | Write_Str ("subunit "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 232 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 233 | elsif Ekind (Template_Id) = E_Generic_Package then |
| 234 | if Nkind (Dnod) = N_Package_Body then |
| 235 | Write_Str ("body of package "); |
| 236 | else |
| 237 | Write_Str ("spec of package "); |
| 238 | end if; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 239 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 240 | elsif Ekind (Template_Id) = E_Function then |
| 241 | Write_Str ("body of function "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 242 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 243 | elsif Ekind (Template_Id) = E_Procedure then |
| 244 | Write_Str ("body of procedure "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 245 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 246 | elsif Ekind (Template_Id) = E_Generic_Function then |
| 247 | Write_Str ("spec of function "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 248 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 249 | elsif Ekind (Template_Id) = E_Generic_Procedure then |
| 250 | Write_Str ("spec of procedure "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 251 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 252 | elsif Ekind (Template_Id) = E_Package_Body then |
| 253 | Write_Str ("body of package "); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 254 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 255 | else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body); |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 256 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 257 | if Nkind (Dnod) = N_Procedure_Specification then |
| 258 | Write_Str ("body of procedure "); |
| 259 | else |
| 260 | Write_Str ("body of function "); |
| 261 | end if; |
| 262 | end if; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 263 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 264 | Write_Name (Chars (Template_Id)); |
| 265 | Write_Eol; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 266 | |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 267 | Write_Str (" new source index = "); |
| 268 | Write_Int (Int (Xnew)); |
| 269 | Write_Eol; |
| 270 | |
| 271 | Write_Str (" copying from file name = "); |
| 272 | Write_Name (File_Name (Xold)); |
| 273 | Write_Eol; |
| 274 | |
| 275 | Write_Str (" old source index = "); |
| 276 | Write_Int (Int (Xold)); |
| 277 | Write_Eol; |
| 278 | |
| 279 | Write_Str (" old lo = "); |
| 280 | Write_Int (Int (A.Lo)); |
| 281 | Write_Eol; |
| 282 | |
| 283 | Write_Str (" old hi = "); |
| 284 | Write_Int (Int (A.Hi)); |
| 285 | Write_Eol; |
| 286 | |
| 287 | Write_Str (" new lo = "); |
| 288 | Write_Int (Int (Snew.Source_First)); |
| 289 | Write_Eol; |
| 290 | |
| 291 | Write_Str (" new hi = "); |
| 292 | Write_Int (Int (Snew.Source_Last)); |
| 293 | Write_Eol; |
| 294 | |
| 295 | Write_Str (" adjustment factor = "); |
| 296 | Write_Int (Int (A.Adjust)); |
| 297 | Write_Eol; |
| 298 | |
| 299 | Write_Str (" instantiation location: "); |
| 300 | Write_Location (Sloc (Inst_Node)); |
| 301 | Write_Eol; |
| 302 | end if; |
| 303 | |
| 304 | -- For a given character in the source, a higher subscript will be |
| 305 | -- used to access the instantiation, which means that the virtual |
| 306 | -- origin must have a corresponding lower value. We compute this new |
| 307 | -- origin by taking the address of the appropriate adjusted element |
| 308 | -- in the old array. Since this adjusted element will be at a |
| 309 | -- negative subscript, we must suppress checks. |
| 310 | |
| 311 | declare |
| 312 | pragma Suppress (All_Checks); |
| 313 | |
| 314 | pragma Warnings (Off); |
| 315 | -- This unchecked conversion is aliasing safe, since it is never |
| 316 | -- used to create improperly aliased pointer values. |
| 317 | |
| 318 | function To_Source_Buffer_Ptr is new |
| 319 | Unchecked_Conversion (Address, Source_Buffer_Ptr); |
| 320 | |
| 321 | pragma Warnings (On); |
| 322 | |
| 323 | begin |
| 324 | Snew.Source_Text := |
| 325 | To_Source_Buffer_Ptr |
| 326 | (Sold.Source_Text (-A.Adjust)'Address); |
| 327 | end; |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 328 | end; |
| 329 | end Create_Instantiation_Source; |
| 330 | |
| 331 | ---------------------- |
| 332 | -- Load_Config_File -- |
| 333 | ---------------------- |
| 334 | |
| 335 | function Load_Config_File |
| 336 | (N : File_Name_Type) return Source_File_Index |
| 337 | is |
| 338 | begin |
| 339 | return Load_File (N, Osint.Config); |
| 340 | end Load_Config_File; |
| 341 | |
| 342 | -------------------------- |
| 343 | -- Load_Definition_File -- |
| 344 | -------------------------- |
| 345 | |
| 346 | function Load_Definition_File |
| 347 | (N : File_Name_Type) return Source_File_Index |
| 348 | is |
| 349 | begin |
| 350 | return Load_File (N, Osint.Definition); |
| 351 | end Load_Definition_File; |
| 352 | |
| 353 | --------------- |
| 354 | -- Load_File -- |
| 355 | --------------- |
| 356 | |
| 357 | function Load_File |
| 358 | (N : File_Name_Type; |
| 359 | T : Osint.File_Type) return Source_File_Index |
| 360 | is |
| 361 | Src : Source_Buffer_Ptr; |
| 362 | X : Source_File_Index; |
| 363 | Lo : Source_Ptr; |
| 364 | Hi : Source_Ptr; |
| 365 | |
| 366 | Preprocessing_Needed : Boolean := False; |
| 367 | |
| 368 | begin |
| 369 | -- If already there, don't need to reload file. An exception occurs |
| 370 | -- in multiple unit per file mode. It would be nice in this case to |
| 371 | -- share the same source file for each unit, but this leads to many |
| 372 | -- difficulties with assumptions (e.g. in the body of lib), that a |
| 373 | -- unit can be found by locating its source file index. Since we do |
| 374 | -- not expect much use of this mode, it's no big deal to waste a bit |
| 375 | -- of space and time by reading and storing the source multiple times. |
| 376 | |
| 377 | if Multiple_Unit_Index = 0 then |
| 378 | for J in 1 .. Source_File.Last loop |
| 379 | if Source_File.Table (J).File_Name = N then |
| 380 | return J; |
| 381 | end if; |
| 382 | end loop; |
| 383 | end if; |
| 384 | |
| 385 | -- Here we must build a new entry in the file table |
| 386 | |
| 387 | -- But first, we must check if a source needs to be preprocessed, |
| 388 | -- because we may have to load and parse a definition file, and we want |
| 389 | -- to do that before we load the source, so that the buffer of the |
| 390 | -- source will be the last created, and we will be able to replace it |
| 391 | -- and modify Hi without stepping on another buffer. |
| 392 | |
| 393 | if T = Osint.Source and then not Is_Internal_File_Name (N) then |
| 394 | Prepare_To_Preprocess |
| 395 | (Source => N, Preprocessing_Needed => Preprocessing_Needed); |
| 396 | end if; |
| 397 | |
| 398 | Source_File.Increment_Last; |
| 399 | X := Source_File.Last; |
| 400 | |
| 401 | if X = Source_File.First then |
| 402 | Lo := First_Source_Ptr; |
| 403 | else |
| 404 | Lo := Source_File.Table (X - 1).Source_Last + 1; |
| 405 | end if; |
| 406 | |
| 407 | Osint.Read_Source_File (N, Lo, Hi, Src, T); |
| 408 | |
| 409 | if Src = null then |
| 410 | Source_File.Decrement_Last; |
| 411 | return No_Source_File; |
| 412 | |
| 413 | else |
| 414 | if Debug_Flag_L then |
| 415 | Write_Eol; |
| 416 | Write_Str ("*** Build source file table entry, Index = "); |
| 417 | Write_Int (Int (X)); |
| 418 | Write_Str (", file name = "); |
| 419 | Write_Name (N); |
| 420 | Write_Eol; |
| 421 | Write_Str (" lo = "); |
| 422 | Write_Int (Int (Lo)); |
| 423 | Write_Eol; |
| 424 | Write_Str (" hi = "); |
| 425 | Write_Int (Int (Hi)); |
| 426 | Write_Eol; |
| 427 | |
| 428 | Write_Str (" first 10 chars -->"); |
| 429 | |
| 430 | declare |
| 431 | procedure Wchar (C : Character); |
| 432 | -- Writes character or ? for control character |
| 433 | |
| 434 | ----------- |
| 435 | -- Wchar -- |
| 436 | ----------- |
| 437 | |
| 438 | procedure Wchar (C : Character) is |
| 439 | begin |
| 440 | if C < ' ' |
| 441 | or else C in ASCII.DEL .. Character'Val (16#9F#) |
| 442 | then |
| 443 | Write_Char ('?'); |
| 444 | else |
| 445 | Write_Char (C); |
| 446 | end if; |
| 447 | end Wchar; |
| 448 | |
| 449 | begin |
| 450 | for J in Lo .. Lo + 9 loop |
| 451 | Wchar (Src (J)); |
| 452 | end loop; |
| 453 | |
| 454 | Write_Str ("<--"); |
| 455 | Write_Eol; |
| 456 | |
| 457 | Write_Str (" last 10 chars -->"); |
| 458 | |
| 459 | for J in Hi - 10 .. Hi - 1 loop |
| 460 | Wchar (Src (J)); |
| 461 | end loop; |
| 462 | |
| 463 | Write_Str ("<--"); |
| 464 | Write_Eol; |
| 465 | |
| 466 | if Src (Hi) /= EOF then |
| 467 | Write_Str (" error: no EOF at end"); |
| 468 | Write_Eol; |
| 469 | end if; |
| 470 | end; |
| 471 | end if; |
| 472 | |
| 473 | declare |
| 474 | S : Source_File_Record renames Source_File.Table (X); |
| 475 | File_Type : Type_Of_File; |
| 476 | |
| 477 | begin |
| 478 | case T is |
| 479 | when Osint.Source => |
| 480 | File_Type := Sinput.Src; |
| 481 | |
| 482 | when Osint.Library => |
| 483 | raise Program_Error; |
| 484 | |
| 485 | when Osint.Config => |
| 486 | File_Type := Sinput.Config; |
| 487 | |
| 488 | when Osint.Definition => |
| 489 | File_Type := Def; |
| 490 | |
| 491 | when Osint.Preprocessing_Data => |
| 492 | File_Type := Preproc; |
| 493 | end case; |
| 494 | |
| 495 | S := (Debug_Source_Name => N, |
| 496 | File_Name => N, |
| 497 | File_Type => File_Type, |
| 498 | First_Mapped_Line => No_Line_Number, |
| 499 | Full_Debug_Name => Osint.Full_Source_Name, |
| 500 | Full_File_Name => Osint.Full_Source_Name, |
| 501 | Full_Ref_Name => Osint.Full_Source_Name, |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 502 | Instance => No_Instance_Id, |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 503 | Identifier_Casing => Unknown, |
Bernhard Rosenkraenzer | ee2ec6d | 2012-10-10 01:40:27 +0159 | [diff] [blame^] | 504 | Inlined_Call => No_Location, |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 505 | Inlined_Body => False, |
Bernhard Rosenkraenzer | c83ebe5 | 2012-09-18 21:38:03 +0159 | [diff] [blame] | 506 | Keyword_Casing => Unknown, |
| 507 | Last_Source_Line => 1, |
| 508 | License => Unknown, |
| 509 | Lines_Table => null, |
| 510 | Lines_Table_Max => 1, |
| 511 | Logical_Lines_Table => null, |
| 512 | Num_SRef_Pragmas => 0, |
| 513 | Reference_Name => N, |
| 514 | Sloc_Adjust => 0, |
| 515 | Source_Checksum => 0, |
| 516 | Source_First => Lo, |
| 517 | Source_Last => Hi, |
| 518 | Source_Text => Src, |
| 519 | Template => No_Source_File, |
| 520 | Unit => No_Unit, |
| 521 | Time_Stamp => Osint.Current_Source_File_Stamp); |
| 522 | |
| 523 | Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial); |
| 524 | S.Lines_Table (1) := Lo; |
| 525 | end; |
| 526 | |
| 527 | -- Preprocess the source if it needs to be preprocessed |
| 528 | |
| 529 | if Preprocessing_Needed then |
| 530 | |
| 531 | -- Temporarily set the Source_File_Index_Table entries for the |
| 532 | -- source, to avoid crash when reporting an error. |
| 533 | |
| 534 | Set_Source_File_Index_Table (X); |
| 535 | |
| 536 | if Opt.List_Preprocessing_Symbols then |
| 537 | Get_Name_String (N); |
| 538 | |
| 539 | declare |
| 540 | Foreword : String (1 .. Foreword_Start'Length + |
| 541 | Name_Len + Foreword_End'Length); |
| 542 | |
| 543 | begin |
| 544 | Foreword (1 .. Foreword_Start'Length) := Foreword_Start; |
| 545 | Foreword (Foreword_Start'Length + 1 .. |
| 546 | Foreword_Start'Length + Name_Len) := |
| 547 | Name_Buffer (1 .. Name_Len); |
| 548 | Foreword (Foreword'Last - Foreword_End'Length + 1 .. |
| 549 | Foreword'Last) := Foreword_End; |
| 550 | Prep.List_Symbols (Foreword); |
| 551 | end; |
| 552 | end if; |
| 553 | |
| 554 | declare |
| 555 | T : constant Nat := Total_Errors_Detected; |
| 556 | -- Used to check if there were errors during preprocessing |
| 557 | |
| 558 | Save_Style_Check : Boolean; |
| 559 | -- Saved state of the Style_Check flag (which needs to be |
| 560 | -- temporarily set to False during preprocessing, see below). |
| 561 | |
| 562 | Modified : Boolean; |
| 563 | |
| 564 | begin |
| 565 | -- If this is the first time we preprocess a source, allocate |
| 566 | -- the preprocessing buffer. |
| 567 | |
| 568 | if Prep_Buffer = null then |
| 569 | Prep_Buffer := |
| 570 | new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer); |
| 571 | end if; |
| 572 | |
| 573 | -- Make sure the preprocessing buffer is empty |
| 574 | |
| 575 | Prep_Buffer_Last := 0; |
| 576 | |
| 577 | -- Initialize the preprocessor hooks |
| 578 | |
| 579 | Prep.Setup_Hooks |
| 580 | (Error_Msg => Errout.Error_Msg'Access, |
| 581 | Scan => Scn.Scanner.Scan'Access, |
| 582 | Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access, |
| 583 | Put_Char => Put_Char_In_Prep_Buffer'Access, |
| 584 | New_EOL => New_EOL_In_Prep_Buffer'Access); |
| 585 | |
| 586 | -- Initialize scanner and set its behavior for preprocessing, |
| 587 | -- then preprocess. Also disable style checks, since some of |
| 588 | -- them are done in the scanner (specifically, those dealing |
| 589 | -- with line length and line termination), and cannot be done |
| 590 | -- during preprocessing (because the source file index table |
| 591 | -- has not been set yet). |
| 592 | |
| 593 | Scn.Scanner.Initialize_Scanner (X); |
| 594 | |
| 595 | Scn.Scanner.Set_Special_Character ('#'); |
| 596 | Scn.Scanner.Set_Special_Character ('$'); |
| 597 | Scn.Scanner.Set_End_Of_Line_As_Token (True); |
| 598 | Save_Style_Check := Opt.Style_Check; |
| 599 | Opt.Style_Check := False; |
| 600 | |
| 601 | -- The actual preprocessing step |
| 602 | |
| 603 | Preprocess (Modified); |
| 604 | |
| 605 | -- Reset the scanner to its standard behavior, and restore the |
| 606 | -- Style_Checks flag. |
| 607 | |
| 608 | Scn.Scanner.Reset_Special_Characters; |
| 609 | Scn.Scanner.Set_End_Of_Line_As_Token (False); |
| 610 | Opt.Style_Check := Save_Style_Check; |
| 611 | |
| 612 | -- If there were errors during preprocessing, record an error |
| 613 | -- at the start of the file, and do not change the source |
| 614 | -- buffer. |
| 615 | |
| 616 | if T /= Total_Errors_Detected then |
| 617 | Errout.Error_Msg |
| 618 | ("file could not be successfully preprocessed", Lo); |
| 619 | return No_Source_File; |
| 620 | |
| 621 | else |
| 622 | -- Output the result of the preprocessing, if requested and |
| 623 | -- the source has been modified by the preprocessing. Only |
| 624 | -- do that for the main unit (spec, body and subunits). |
| 625 | |
| 626 | if Generate_Processed_File |
| 627 | and then Modified |
| 628 | and then |
| 629 | ((Compiler_State = Parsing |
| 630 | and then Parsing_Main_Extended_Source) |
| 631 | or else |
| 632 | (Compiler_State = Analyzing |
| 633 | and then Analysing_Subunit_Of_Main)) |
| 634 | then |
| 635 | declare |
| 636 | FD : File_Descriptor; |
| 637 | NB : Integer; |
| 638 | Status : Boolean; |
| 639 | |
| 640 | begin |
| 641 | Get_Name_String (N); |
| 642 | |
| 643 | if Hostparm.OpenVMS then |
| 644 | Add_Str_To_Name_Buffer ("_prep"); |
| 645 | else |
| 646 | Add_Str_To_Name_Buffer (".prep"); |
| 647 | end if; |
| 648 | |
| 649 | Delete_File (Name_Buffer (1 .. Name_Len), Status); |
| 650 | |
| 651 | FD := |
| 652 | Create_New_File (Name_Buffer (1 .. Name_Len), Text); |
| 653 | |
| 654 | Status := FD /= Invalid_FD; |
| 655 | |
| 656 | if Status then |
| 657 | NB := |
| 658 | Write |
| 659 | (FD, |
| 660 | Prep_Buffer (1)'Address, |
| 661 | Integer (Prep_Buffer_Last)); |
| 662 | Status := NB = Integer (Prep_Buffer_Last); |
| 663 | end if; |
| 664 | |
| 665 | if Status then |
| 666 | Close (FD, Status); |
| 667 | end if; |
| 668 | |
| 669 | if not Status then |
| 670 | Errout.Error_Msg |
| 671 | ("?could not write processed file """ & |
| 672 | Name_Buffer (1 .. Name_Len) & '"', |
| 673 | Lo); |
| 674 | end if; |
| 675 | end; |
| 676 | end if; |
| 677 | |
| 678 | -- Set the new value of Hi |
| 679 | |
| 680 | Hi := Lo + Source_Ptr (Prep_Buffer_Last); |
| 681 | |
| 682 | -- Create the new source buffer |
| 683 | |
| 684 | declare |
| 685 | subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi); |
| 686 | -- Physical buffer allocated |
| 687 | |
| 688 | type Actual_Source_Ptr is access Actual_Source_Buffer; |
| 689 | -- Pointer type for the physical buffer allocated |
| 690 | |
| 691 | Actual_Ptr : constant Actual_Source_Ptr := |
| 692 | new Actual_Source_Buffer; |
| 693 | -- Actual physical buffer |
| 694 | |
| 695 | begin |
| 696 | Actual_Ptr (Lo .. Hi - 1) := |
| 697 | Prep_Buffer (1 .. Prep_Buffer_Last); |
| 698 | Actual_Ptr (Hi) := EOF; |
| 699 | |
| 700 | -- Now we need to work out the proper virtual origin |
| 701 | -- pointer to return. This is Actual_Ptr (0)'Address, but |
| 702 | -- we have to be careful to suppress checks to compute |
| 703 | -- this address. |
| 704 | |
| 705 | declare |
| 706 | pragma Suppress (All_Checks); |
| 707 | |
| 708 | pragma Warnings (Off); |
| 709 | -- This unchecked conversion is aliasing safe, since |
| 710 | -- it is never used to create improperly aliased |
| 711 | -- pointer values. |
| 712 | |
| 713 | function To_Source_Buffer_Ptr is new |
| 714 | Unchecked_Conversion (Address, Source_Buffer_Ptr); |
| 715 | |
| 716 | pragma Warnings (On); |
| 717 | |
| 718 | begin |
| 719 | Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address); |
| 720 | |
| 721 | -- Record in the table the new source buffer and the |
| 722 | -- new value of Hi. |
| 723 | |
| 724 | Source_File.Table (X).Source_Text := Src; |
| 725 | Source_File.Table (X).Source_Last := Hi; |
| 726 | |
| 727 | -- Reset Last_Line to 1, because the lines do not |
| 728 | -- have necessarily the same starts and lengths. |
| 729 | |
| 730 | Source_File.Table (X).Last_Source_Line := 1; |
| 731 | end; |
| 732 | end; |
| 733 | end if; |
| 734 | end; |
| 735 | end if; |
| 736 | |
| 737 | Set_Source_File_Index_Table (X); |
| 738 | return X; |
| 739 | end if; |
| 740 | end Load_File; |
| 741 | |
| 742 | ---------------------------------- |
| 743 | -- Load_Preprocessing_Data_File -- |
| 744 | ---------------------------------- |
| 745 | |
| 746 | function Load_Preprocessing_Data_File |
| 747 | (N : File_Name_Type) return Source_File_Index |
| 748 | is |
| 749 | begin |
| 750 | return Load_File (N, Osint.Preprocessing_Data); |
| 751 | end Load_Preprocessing_Data_File; |
| 752 | |
| 753 | ---------------------- |
| 754 | -- Load_Source_File -- |
| 755 | ---------------------- |
| 756 | |
| 757 | function Load_Source_File |
| 758 | (N : File_Name_Type) return Source_File_Index |
| 759 | is |
| 760 | begin |
| 761 | return Load_File (N, Osint.Source); |
| 762 | end Load_Source_File; |
| 763 | |
| 764 | ---------------------------- |
| 765 | -- New_EOL_In_Prep_Buffer -- |
| 766 | ---------------------------- |
| 767 | |
| 768 | procedure New_EOL_In_Prep_Buffer is |
| 769 | begin |
| 770 | Put_Char_In_Prep_Buffer (ASCII.LF); |
| 771 | end New_EOL_In_Prep_Buffer; |
| 772 | |
| 773 | ----------------------------- |
| 774 | -- Put_Char_In_Prep_Buffer -- |
| 775 | ----------------------------- |
| 776 | |
| 777 | procedure Put_Char_In_Prep_Buffer (C : Character) is |
| 778 | begin |
| 779 | -- If preprocessing buffer is not large enough, double it |
| 780 | |
| 781 | if Prep_Buffer_Last = Prep_Buffer'Last then |
| 782 | declare |
| 783 | New_Prep_Buffer : constant Text_Buffer_Ptr := |
| 784 | new Text_Buffer (1 .. 2 * Prep_Buffer_Last); |
| 785 | |
| 786 | begin |
| 787 | New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all; |
| 788 | Free (Prep_Buffer); |
| 789 | Prep_Buffer := New_Prep_Buffer; |
| 790 | end; |
| 791 | end if; |
| 792 | |
| 793 | Prep_Buffer_Last := Prep_Buffer_Last + 1; |
| 794 | Prep_Buffer (Prep_Buffer_Last) := C; |
| 795 | end Put_Char_In_Prep_Buffer; |
| 796 | |
| 797 | ----------------------------------- |
| 798 | -- Source_File_Is_Pragma_No_Body -- |
| 799 | ----------------------------------- |
| 800 | |
| 801 | function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is |
| 802 | begin |
| 803 | Initialize_Scanner (No_Unit, X); |
| 804 | |
| 805 | if Token /= Tok_Pragma then |
| 806 | return False; |
| 807 | end if; |
| 808 | |
| 809 | Scan; -- past pragma |
| 810 | |
| 811 | if Token /= Tok_Identifier |
| 812 | or else Chars (Token_Node) /= Name_No_Body |
| 813 | then |
| 814 | return False; |
| 815 | end if; |
| 816 | |
| 817 | Scan; -- past No_Body |
| 818 | |
| 819 | if Token /= Tok_Semicolon then |
| 820 | return False; |
| 821 | end if; |
| 822 | |
| 823 | Scan; -- past semicolon |
| 824 | |
| 825 | return Token = Tok_EOF; |
| 826 | end Source_File_Is_No_Body; |
| 827 | |
| 828 | ---------------------------- |
| 829 | -- Source_File_Is_Subunit -- |
| 830 | ---------------------------- |
| 831 | |
| 832 | function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is |
| 833 | begin |
| 834 | Initialize_Scanner (No_Unit, X); |
| 835 | |
| 836 | -- We scan past junk to the first interesting compilation unit token, to |
| 837 | -- see if it is SEPARATE. We ignore WITH keywords during this and also |
| 838 | -- PRIVATE. The reason for ignoring PRIVATE is that it handles some |
| 839 | -- error situations, and also to handle PRIVATE WITH in Ada 2005 mode. |
| 840 | |
| 841 | while Token = Tok_With |
| 842 | or else Token = Tok_Private |
| 843 | or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF) |
| 844 | loop |
| 845 | Scan; |
| 846 | end loop; |
| 847 | |
| 848 | return Token = Tok_Separate; |
| 849 | end Source_File_Is_Subunit; |
| 850 | |
| 851 | end Sinput.L; |