|
131
|
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;
|
