Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/vxlink-bind.adb @ 131:84e7813d76e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents
children
comparison
equal deleted inserted replaced
111:04ced10e8804 131:84e7813d76e9
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- V X L I N K . B I N D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2018, AdaCore --
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 pragma Ada_2012;
27
28 with Ada.Text_IO; use Ada.Text_IO;
29 with Ada.IO_Exceptions;
30 with Ada.Strings.Fixed;
31
32 with GNAT.Regpat; use GNAT.Regpat;
33
34 package body VxLink.Bind is
35
36 function Split_Lines (S : String) return Strings_List.Vector;
37
38 function Split (S : String; C : Character) return Strings_List.Vector;
39
40 function Parse_Nm_Output (S : String) return Symbol_Sets.Set;
41
42 procedure Emit_Module_Dtor
43 (FP : File_Type);
44
45 procedure Emit_CDtor
46 (FP : File_Type;
47 Var : String;
48 Set : Symbol_Sets.Set);
49
50 -----------------
51 -- Split_Lines --
52 -----------------
53
54 function Split_Lines (S : String) return Strings_List.Vector
55 is
56 Last : Natural := S'First;
57 Ret : Strings_List.Vector;
58 begin
59 for J in S'Range loop
60 if S (J) = ASCII.CR
61 and then J < S'Last
62 and then S (J + 1) = ASCII.LF
63 then
64 Ret.Append (S (Last .. J - 1));
65 Last := J + 2;
66 elsif S (J) = ASCII.LF then
67 Ret.Append (S (Last .. J - 1));
68 Last := J + 1;
69 end if;
70 end loop;
71
72 if Last <= S'Last then
73 Ret.Append (S (Last .. S'Last));
74 end if;
75
76 return Ret;
77 end Split_Lines;
78
79 -----------
80 -- Split --
81 -----------
82
83 function Split (S : String; C : Character) return Strings_List.Vector
84 is
85 Last : Natural := S'First;
86 Ret : Strings_List.Vector;
87 begin
88 for J in S'Range loop
89 if S (J) = C then
90 if J > Last then
91 Ret.Append (S (Last .. J - 1));
92 end if;
93
94 Last := J + 1;
95 end if;
96 end loop;
97
98 if Last <= S'Last then
99 Ret.Append (S (Last .. S'Last));
100 end if;
101
102 return Ret;
103 end Split;
104
105 ---------------------
106 -- Parse_Nm_Output --
107 ---------------------
108
109 function Parse_Nm_Output (S : String) return Symbol_Sets.Set
110 is
111 Nm_Regexp : constant Pattern_Matcher :=
112 Compile ("^[0-9A-Za-z]* ([a-zA-Z]) (.*)$");
113 type CDTor_Type is
114 (CTOR_Diab,
115 CTOR_Gcc,
116 DTOR_Diab,
117 DTOR_Gcc);
118 subtype CTOR_Type is CDTor_Type range CTOR_Diab .. CTOR_Gcc;
119 CTOR_DIAB_Regexp : aliased constant Pattern_Matcher :=
120 Compile ("^__?STI__*([0-9]+)_");
121 CTOR_GCC_Regexp : aliased constant Pattern_Matcher :=
122 Compile ("^__?GLOBAL_.I._*([0-9]+)_");
123 DTOR_DIAB_Regexp : aliased constant Pattern_Matcher :=
124 Compile ("^__?STD__*([0-9]+)_");
125 DTOR_GCC_Regexp : aliased constant Pattern_Matcher :=
126 Compile ("^__?GLOBAL_.D._*([0-9]+)_");
127 type Regexp_Access is access constant Pattern_Matcher;
128 CDTor_Regexps : constant array (CDTor_Type) of Regexp_Access :=
129 (CTOR_Diab => CTOR_DIAB_Regexp'Access,
130 CTOR_Gcc => CTOR_GCC_Regexp'Access,
131 DTOR_Diab => DTOR_DIAB_Regexp'Access,
132 DTOR_Gcc => DTOR_GCC_Regexp'Access);
133 Result : Symbol_Sets.Set;
134
135 begin
136 for Line of Split_Lines (S) loop
137 declare
138 Sym : Symbol;
139 Nm_Grps : Match_Array (0 .. 2);
140 Ctor_Grps : Match_Array (0 .. 1);
141 begin
142 Match (Nm_Regexp, Line, Nm_Grps);
143
144 if Nm_Grps (0) /= No_Match then
145 declare
146 Sym_Type : constant Character :=
147 Line (Nm_Grps (1).First);
148 Sym_Name : constant String :=
149 Line (Nm_Grps (2).First .. Nm_Grps (2).Last);
150 begin
151 Sym :=
152 (Name => To_Unbounded_String (Sym_Name),
153 Cat => Sym_Type,
154 Internal => False,
155 Kind => Sym_Other,
156 Priority => -1);
157
158 for J in CDTor_Regexps'Range loop
159 Match (CDTor_Regexps (J).all, Sym_Name, Ctor_Grps);
160
161 if Ctor_Grps (0) /= No_Match then
162 if J in CTOR_Type then
163 Sym.Kind := Sym_Ctor;
164 else
165 Sym.Kind := Sym_Dtor;
166 end if;
167
168 Sym.Priority := Integer'Value
169 (Line (Ctor_Grps (1).First .. Ctor_Grps (1).Last));
170
171 exit;
172 end if;
173 end loop;
174
175 Result.Include (Sym);
176 end;
177 end if;
178 end;
179 end loop;
180
181 return Result;
182 end Parse_Nm_Output;
183
184 ----------------
185 -- Initialize --
186 ----------------
187
188 procedure Initialize
189 (Binder : out VxLink_Binder;
190 Object_File : String)
191 is
192 Args : Arguments_List;
193 Module_Dtor_Not_Needed : Boolean := False;
194 Module_Dtor_Needed : Boolean := False;
195
196 begin
197 Args.Append (Nm);
198 Args.Append (Object_File);
199
200 declare
201 Output : constant String := Run (Args);
202 Symbols : Symbol_Sets.Set;
203 begin
204 if Is_Error_State then
205 return;
206 end if;
207
208 Symbols := Parse_Nm_Output (Output);
209
210 for Sym of Symbols loop
211 if Sym.Kind = Sym_Ctor then
212 Binder.Constructors.Insert (Sym);
213 elsif Sym.Kind = Sym_Dtor then
214 Binder.Destructors.Insert (Sym);
215 elsif Match ("_?__.*_atexit$", To_String (Sym.Name)) then
216 if Sym.Cat = 'T' then
217 Module_Dtor_Not_Needed := True;
218 elsif Sym.Cat = 'U' then
219 Module_Dtor_Needed := True;
220 end if;
221 end if;
222 end loop;
223
224 Binder.Module_Dtor_Needed :=
225 not Module_Dtor_Not_Needed and then Module_Dtor_Needed;
226 end;
227 end Initialize;
228
229 --------------------
230 -- Parse_Tag_File --
231 --------------------
232
233 procedure Parse_Tag_File
234 (Binder : in out VxLink_Binder;
235 File : String)
236 is
237 FP : Ada.Text_IO.File_Type;
238
239 begin
240 Open
241 (FP,
242 Mode => In_File,
243 Name => File);
244 loop
245 declare
246 Line : constant String :=
247 Ada.Strings.Fixed.Trim
248 (Get_Line (FP), Ada.Strings.Both);
249 Tokens : Strings_List.Vector;
250
251 begin
252 if Line'Length = 0 then
253 -- Skip empty lines
254 null;
255
256 elsif Line (Line'First) = '#' then
257 -- Skip comment
258 null;
259
260 else
261 Tokens := Split (Line, ' ');
262 if Tokens.First_Element = "section" then
263 -- Sections are not used for tags, only when building
264 -- kernels. So skip for now
265 null;
266 else
267 Binder.Tags_List.Append (Line);
268 end if;
269 end if;
270 end;
271 end loop;
272
273 exception
274 when Ada.IO_Exceptions.End_Error =>
275 Close (FP);
276 when others =>
277 Log_Error ("Cannot open file " & File &
278 ". DKM tags won't be generated");
279 end Parse_Tag_File;
280
281 ----------------------
282 -- Emit_Module_Dtor --
283 ----------------------
284
285 procedure Emit_Module_Dtor
286 (FP : File_Type)
287 is
288 Dtor_Name : constant String := "_GLOBAL__D_65536_0_cxa_finalize";
289 begin
290 Put_Line (FP, "extern void __cxa_finalize(void *);");
291 Put_Line (FP, "static void " & Dtor_Name & "()");
292 Put_Line (FP, "{");
293 Put_Line (FP, " __cxa_finalize(&__dso_handle);");
294 Put_Line (FP, "}");
295 Put_Line (FP, "");
296 end Emit_Module_Dtor;
297
298 ----------------
299 -- Emit_CDtor --
300 ----------------
301
302 procedure Emit_CDtor
303 (FP : File_Type;
304 Var : String;
305 Set : Symbol_Sets.Set)
306 is
307 begin
308 for Sym of Set loop
309 if not Sym.Internal then
310 Put_Line (FP, "extern void " & To_String (Sym.Name) & "();");
311 end if;
312 end loop;
313
314 New_Line (FP);
315
316 Put_Line (FP, "extern void (*" & Var & "[])();");
317 Put_Line (FP, "void (*" & Var & "[])() =");
318 Put_Line (FP, " {");
319 for Sym of Set loop
320 Put_Line (FP, " " & To_String (Sym.Name) & ",");
321 end loop;
322 Put_Line (FP, " 0};");
323 New_Line (FP);
324 end Emit_CDtor;
325
326 ---------------
327 -- Emit_CTDT --
328 ---------------
329
330 procedure Emit_CTDT
331 (Binder : in out VxLink_Binder;
332 Namespace : String)
333 is
334 FP : Ada.Text_IO.File_Type;
335 CDtor_File : constant String := Namespace & "-cdtor.c";
336 begin
337 Binder.CTDT_File := To_Unbounded_String (CDtor_File);
338 Create
339 (File => FP,
340 Name => CDtor_File);
341 Put_Line (FP, "#if defined(_HAVE_TOOL_XTORS)");
342 Put_Line (FP, "#include <vxWorks.h>");
343 if Binder.Module_Dtor_Needed then
344 Put_Line (FP, "#define _WRS_NEED_CALL_CXA_FINALIZE");
345 end if;
346 Put_Line (FP, "#include TOOL_HEADER (toolXtors.h)");
347 Put_Line (FP, "#else");
348 Put_Line (FP, "");
349
350 if Binder.Module_Dtor_Needed then
351 Emit_Module_Dtor (FP);
352 end if;
353
354 Emit_CDtor (FP, "_ctors", Binder.Constructors);
355 Emit_CDtor (FP, "_dtors", Binder.Destructors);
356
357 Put_Line (FP, "#endif");
358
359 if not Binder.Tags_List.Is_Empty then
360 New_Line (FP);
361 Put_Line (FP, "/* build variables */");
362 Put_Line (FP, "__asm("" .section \"".wrs_build_vars\"",\""a\"""");");
363 for Tag of Binder.Tags_List loop
364 Put_Line (FP, "__asm("" .ascii \""" & Tag & "\"""");");
365 Put_Line (FP, "__asm("" .byte 0"");");
366 end loop;
367 Put_Line (FP, "__asm("" .ascii \""end\"""");");
368 Put_Line (FP, "__asm("" .byte 0"");");
369 end if;
370
371 Close (FP);
372
373 exception
374 when others =>
375 Close (FP);
376 Set_Error_State ("Internal error");
377 raise;
378 end Emit_CTDT;
379
380 ---------------
381 -- CTDT_File --
382 ---------------
383
384 function CTDT_File (Binder : VxLink_Binder) return String
385 is
386 begin
387 return To_String (Binder.CTDT_File);
388 end CTDT_File;
389
390 end VxLink.Bind;