131
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
4 -- --
|
|
5 -- V X L I N K . L I N K --
|
|
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.Command_Line; use Ada.Command_Line;
|
|
29 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
|
30
|
|
31 package body VxLink.Link is
|
|
32
|
|
33 Gcc : constant String := VxLink.Gcc;
|
|
34
|
|
35 ----------------
|
|
36 -- Initialize --
|
|
37 ----------------
|
|
38
|
|
39 procedure Initialize
|
|
40 (Linker : out VxLink_Linker)
|
|
41 is
|
|
42 Leading : Boolean := True;
|
|
43 Next_Is_Object : Boolean := False;
|
|
44
|
|
45 begin
|
|
46 for J in 1 .. Ada.Command_Line.Argument_Count loop
|
|
47 declare
|
|
48 Arg : String renames Argument (J);
|
|
49 begin
|
|
50 if Next_Is_Object then
|
|
51 Next_Is_Object := False;
|
|
52 Linker.Dest_Object := To_Unbounded_String (Arg);
|
|
53 Leading := False;
|
|
54
|
|
55 elsif Argument (J) = "-o" then
|
|
56 Next_Is_Object := True;
|
|
57
|
|
58 elsif Argument (J) = "-noauto-register" then
|
|
59 -- Filter out this argument, and do not generate _ctors/_dtors
|
|
60 Linker.Add_CDtors := False;
|
|
61 elsif Arg = "-v" and then not Is_Verbose then
|
|
62 -- first -v means VxLink should be verbose, two -v passes -v to
|
|
63 -- the linker.
|
|
64 Set_Verbose (True);
|
|
65 else
|
|
66 if Arg = "-nostdlib" or Arg = "-nostartfiles" then
|
|
67 Linker.Add_CDtors := False;
|
|
68 end if;
|
|
69
|
|
70 if Leading then
|
|
71 Linker.Args_Leading.Append (Arg);
|
|
72 else
|
|
73 Linker.Args_Trailing.Append (Arg);
|
|
74 end if;
|
|
75 end if;
|
|
76 end;
|
|
77 end loop;
|
|
78
|
|
79 if Linker.Dest_Object = Null_Unbounded_String then
|
|
80 Set_Error_State ("no output object is defined");
|
|
81 elsif Linker.Add_CDtors then
|
|
82 -- We'll need to create intermediate artefacts, so we'll use the
|
|
83 -- destination object as base namespace just in case we have
|
|
84 -- several link operations in the same directory
|
|
85 declare
|
|
86 Obj : constant String :=
|
|
87 Base_Name (To_String (Linker.Dest_Object));
|
|
88
|
|
89 begin
|
|
90 for J in reverse Obj'Range loop
|
|
91 if Obj (J) = '.' then
|
|
92 Linker.Dest_Base :=
|
|
93 To_Unbounded_String (Obj (Obj'First .. J - 1));
|
|
94 exit;
|
|
95 end if;
|
|
96 end loop;
|
|
97
|
|
98 Linker.Partial_Obj := Linker.Dest_Base & "-partial.o";
|
|
99 end;
|
|
100 end if;
|
|
101 end Initialize;
|
|
102
|
|
103 -----------------
|
|
104 -- Needs_CDtor --
|
|
105 -----------------
|
|
106
|
|
107 function Needs_CDtor (Linker : VxLink_Linker) return Boolean is
|
|
108 begin
|
|
109 return Linker.Add_CDtors;
|
|
110 end Needs_CDtor;
|
|
111
|
|
112 --------------------
|
|
113 -- Partial_Object --
|
|
114 --------------------
|
|
115
|
|
116 function Partial_Object (Linker : VxLink_Linker) return String is
|
|
117 begin
|
|
118 return To_String (Linker.Partial_Obj);
|
|
119 end Partial_Object;
|
|
120
|
|
121 ---------------
|
|
122 -- Namespace --
|
|
123 ---------------
|
|
124
|
|
125 function Namespace (Linker : VxLink_Linker) return String is
|
|
126 begin
|
|
127 return To_String (Linker.Dest_Base);
|
|
128 end Namespace;
|
|
129
|
|
130 ---------------------
|
|
131 -- Do_Initial_Link --
|
|
132 ---------------------
|
|
133
|
|
134 procedure Do_Initial_Link (Linker : VxLink_Linker)
|
|
135 is
|
|
136 Args : Arguments_List;
|
|
137 Gxx_Path : constant String := Gxx;
|
|
138 begin
|
|
139 if Is_Error_State then
|
|
140 return;
|
|
141 end if;
|
|
142
|
|
143 if Gxx_Path'Length /= 0 then
|
|
144 Args.Append (Gxx);
|
|
145 else
|
|
146 Args.Append (Gcc);
|
|
147 end if;
|
|
148 Args.Append (Linker.Args_Leading);
|
|
149 Args.Append ("-o");
|
|
150
|
|
151 if Linker.Add_CDtors then
|
|
152 Args.Append (To_String (Linker.Partial_Obj));
|
|
153 else
|
|
154 Args.Append (To_String (Linker.Dest_Object));
|
|
155 end if;
|
|
156
|
|
157 Args.Append (Linker.Args_Trailing);
|
|
158
|
|
159 if not Linker.Add_CDtors then
|
|
160 Args.Append ("-nostartfiles");
|
|
161 end if;
|
|
162
|
|
163 Run (Args);
|
|
164 end Do_Initial_Link;
|
|
165
|
|
166 -------------------
|
|
167 -- Do_Final_Link --
|
|
168 -------------------
|
|
169
|
|
170 procedure Do_Final_Link
|
|
171 (Linker : VxLink_Linker;
|
|
172 Ctdt_Obj : String)
|
|
173 is
|
|
174 Args : Arguments_List;
|
|
175 begin
|
|
176 if not Linker.Add_CDtors then
|
|
177 return;
|
|
178 end if;
|
|
179
|
|
180 if Is_Error_State then
|
|
181 return;
|
|
182 end if;
|
|
183
|
|
184 Args.Append (Gcc);
|
|
185 Args.Append ("-nostdlib");
|
|
186 Args.Append (Ctdt_Obj);
|
|
187 Args.Append (To_String (Linker.Partial_Obj));
|
|
188 Args.Append ("-o");
|
|
189 Args.Append (To_String (Linker.Dest_Object));
|
|
190
|
|
191 Run (Args);
|
|
192 end Do_Final_Link;
|
|
193
|
|
194 end VxLink.Link;
|