Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/vxlink-link.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 . 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;