annotate gcc/ada/osint-c.adb @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 1830386684a0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT COMPILER COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- O S I N T - C --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
9 -- Copyright (C) 2001-2019, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
kono
parents:
diff changeset
17 -- for more details. You should have received a copy of the GNU General --
kono
parents:
diff changeset
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
kono
parents:
diff changeset
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
kono
parents:
diff changeset
20 -- --
kono
parents:
diff changeset
21 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
23 -- --
kono
parents:
diff changeset
24 ------------------------------------------------------------------------------
kono
parents:
diff changeset
25
kono
parents:
diff changeset
26 with Opt; use Opt;
kono
parents:
diff changeset
27 with Tree_IO; use Tree_IO;
kono
parents:
diff changeset
28
kono
parents:
diff changeset
29 package body Osint.C is
kono
parents:
diff changeset
30
kono
parents:
diff changeset
31 Output_Object_File_Name : String_Ptr;
kono
parents:
diff changeset
32 -- Argument of -o compiler option, if given. This is needed to verify
kono
parents:
diff changeset
33 -- consistency with the ALI file name.
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 procedure Adjust_OS_Resource_Limits;
kono
parents:
diff changeset
36 pragma Import (C, Adjust_OS_Resource_Limits,
kono
parents:
diff changeset
37 "__gnat_adjust_os_resource_limits");
kono
parents:
diff changeset
38 -- Procedure to make system specific adjustments to make GNAT run better
kono
parents:
diff changeset
39
kono
parents:
diff changeset
40 function Create_Auxiliary_File
kono
parents:
diff changeset
41 (Src : File_Name_Type;
kono
parents:
diff changeset
42 Suffix : String) return File_Name_Type;
kono
parents:
diff changeset
43 -- Common processing for Create_List_File, Create_Repinfo_File and
kono
parents:
diff changeset
44 -- Create_Debug_File. Src is the file name used to create the required
kono
parents:
diff changeset
45 -- output file and Suffix is the desired suffix (dg/rep/xxx for debug/
kono
parents:
diff changeset
46 -- repinfo/list file where xxx is specified extension.
kono
parents:
diff changeset
47
kono
parents:
diff changeset
48 ------------------
kono
parents:
diff changeset
49 -- Close_C_File --
kono
parents:
diff changeset
50 ------------------
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 procedure Close_C_File is
kono
parents:
diff changeset
53 Status : Boolean;
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55 begin
kono
parents:
diff changeset
56 Close (Output_FD, Status);
kono
parents:
diff changeset
57
kono
parents:
diff changeset
58 if not Status then
kono
parents:
diff changeset
59 Fail
kono
parents:
diff changeset
60 ("error while closing file "
kono
parents:
diff changeset
61 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
62 end if;
kono
parents:
diff changeset
63 end Close_C_File;
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 ----------------------
kono
parents:
diff changeset
66 -- Close_Debug_File --
kono
parents:
diff changeset
67 ----------------------
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 procedure Close_Debug_File is
kono
parents:
diff changeset
70 Status : Boolean;
kono
parents:
diff changeset
71
kono
parents:
diff changeset
72 begin
kono
parents:
diff changeset
73 Close (Output_FD, Status);
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 if not Status then
kono
parents:
diff changeset
76 Fail
kono
parents:
diff changeset
77 ("error while closing expanded source file "
kono
parents:
diff changeset
78 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
79 end if;
kono
parents:
diff changeset
80 end Close_Debug_File;
kono
parents:
diff changeset
81
kono
parents:
diff changeset
82 ------------------
kono
parents:
diff changeset
83 -- Close_H_File --
kono
parents:
diff changeset
84 ------------------
kono
parents:
diff changeset
85
kono
parents:
diff changeset
86 procedure Close_H_File is
kono
parents:
diff changeset
87 Status : Boolean;
kono
parents:
diff changeset
88
kono
parents:
diff changeset
89 begin
kono
parents:
diff changeset
90 Close (Output_FD, Status);
kono
parents:
diff changeset
91
kono
parents:
diff changeset
92 if not Status then
kono
parents:
diff changeset
93 Fail
kono
parents:
diff changeset
94 ("error while closing file "
kono
parents:
diff changeset
95 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
96 end if;
kono
parents:
diff changeset
97 end Close_H_File;
kono
parents:
diff changeset
98
kono
parents:
diff changeset
99 ---------------------
kono
parents:
diff changeset
100 -- Close_List_File --
kono
parents:
diff changeset
101 ---------------------
kono
parents:
diff changeset
102
kono
parents:
diff changeset
103 procedure Close_List_File is
kono
parents:
diff changeset
104 Status : Boolean;
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 begin
kono
parents:
diff changeset
107 Close (Output_FD, Status);
kono
parents:
diff changeset
108
kono
parents:
diff changeset
109 if not Status then
kono
parents:
diff changeset
110 Fail
kono
parents:
diff changeset
111 ("error while closing list file "
kono
parents:
diff changeset
112 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
113 end if;
kono
parents:
diff changeset
114 end Close_List_File;
kono
parents:
diff changeset
115
kono
parents:
diff changeset
116 -------------------------------
kono
parents:
diff changeset
117 -- Close_Output_Library_Info --
kono
parents:
diff changeset
118 -------------------------------
kono
parents:
diff changeset
119
kono
parents:
diff changeset
120 procedure Close_Output_Library_Info is
kono
parents:
diff changeset
121 Status : Boolean;
kono
parents:
diff changeset
122
kono
parents:
diff changeset
123 begin
kono
parents:
diff changeset
124 Close (Output_FD, Status);
kono
parents:
diff changeset
125
kono
parents:
diff changeset
126 if not Status then
kono
parents:
diff changeset
127 Fail
kono
parents:
diff changeset
128 ("error while closing ALI file "
kono
parents:
diff changeset
129 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
130 end if;
kono
parents:
diff changeset
131 end Close_Output_Library_Info;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 ------------------------
kono
parents:
diff changeset
134 -- Close_Repinfo_File --
kono
parents:
diff changeset
135 ------------------------
kono
parents:
diff changeset
136
kono
parents:
diff changeset
137 procedure Close_Repinfo_File is
kono
parents:
diff changeset
138 Status : Boolean;
kono
parents:
diff changeset
139
kono
parents:
diff changeset
140 begin
kono
parents:
diff changeset
141 Close (Output_FD, Status);
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143 if not Status then
kono
parents:
diff changeset
144 Fail
kono
parents:
diff changeset
145 ("error while closing representation info file "
kono
parents:
diff changeset
146 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
147 end if;
kono
parents:
diff changeset
148 end Close_Repinfo_File;
kono
parents:
diff changeset
149
kono
parents:
diff changeset
150 ---------------------------
kono
parents:
diff changeset
151 -- Create_Auxiliary_File --
kono
parents:
diff changeset
152 ---------------------------
kono
parents:
diff changeset
153
kono
parents:
diff changeset
154 function Create_Auxiliary_File
kono
parents:
diff changeset
155 (Src : File_Name_Type;
kono
parents:
diff changeset
156 Suffix : String) return File_Name_Type
kono
parents:
diff changeset
157 is
kono
parents:
diff changeset
158 Result : File_Name_Type;
kono
parents:
diff changeset
159
kono
parents:
diff changeset
160 begin
kono
parents:
diff changeset
161 Get_Name_String (Src);
kono
parents:
diff changeset
162
kono
parents:
diff changeset
163 Name_Buffer (Name_Len + 1) := '.';
kono
parents:
diff changeset
164 Name_Len := Name_Len + 1;
kono
parents:
diff changeset
165 Name_Buffer (Name_Len + 1 .. Name_Len + Suffix'Length) := Suffix;
kono
parents:
diff changeset
166 Name_Len := Name_Len + Suffix'Length;
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 if Output_Object_File_Name /= null then
kono
parents:
diff changeset
169 for Index in reverse Output_Object_File_Name'Range loop
kono
parents:
diff changeset
170 if Output_Object_File_Name (Index) = Directory_Separator then
kono
parents:
diff changeset
171 declare
kono
parents:
diff changeset
172 File_Name : constant String := Name_Buffer (1 .. Name_Len);
kono
parents:
diff changeset
173 begin
kono
parents:
diff changeset
174 Name_Len := Index - Output_Object_File_Name'First + 1;
kono
parents:
diff changeset
175 Name_Buffer (1 .. Name_Len) :=
kono
parents:
diff changeset
176 Output_Object_File_Name
kono
parents:
diff changeset
177 (Output_Object_File_Name'First .. Index);
kono
parents:
diff changeset
178 Name_Buffer (Name_Len + 1 .. Name_Len + File_Name'Length) :=
kono
parents:
diff changeset
179 File_Name;
kono
parents:
diff changeset
180 Name_Len := Name_Len + File_Name'Length;
kono
parents:
diff changeset
181 end;
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183 exit;
kono
parents:
diff changeset
184 end if;
kono
parents:
diff changeset
185 end loop;
kono
parents:
diff changeset
186 end if;
kono
parents:
diff changeset
187
kono
parents:
diff changeset
188 Result := Name_Find;
kono
parents:
diff changeset
189 Name_Buffer (Name_Len + 1) := ASCII.NUL;
kono
parents:
diff changeset
190 Create_File_And_Check (Output_FD, Text);
kono
parents:
diff changeset
191 return Result;
kono
parents:
diff changeset
192 end Create_Auxiliary_File;
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 -------------------
kono
parents:
diff changeset
195 -- Create_C_File --
kono
parents:
diff changeset
196 -------------------
kono
parents:
diff changeset
197
kono
parents:
diff changeset
198 procedure Create_C_File is
kono
parents:
diff changeset
199 Dummy : Boolean;
kono
parents:
diff changeset
200 begin
kono
parents:
diff changeset
201 Set_File_Name ("c");
kono
parents:
diff changeset
202 Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
kono
parents:
diff changeset
203 Create_File_And_Check (Output_FD, Text);
kono
parents:
diff changeset
204 end Create_C_File;
kono
parents:
diff changeset
205
kono
parents:
diff changeset
206 -----------------------
kono
parents:
diff changeset
207 -- Create_Debug_File --
kono
parents:
diff changeset
208 -----------------------
kono
parents:
diff changeset
209
kono
parents:
diff changeset
210 function Create_Debug_File (Src : File_Name_Type) return File_Name_Type is
kono
parents:
diff changeset
211 begin
kono
parents:
diff changeset
212 return Create_Auxiliary_File (Src, "dg");
kono
parents:
diff changeset
213 end Create_Debug_File;
kono
parents:
diff changeset
214
kono
parents:
diff changeset
215 -------------------
kono
parents:
diff changeset
216 -- Create_H_File --
kono
parents:
diff changeset
217 -------------------
kono
parents:
diff changeset
218
kono
parents:
diff changeset
219 procedure Create_H_File is
kono
parents:
diff changeset
220 Dummy : Boolean;
kono
parents:
diff changeset
221 begin
kono
parents:
diff changeset
222 Set_File_Name ("h");
kono
parents:
diff changeset
223 Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
kono
parents:
diff changeset
224 Create_File_And_Check (Output_FD, Text);
kono
parents:
diff changeset
225 end Create_H_File;
kono
parents:
diff changeset
226
kono
parents:
diff changeset
227 ----------------------
kono
parents:
diff changeset
228 -- Create_List_File --
kono
parents:
diff changeset
229 ----------------------
kono
parents:
diff changeset
230
kono
parents:
diff changeset
231 procedure Create_List_File (S : String) is
kono
parents:
diff changeset
232 Dummy : File_Name_Type;
kono
parents:
diff changeset
233 begin
kono
parents:
diff changeset
234 if S (S'First) = '.' then
kono
parents:
diff changeset
235 Dummy :=
kono
parents:
diff changeset
236 Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
kono
parents:
diff changeset
237 else
kono
parents:
diff changeset
238 Name_Buffer (1 .. S'Length) := S;
kono
parents:
diff changeset
239 Name_Len := S'Length + 1;
kono
parents:
diff changeset
240 Name_Buffer (Name_Len) := ASCII.NUL;
kono
parents:
diff changeset
241 Create_File_And_Check (Output_FD, Text);
kono
parents:
diff changeset
242 end if;
kono
parents:
diff changeset
243 end Create_List_File;
kono
parents:
diff changeset
244
kono
parents:
diff changeset
245 --------------------------------
kono
parents:
diff changeset
246 -- Create_Output_Library_Info --
kono
parents:
diff changeset
247 --------------------------------
kono
parents:
diff changeset
248
kono
parents:
diff changeset
249 procedure Create_Output_Library_Info is
kono
parents:
diff changeset
250 Dummy : Boolean;
kono
parents:
diff changeset
251 begin
kono
parents:
diff changeset
252 Set_File_Name (ALI_Suffix.all);
kono
parents:
diff changeset
253 Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
kono
parents:
diff changeset
254 Create_File_And_Check (Output_FD, Text);
kono
parents:
diff changeset
255 end Create_Output_Library_Info;
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 ------------------------------
kono
parents:
diff changeset
258 -- Open_Output_Library_Info --
kono
parents:
diff changeset
259 ------------------------------
kono
parents:
diff changeset
260
kono
parents:
diff changeset
261 procedure Open_Output_Library_Info is
kono
parents:
diff changeset
262 begin
kono
parents:
diff changeset
263 Set_File_Name (ALI_Suffix.all);
kono
parents:
diff changeset
264 Open_File_To_Append_And_Check (Output_FD, Text);
kono
parents:
diff changeset
265 end Open_Output_Library_Info;
kono
parents:
diff changeset
266
kono
parents:
diff changeset
267 -------------------------
kono
parents:
diff changeset
268 -- Create_Repinfo_File --
kono
parents:
diff changeset
269 -------------------------
kono
parents:
diff changeset
270
kono
parents:
diff changeset
271 procedure Create_Repinfo_File (Src : String) is
kono
parents:
diff changeset
272 Discard : File_Name_Type;
kono
parents:
diff changeset
273 begin
kono
parents:
diff changeset
274 Name_Buffer (1 .. Src'Length) := Src;
kono
parents:
diff changeset
275 Name_Len := Src'Length;
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
276 if List_Representation_Info_To_JSON then
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
277 Discard := Create_Auxiliary_File (Name_Find, "json");
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
278 else
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
279 Discard := Create_Auxiliary_File (Name_Find, "rep");
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
280 end if;
111
kono
parents:
diff changeset
281 end Create_Repinfo_File;
kono
parents:
diff changeset
282
kono
parents:
diff changeset
283 ---------------------------
kono
parents:
diff changeset
284 -- Debug_File_Eol_Length --
kono
parents:
diff changeset
285 ---------------------------
kono
parents:
diff changeset
286
kono
parents:
diff changeset
287 function Debug_File_Eol_Length return Nat is
kono
parents:
diff changeset
288 begin
kono
parents:
diff changeset
289 -- There has to be a cleaner way to do this ???
kono
parents:
diff changeset
290
kono
parents:
diff changeset
291 if Directory_Separator = '/' then
kono
parents:
diff changeset
292 return 1;
kono
parents:
diff changeset
293 else
kono
parents:
diff changeset
294 return 2;
kono
parents:
diff changeset
295 end if;
kono
parents:
diff changeset
296 end Debug_File_Eol_Length;
kono
parents:
diff changeset
297
kono
parents:
diff changeset
298 -------------------
kono
parents:
diff changeset
299 -- Delete_C_File --
kono
parents:
diff changeset
300 -------------------
kono
parents:
diff changeset
301
kono
parents:
diff changeset
302 procedure Delete_C_File is
kono
parents:
diff changeset
303 Dummy : Boolean;
kono
parents:
diff changeset
304 begin
kono
parents:
diff changeset
305 Set_File_Name ("c");
kono
parents:
diff changeset
306 Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
kono
parents:
diff changeset
307 end Delete_C_File;
kono
parents:
diff changeset
308
kono
parents:
diff changeset
309 -------------------
kono
parents:
diff changeset
310 -- Delete_H_File --
kono
parents:
diff changeset
311 -------------------
kono
parents:
diff changeset
312
kono
parents:
diff changeset
313 procedure Delete_H_File is
kono
parents:
diff changeset
314 Dummy : Boolean;
kono
parents:
diff changeset
315 begin
kono
parents:
diff changeset
316 Set_File_Name ("h");
kono
parents:
diff changeset
317 Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
kono
parents:
diff changeset
318 end Delete_H_File;
kono
parents:
diff changeset
319
kono
parents:
diff changeset
320 ---------------------------------
kono
parents:
diff changeset
321 -- Get_Output_Object_File_Name --
kono
parents:
diff changeset
322 ---------------------------------
kono
parents:
diff changeset
323
kono
parents:
diff changeset
324 function Get_Output_Object_File_Name return String is
kono
parents:
diff changeset
325 begin
kono
parents:
diff changeset
326 pragma Assert (Output_Object_File_Name /= null);
kono
parents:
diff changeset
327
kono
parents:
diff changeset
328 return Output_Object_File_Name.all;
kono
parents:
diff changeset
329 end Get_Output_Object_File_Name;
kono
parents:
diff changeset
330
kono
parents:
diff changeset
331 -----------------------
kono
parents:
diff changeset
332 -- More_Source_Files --
kono
parents:
diff changeset
333 -----------------------
kono
parents:
diff changeset
334
kono
parents:
diff changeset
335 function More_Source_Files return Boolean renames More_Files;
kono
parents:
diff changeset
336
kono
parents:
diff changeset
337 ----------------------
kono
parents:
diff changeset
338 -- Next_Main_Source --
kono
parents:
diff changeset
339 ----------------------
kono
parents:
diff changeset
340
kono
parents:
diff changeset
341 function Next_Main_Source return File_Name_Type renames Next_Main_File;
kono
parents:
diff changeset
342
kono
parents:
diff changeset
343 -----------------------
kono
parents:
diff changeset
344 -- Read_Library_Info --
kono
parents:
diff changeset
345 -----------------------
kono
parents:
diff changeset
346
kono
parents:
diff changeset
347 procedure Read_Library_Info
kono
parents:
diff changeset
348 (Name : out File_Name_Type;
kono
parents:
diff changeset
349 Text : out Text_Buffer_Ptr)
kono
parents:
diff changeset
350 is
kono
parents:
diff changeset
351 begin
kono
parents:
diff changeset
352 Set_File_Name (ALI_Suffix.all);
kono
parents:
diff changeset
353
kono
parents:
diff changeset
354 -- Remove trailing NUL that comes from Set_File_Name above. This is
kono
parents:
diff changeset
355 -- needed for consistency with names that come from Scan_ALI and thus
kono
parents:
diff changeset
356 -- preventing repeated scanning of the same file.
kono
parents:
diff changeset
357
kono
parents:
diff changeset
358 pragma Assert (Name_Len > 1 and then Name_Buffer (Name_Len) = ASCII.NUL);
kono
parents:
diff changeset
359 Name_Len := Name_Len - 1;
kono
parents:
diff changeset
360
kono
parents:
diff changeset
361 Name := Name_Find;
kono
parents:
diff changeset
362 Text := Read_Library_Info (Name, Fatal_Err => False);
kono
parents:
diff changeset
363 end Read_Library_Info;
kono
parents:
diff changeset
364
kono
parents:
diff changeset
365 -------------------
kono
parents:
diff changeset
366 -- Set_File_Name --
kono
parents:
diff changeset
367 -------------------
kono
parents:
diff changeset
368
kono
parents:
diff changeset
369 procedure Set_File_Name (Ext : String) is
kono
parents:
diff changeset
370 Dot_Index : Natural;
kono
parents:
diff changeset
371
kono
parents:
diff changeset
372 begin
kono
parents:
diff changeset
373 Get_Name_String (Current_Main);
kono
parents:
diff changeset
374
kono
parents:
diff changeset
375 -- Find last dot since we replace the existing extension by .ali. The
kono
parents:
diff changeset
376 -- initialization to Name_Len + 1 provides for simply adding the .ali
kono
parents:
diff changeset
377 -- extension if the source file name has no extension.
kono
parents:
diff changeset
378
kono
parents:
diff changeset
379 Dot_Index := Name_Len + 1;
kono
parents:
diff changeset
380
kono
parents:
diff changeset
381 for J in reverse 1 .. Name_Len loop
kono
parents:
diff changeset
382 if Name_Buffer (J) = '.' then
kono
parents:
diff changeset
383 Dot_Index := J;
kono
parents:
diff changeset
384 exit;
kono
parents:
diff changeset
385 end if;
kono
parents:
diff changeset
386 end loop;
kono
parents:
diff changeset
387
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
388 -- If we are in multiple-units-per-file mode, then add a ~nnn extension
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
389 -- to the name.
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
390
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
391 if Multiple_Unit_Index /= 0 then
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
392 declare
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
393 Exten : constant String := Name_Buffer (Dot_Index .. Name_Len);
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
394 begin
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
395 Name_Len := Dot_Index - 1;
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
396 Add_Char_To_Name_Buffer (Multi_Unit_Index_Character);
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
397 Add_Nat_To_Name_Buffer (Multiple_Unit_Index);
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
398 Dot_Index := Name_Len + 1;
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
399 Add_Str_To_Name_Buffer (Exten);
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
400 end;
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
401 end if;
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
402
111
kono
parents:
diff changeset
403 -- Make sure that the output file name matches the source file name.
kono
parents:
diff changeset
404 -- To compare them, remove file name directories and extensions.
kono
parents:
diff changeset
405
kono
parents:
diff changeset
406 if Output_Object_File_Name /= null then
kono
parents:
diff changeset
407
kono
parents:
diff changeset
408 -- Make sure there is a dot at Dot_Index. This may not be the case
kono
parents:
diff changeset
409 -- if the source file name has no extension.
kono
parents:
diff changeset
410
kono
parents:
diff changeset
411 Name_Buffer (Dot_Index) := '.';
kono
parents:
diff changeset
412
kono
parents:
diff changeset
413 -- Remove extension preparing to replace it
kono
parents:
diff changeset
414
kono
parents:
diff changeset
415 declare
kono
parents:
diff changeset
416 Name : String := Name_Buffer (1 .. Dot_Index);
kono
parents:
diff changeset
417 First : Positive;
kono
parents:
diff changeset
418
kono
parents:
diff changeset
419 begin
kono
parents:
diff changeset
420 Name_Buffer (1 .. Output_Object_File_Name'Length) :=
kono
parents:
diff changeset
421 Output_Object_File_Name.all;
kono
parents:
diff changeset
422
kono
parents:
diff changeset
423 -- Put two names in canonical case, to allow object file names
kono
parents:
diff changeset
424 -- with upper-case letters on Windows.
kono
parents:
diff changeset
425
kono
parents:
diff changeset
426 Canonical_Case_File_Name (Name);
kono
parents:
diff changeset
427 Canonical_Case_File_Name
kono
parents:
diff changeset
428 (Name_Buffer (1 .. Output_Object_File_Name'Length));
kono
parents:
diff changeset
429
kono
parents:
diff changeset
430 Dot_Index := 0;
kono
parents:
diff changeset
431 for J in reverse Output_Object_File_Name'Range loop
kono
parents:
diff changeset
432 if Name_Buffer (J) = '.' then
kono
parents:
diff changeset
433 Dot_Index := J;
kono
parents:
diff changeset
434 exit;
kono
parents:
diff changeset
435 end if;
kono
parents:
diff changeset
436 end loop;
kono
parents:
diff changeset
437
kono
parents:
diff changeset
438 -- Dot_Index should not be zero now (we check for extension
kono
parents:
diff changeset
439 -- elsewhere).
kono
parents:
diff changeset
440
kono
parents:
diff changeset
441 pragma Assert (Dot_Index /= 0);
kono
parents:
diff changeset
442
kono
parents:
diff changeset
443 -- Look for first character of file name
kono
parents:
diff changeset
444
kono
parents:
diff changeset
445 First := Dot_Index;
kono
parents:
diff changeset
446 while First > 1
kono
parents:
diff changeset
447 and then Name_Buffer (First - 1) /= Directory_Separator
kono
parents:
diff changeset
448 and then Name_Buffer (First - 1) /= '/'
kono
parents:
diff changeset
449 loop
kono
parents:
diff changeset
450 First := First - 1;
kono
parents:
diff changeset
451 end loop;
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 -- Check name of object file is what we expect
kono
parents:
diff changeset
454
kono
parents:
diff changeset
455 if Name /= Name_Buffer (First .. Dot_Index) then
kono
parents:
diff changeset
456 Fail ("incorrect object file name");
kono
parents:
diff changeset
457 end if;
kono
parents:
diff changeset
458 end;
kono
parents:
diff changeset
459 end if;
kono
parents:
diff changeset
460
kono
parents:
diff changeset
461 Name_Buffer (Dot_Index) := '.';
kono
parents:
diff changeset
462 Name_Buffer (Dot_Index + 1 .. Dot_Index + Ext'Length) := Ext;
kono
parents:
diff changeset
463 Name_Buffer (Dot_Index + Ext'Length + 1) := ASCII.NUL;
kono
parents:
diff changeset
464 Name_Len := Dot_Index + Ext'Length + 1;
kono
parents:
diff changeset
465 end Set_File_Name;
kono
parents:
diff changeset
466
kono
parents:
diff changeset
467 ---------------------------------
kono
parents:
diff changeset
468 -- Set_Output_Object_File_Name --
kono
parents:
diff changeset
469 ---------------------------------
kono
parents:
diff changeset
470
kono
parents:
diff changeset
471 procedure Set_Output_Object_File_Name (Name : String) is
kono
parents:
diff changeset
472 Ext : constant String := Target_Object_Suffix;
kono
parents:
diff changeset
473 NL : constant Natural := Name'Length;
kono
parents:
diff changeset
474 EL : constant Natural := Ext'Length;
kono
parents:
diff changeset
475
kono
parents:
diff changeset
476 begin
kono
parents:
diff changeset
477 -- Make sure that the object file has the expected extension
kono
parents:
diff changeset
478
kono
parents:
diff changeset
479 if NL <= EL
kono
parents:
diff changeset
480 or else
kono
parents:
diff changeset
481 (Name (NL - EL + Name'First .. Name'Last) /= Ext
kono
parents:
diff changeset
482 and then Name (NL - 2 + Name'First .. Name'Last) /= ".o"
kono
parents:
diff changeset
483 and then
kono
parents:
diff changeset
484 (not Generate_C_Code
kono
parents:
diff changeset
485 or else Name (NL - 2 + Name'First .. Name'Last) /= ".c"))
kono
parents:
diff changeset
486 then
kono
parents:
diff changeset
487 Fail ("incorrect object file extension");
kono
parents:
diff changeset
488 end if;
kono
parents:
diff changeset
489
kono
parents:
diff changeset
490 Output_Object_File_Name := new String'(Name);
kono
parents:
diff changeset
491 end Set_Output_Object_File_Name;
kono
parents:
diff changeset
492
kono
parents:
diff changeset
493 ----------------
kono
parents:
diff changeset
494 -- Tree_Close --
kono
parents:
diff changeset
495 ----------------
kono
parents:
diff changeset
496
kono
parents:
diff changeset
497 procedure Tree_Close is
kono
parents:
diff changeset
498 Status : Boolean;
kono
parents:
diff changeset
499 begin
kono
parents:
diff changeset
500 Tree_Write_Terminate;
kono
parents:
diff changeset
501 Close (Output_FD, Status);
kono
parents:
diff changeset
502
kono
parents:
diff changeset
503 if not Status then
kono
parents:
diff changeset
504 Fail
kono
parents:
diff changeset
505 ("error while closing tree file "
kono
parents:
diff changeset
506 & Get_Name_String (Output_File_Name));
kono
parents:
diff changeset
507 end if;
kono
parents:
diff changeset
508 end Tree_Close;
kono
parents:
diff changeset
509
kono
parents:
diff changeset
510 -----------------
kono
parents:
diff changeset
511 -- Tree_Create --
kono
parents:
diff changeset
512 -----------------
kono
parents:
diff changeset
513
kono
parents:
diff changeset
514 procedure Tree_Create is
kono
parents:
diff changeset
515 Dot_Index : Natural;
kono
parents:
diff changeset
516
kono
parents:
diff changeset
517 begin
kono
parents:
diff changeset
518 Get_Name_String (Current_Main);
kono
parents:
diff changeset
519
kono
parents:
diff changeset
520 -- If an object file has been specified, then the ALI file
kono
parents:
diff changeset
521 -- will be in the same directory as the object file;
kono
parents:
diff changeset
522 -- so, we put the tree file in this same directory,
kono
parents:
diff changeset
523 -- even though no object file needs to be generated.
kono
parents:
diff changeset
524
kono
parents:
diff changeset
525 if Output_Object_File_Name /= null then
kono
parents:
diff changeset
526 Name_Len := Output_Object_File_Name'Length;
kono
parents:
diff changeset
527 Name_Buffer (1 .. Name_Len) := Output_Object_File_Name.all;
kono
parents:
diff changeset
528 end if;
kono
parents:
diff changeset
529
kono
parents:
diff changeset
530 Dot_Index := Name_Len + 1;
kono
parents:
diff changeset
531
kono
parents:
diff changeset
532 for J in reverse 1 .. Name_Len loop
kono
parents:
diff changeset
533 if Name_Buffer (J) = '.' then
kono
parents:
diff changeset
534 Dot_Index := J;
kono
parents:
diff changeset
535 exit;
kono
parents:
diff changeset
536 end if;
kono
parents:
diff changeset
537 end loop;
kono
parents:
diff changeset
538
kono
parents:
diff changeset
539 -- Should be impossible to not have an extension
kono
parents:
diff changeset
540
kono
parents:
diff changeset
541 pragma Assert (Dot_Index /= 0);
kono
parents:
diff changeset
542
kono
parents:
diff changeset
543 -- Change extension to adt
kono
parents:
diff changeset
544
kono
parents:
diff changeset
545 Name_Buffer (Dot_Index) := '.';
kono
parents:
diff changeset
546 Name_Buffer (Dot_Index + 1) := 'a';
kono
parents:
diff changeset
547 Name_Buffer (Dot_Index + 2) := 'd';
kono
parents:
diff changeset
548 Name_Buffer (Dot_Index + 3) := 't';
kono
parents:
diff changeset
549 Name_Buffer (Dot_Index + 4) := ASCII.NUL;
kono
parents:
diff changeset
550 Name_Len := Dot_Index + 3;
kono
parents:
diff changeset
551 Create_File_And_Check (Output_FD, Binary);
kono
parents:
diff changeset
552
kono
parents:
diff changeset
553 Tree_Write_Initialize (Output_FD);
kono
parents:
diff changeset
554 end Tree_Create;
kono
parents:
diff changeset
555
kono
parents:
diff changeset
556 -----------------------
kono
parents:
diff changeset
557 -- Write_Debug_Info --
kono
parents:
diff changeset
558 -----------------------
kono
parents:
diff changeset
559
kono
parents:
diff changeset
560 procedure Write_Debug_Info (Info : String) renames Write_Info;
kono
parents:
diff changeset
561
kono
parents:
diff changeset
562 ------------------------
kono
parents:
diff changeset
563 -- Write_Library_Info --
kono
parents:
diff changeset
564 ------------------------
kono
parents:
diff changeset
565
kono
parents:
diff changeset
566 procedure Write_Library_Info (Info : String) renames Write_Info;
kono
parents:
diff changeset
567
kono
parents:
diff changeset
568 ---------------------
kono
parents:
diff changeset
569 -- Write_List_Info --
kono
parents:
diff changeset
570 ---------------------
kono
parents:
diff changeset
571
kono
parents:
diff changeset
572 procedure Write_List_Info (S : String) is
kono
parents:
diff changeset
573 begin
kono
parents:
diff changeset
574 Write_With_Check (S'Address, S'Length);
kono
parents:
diff changeset
575 end Write_List_Info;
kono
parents:
diff changeset
576
kono
parents:
diff changeset
577 ------------------------
kono
parents:
diff changeset
578 -- Write_Repinfo_Line --
kono
parents:
diff changeset
579 ------------------------
kono
parents:
diff changeset
580
kono
parents:
diff changeset
581 procedure Write_Repinfo_Line (Info : String) renames Write_Info;
kono
parents:
diff changeset
582
kono
parents:
diff changeset
583 begin
kono
parents:
diff changeset
584 Adjust_OS_Resource_Limits;
kono
parents:
diff changeset
585
kono
parents:
diff changeset
586 Opt.Create_Repinfo_File_Access := Create_Repinfo_File'Access;
kono
parents:
diff changeset
587 Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access;
kono
parents:
diff changeset
588 Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access;
kono
parents:
diff changeset
589
kono
parents:
diff changeset
590 Opt.Create_List_File_Access := Create_List_File'Access;
kono
parents:
diff changeset
591 Opt.Write_List_Info_Access := Write_List_Info'Access;
kono
parents:
diff changeset
592 Opt.Close_List_File_Access := Close_List_File'Access;
kono
parents:
diff changeset
593
kono
parents:
diff changeset
594 Set_Program (Compiler);
kono
parents:
diff changeset
595 end Osint.C;