1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2007, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
29 with Tree_IO; use Tree_IO;
31 package body Osint.C is
33 Output_Object_File_Name : String_Ptr;
34 -- Argument of -o compiler option, if given. This is needed to verify
35 -- consistency with the ALI file name.
37 procedure Adjust_OS_Resource_Limits;
38 pragma Import (C, Adjust_OS_Resource_Limits,
39 "__gnat_adjust_os_resource_limits");
40 -- Procedure to make system specific adjustments to make GNAT run better
42 function Create_Auxiliary_File
43 (Src : File_Name_Type;
44 Suffix : String) return File_Name_Type;
45 -- Common processing for Create_List_File, Create_Repinfo_File and
46 -- Create_Debug_File. Src is the file name used to create the required
47 -- output file and Suffix is the desired suffic (dg/rep/xxx for debug/
48 -- repinfo/list file where xxx is specified extension.
50 procedure Set_Library_Info_Name;
51 -- Sets a default ALI file name from the main compiler source name.
52 -- This is used by Create_Output_Library_Info, and by the version of
53 -- Read_Library_Info that takes a default file name. The name is in
54 -- Name_Buffer (with length in Name_Len) on return from the call.
56 ----------------------
57 -- Close_Debug_File --
58 ----------------------
60 procedure Close_Debug_File is
64 Close (Output_FD, Status);
68 ("error while closing expanded source file ",
69 Get_Name_String (Output_File_Name));
77 procedure Close_List_File is
81 Close (Output_FD, Status);
85 ("error while closing list file ",
86 Get_Name_String (Output_File_Name));
90 -------------------------------
91 -- Close_Output_Library_Info --
92 -------------------------------
94 procedure Close_Output_Library_Info is
98 Close (Output_FD, Status);
102 ("error while closing ALI file ",
103 Get_Name_String (Output_File_Name));
105 end Close_Output_Library_Info;
107 ------------------------
108 -- Close_Repinfo_File --
109 ------------------------
111 procedure Close_Repinfo_File is
115 Close (Output_FD, Status);
119 ("error while closing representation info file ",
120 Get_Name_String (Output_File_Name));
122 end Close_Repinfo_File;
124 ---------------------------
125 -- Create_Auxiliary_File --
126 ---------------------------
128 function Create_Auxiliary_File
129 (Src : File_Name_Type;
130 Suffix : String) return File_Name_Type
132 Result : File_Name_Type;
135 Get_Name_String (Src);
137 if Hostparm.OpenVMS then
138 Name_Buffer (Name_Len + 1) := '_';
140 Name_Buffer (Name_Len + 1) := '.';
143 Name_Len := Name_Len + 1;
144 Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
145 Name_Len := Name_Len + Suffix'Length;
147 if Output_Object_File_Name /= null then
148 for Index in reverse Output_Object_File_Name'Range loop
149 if Output_Object_File_Name (Index) = Directory_Separator then
151 File_Name : constant String := Name_Buffer (1 .. Name_Len);
153 Name_Len := Index - Output_Object_File_Name'First + 1;
154 Name_Buffer (1 .. Name_Len) :=
155 Output_Object_File_Name
156 (Output_Object_File_Name'First .. Index);
157 Name_Buffer (Name_Len + 1 .. Name_Len + File_Name'Length) :=
159 Name_Len := Name_Len + File_Name'Length;
168 Name_Buffer (Name_Len + 1) := ASCII.NUL;
169 Create_File_And_Check (Output_FD, Text);
171 end Create_Auxiliary_File;
173 -----------------------
174 -- Create_Debug_File --
175 -----------------------
177 function Create_Debug_File (Src : File_Name_Type) return File_Name_Type is
179 return Create_Auxiliary_File (Src, "dg");
180 end Create_Debug_File;
182 ----------------------
183 -- Create_List_File --
184 ----------------------
186 procedure Create_List_File (S : String) is
188 pragma Warnings (Off, F);
190 if S (S'First) = '.' then
191 F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
194 Name_Buffer (1 .. S'Length) := S;
195 Name_Len := S'Length + 1;
196 Name_Buffer (Name_Len) := ASCII.NUL;
197 Create_File_And_Check (Output_FD, Text);
199 end Create_List_File;
201 --------------------------------
202 -- Create_Output_Library_Info --
203 --------------------------------
205 procedure Create_Output_Library_Info is
207 Set_Library_Info_Name;
208 Create_File_And_Check (Output_FD, Text);
209 end Create_Output_Library_Info;
211 -------------------------
212 -- Create_Repinfo_File --
213 -------------------------
215 procedure Create_Repinfo_File (Src : String) is
216 Discard : File_Name_Type;
217 pragma Warnings (Off, Discard);
219 Name_Buffer (1 .. Src'Length) := Src;
220 Name_Len := Src'Length;
221 Discard := Create_Auxiliary_File (Name_Find, "rep");
223 end Create_Repinfo_File;
225 ---------------------------
226 -- Debug_File_Eol_Length --
227 ---------------------------
229 function Debug_File_Eol_Length return Nat is
231 -- There has to be a cleaner way to do this! ???
233 if Directory_Separator = '/' then
238 end Debug_File_Eol_Length;
240 -----------------------
241 -- More_Source_Files --
242 -----------------------
244 function More_Source_Files return Boolean renames More_Files;
246 ----------------------
247 -- Next_Main_Source --
248 ----------------------
250 function Next_Main_Source return File_Name_Type renames Next_Main_File;
252 -----------------------
253 -- Read_Library_Info --
254 -----------------------
256 -- Version with default file name
258 procedure Read_Library_Info
259 (Name : out File_Name_Type;
260 Text : out Text_Buffer_Ptr)
263 Set_Library_Info_Name;
265 Text := Read_Library_Info (Name, Fatal_Err => False);
266 end Read_Library_Info;
268 ---------------------------
269 -- Set_Library_Info_Name --
270 ---------------------------
272 procedure Set_Library_Info_Name is
276 Get_Name_String (Current_Main);
278 -- Find last dot since we replace the existing extension by .ali. The
279 -- initialization to Name_Len + 1 provides for simply adding the .ali
280 -- extension if the source file name has no extension.
282 Dot_Index := Name_Len + 1;
284 for J in reverse 1 .. Name_Len loop
285 if Name_Buffer (J) = '.' then
291 -- Make sure that the output file name matches the source file name.
292 -- To compare them, remove file name directories and extensions.
294 if Output_Object_File_Name /= null then
296 -- Make sure there is a dot at Dot_Index. This may not be the case
297 -- if the source file name has no extension.
299 Name_Buffer (Dot_Index) := '.';
301 -- If we are in multiple unit per file mode, then add ~nnn
302 -- extension to the name before doing the comparison.
304 if Multiple_Unit_Index /= 0 then
306 Exten : constant String := Name_Buffer (Dot_Index .. Name_Len);
308 Name_Len := Dot_Index - 1;
309 Add_Char_To_Name_Buffer (Multi_Unit_Index_Character);
310 Add_Nat_To_Name_Buffer (Multiple_Unit_Index);
311 Dot_Index := Name_Len + 1;
312 Add_Str_To_Name_Buffer (Exten);
316 -- Remove extension preparing to replace it
319 Name : constant String := Name_Buffer (1 .. Dot_Index);
323 Name_Buffer (1 .. Output_Object_File_Name'Length) :=
324 Output_Object_File_Name.all;
327 for J in reverse Output_Object_File_Name'Range loop
328 if Name_Buffer (J) = '.' then
334 -- Dot_Index should not be zero now (we check for extension
337 pragma Assert (Dot_Index /= 0);
339 -- Look for first character of file name
343 and then Name_Buffer (First - 1) /= Directory_Separator
344 and then Name_Buffer (First - 1) /= '/'
349 -- Check name of object file is what we expect
351 if Name /= Name_Buffer (First .. Dot_Index) then
352 Fail ("incorrect object file name");
357 Name_Buffer (Dot_Index) := '.';
358 Name_Buffer (Dot_Index + 1 .. Dot_Index + 3) := ALI_Suffix.all;
359 Name_Buffer (Dot_Index + 4) := ASCII.NUL;
360 Name_Len := Dot_Index + 3;
361 end Set_Library_Info_Name;
363 ---------------------------------
364 -- Set_Output_Object_File_Name --
365 ---------------------------------
367 procedure Set_Output_Object_File_Name (Name : String) is
368 Ext : constant String := Target_Object_Suffix;
369 NL : constant Natural := Name'Length;
370 EL : constant Natural := Ext'Length;
373 -- Make sure that the object file has the expected extension
377 (Name (NL - EL + Name'First .. Name'Last) /= Ext
378 and then Name (NL - 2 + Name'First .. Name'Last) /= ".o")
380 Fail ("incorrect object file extension");
383 Output_Object_File_Name := new String'(Name);
384 end Set_Output_Object_File_Name;
390 procedure Tree_Close is
393 Tree_Write_Terminate;
394 Close (Output_FD, Status);
398 ("error while closing tree file ",
399 Get_Name_String (Output_File_Name));
407 procedure Tree_Create is
411 Get_Name_String (Current_Main);
413 -- If an object file has been specified, then the ALI file
414 -- will be in the same directory as the object file;
415 -- so, we put the tree file in this same directory,
416 -- even though no object file needs to be generated.
418 if Output_Object_File_Name /= null then
419 Name_Len := Output_Object_File_Name'Length;
420 Name_Buffer (1 .. Name_Len) := Output_Object_File_Name.all;
423 Dot_Index := Name_Len + 1;
425 for J in reverse 1 .. Name_Len loop
426 if Name_Buffer (J) = '.' then
432 -- Should be impossible to not have an extension
434 pragma Assert (Dot_Index /= 0);
436 -- Change exctension to adt
438 Name_Buffer (Dot_Index) := '.';
439 Name_Buffer (Dot_Index + 1) := 'a';
440 Name_Buffer (Dot_Index + 2) := 'd';
441 Name_Buffer (Dot_Index + 3) := 't';
442 Name_Buffer (Dot_Index + 4) := ASCII.NUL;
443 Name_Len := Dot_Index + 3;
444 Create_File_And_Check (Output_FD, Binary);
446 Tree_Write_Initialize (Output_FD);
449 -----------------------
450 -- Write_Debug_Info --
451 -----------------------
453 procedure Write_Debug_Info (Info : String) renames Write_Info;
455 ------------------------
456 -- Write_Library_Info --
457 ------------------------
459 procedure Write_Library_Info (Info : String) renames Write_Info;
461 ---------------------
462 -- Write_List_Info --
463 ---------------------
465 procedure Write_List_Info (S : String) is
467 Write_With_Check (S'Address, S'Length);
470 ------------------------
471 -- Write_Repinfo_Line --
472 ------------------------
474 procedure Write_Repinfo_Line (Info : String) renames Write_Info;
477 Adjust_OS_Resource_Limits;
479 Opt.Create_Repinfo_File_Access := Create_Repinfo_File'Access;
480 Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access;
481 Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access;
483 Opt.Create_List_File_Access := Create_List_File'Access;
484 Opt.Write_List_Info_Access := Write_List_Info'Access;
485 Opt.Close_List_File_Access := Close_List_File'Access;
487 Set_Program (Compiler);