1*3d8817e4Smiod /* Stabs in sections linking support.
2*3d8817e4Smiod Copyright 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
3*3d8817e4Smiod 2006 Free Software Foundation, Inc.
4*3d8817e4Smiod Written by Ian Lance Taylor, Cygnus Support.
5*3d8817e4Smiod
6*3d8817e4Smiod This file is part of BFD, the Binary File Descriptor library.
7*3d8817e4Smiod
8*3d8817e4Smiod This program is free software; you can redistribute it and/or modify
9*3d8817e4Smiod it under the terms of the GNU General Public License as published by
10*3d8817e4Smiod the Free Software Foundation; either version 2 of the License, or
11*3d8817e4Smiod (at your option) any later version.
12*3d8817e4Smiod
13*3d8817e4Smiod This program is distributed in the hope that it will be useful,
14*3d8817e4Smiod but WITHOUT ANY WARRANTY; without even the implied warranty of
15*3d8817e4Smiod MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16*3d8817e4Smiod GNU General Public License for more details.
17*3d8817e4Smiod
18*3d8817e4Smiod You should have received a copy of the GNU General Public License
19*3d8817e4Smiod along with this program; if not, write to the Free Software
20*3d8817e4Smiod Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. */
21*3d8817e4Smiod
22*3d8817e4Smiod /* This file contains support for linking stabs in sections, as used
23*3d8817e4Smiod on COFF and ELF. */
24*3d8817e4Smiod
25*3d8817e4Smiod #include "bfd.h"
26*3d8817e4Smiod #include "sysdep.h"
27*3d8817e4Smiod #include "libbfd.h"
28*3d8817e4Smiod #include "aout/stab_gnu.h"
29*3d8817e4Smiod #include "safe-ctype.h"
30*3d8817e4Smiod
31*3d8817e4Smiod /* Stabs entries use a 12 byte format:
32*3d8817e4Smiod 4 byte string table index
33*3d8817e4Smiod 1 byte stab type
34*3d8817e4Smiod 1 byte stab other field
35*3d8817e4Smiod 2 byte stab desc field
36*3d8817e4Smiod 4 byte stab value
37*3d8817e4Smiod FIXME: This will have to change for a 64 bit object format.
38*3d8817e4Smiod
39*3d8817e4Smiod The stabs symbols are divided into compilation units. For the
40*3d8817e4Smiod first entry in each unit, the type of 0, the value is the length of
41*3d8817e4Smiod the string table for this unit, and the desc field is the number of
42*3d8817e4Smiod stabs symbols for this unit. */
43*3d8817e4Smiod
44*3d8817e4Smiod #define STRDXOFF 0
45*3d8817e4Smiod #define TYPEOFF 4
46*3d8817e4Smiod #define OTHEROFF 5
47*3d8817e4Smiod #define DESCOFF 6
48*3d8817e4Smiod #define VALOFF 8
49*3d8817e4Smiod #define STABSIZE 12
50*3d8817e4Smiod
51*3d8817e4Smiod /* A linked list of totals that we have found for a particular header
52*3d8817e4Smiod file. A total is a unique identifier for a particular BINCL...EINCL
53*3d8817e4Smiod sequence of STABs that can be used to identify duplicate sequences.
54*3d8817e4Smiod It consists of three fields, 'sum_chars' which is the sum of all the
55*3d8817e4Smiod STABS characters; 'num_chars' which is the number of these charactes
56*3d8817e4Smiod and 'symb' which is a buffer of all the symbols in the sequence. This
57*3d8817e4Smiod buffer is only checked as a last resort. */
58*3d8817e4Smiod
59*3d8817e4Smiod struct stab_link_includes_totals
60*3d8817e4Smiod {
61*3d8817e4Smiod struct stab_link_includes_totals *next;
62*3d8817e4Smiod bfd_vma sum_chars; /* Accumulated sum of STABS characters. */
63*3d8817e4Smiod bfd_vma num_chars; /* Number of STABS characters. */
64*3d8817e4Smiod const char* symb; /* The STABS characters themselves. */
65*3d8817e4Smiod };
66*3d8817e4Smiod
67*3d8817e4Smiod /* An entry in the header file hash table. */
68*3d8817e4Smiod
69*3d8817e4Smiod struct stab_link_includes_entry
70*3d8817e4Smiod {
71*3d8817e4Smiod struct bfd_hash_entry root;
72*3d8817e4Smiod /* List of totals we have found for this file. */
73*3d8817e4Smiod struct stab_link_includes_totals *totals;
74*3d8817e4Smiod };
75*3d8817e4Smiod
76*3d8817e4Smiod /* This structure is used to hold a list of N_BINCL symbols, some of
77*3d8817e4Smiod which might be converted into N_EXCL symbols. */
78*3d8817e4Smiod
79*3d8817e4Smiod struct stab_excl_list
80*3d8817e4Smiod {
81*3d8817e4Smiod /* The next symbol to convert. */
82*3d8817e4Smiod struct stab_excl_list *next;
83*3d8817e4Smiod /* The offset to this symbol in the section contents. */
84*3d8817e4Smiod bfd_size_type offset;
85*3d8817e4Smiod /* The value to use for the symbol. */
86*3d8817e4Smiod bfd_vma val;
87*3d8817e4Smiod /* The type of this symbol (N_BINCL or N_EXCL). */
88*3d8817e4Smiod int type;
89*3d8817e4Smiod };
90*3d8817e4Smiod
91*3d8817e4Smiod /* This structure is stored with each .stab section. */
92*3d8817e4Smiod
93*3d8817e4Smiod struct stab_section_info
94*3d8817e4Smiod {
95*3d8817e4Smiod /* This is a linked list of N_BINCL symbols which should be
96*3d8817e4Smiod converted into N_EXCL symbols. */
97*3d8817e4Smiod struct stab_excl_list *excls;
98*3d8817e4Smiod
99*3d8817e4Smiod /* This is used to map input stab offsets within their sections
100*3d8817e4Smiod to output stab offsets, to take into account stabs that have
101*3d8817e4Smiod been deleted. If it is NULL, the output offsets are the same
102*3d8817e4Smiod as the input offsets, because no stabs have been deleted from
103*3d8817e4Smiod this section. Otherwise the i'th entry is the number of
104*3d8817e4Smiod bytes of stabs that have been deleted prior to the i'th
105*3d8817e4Smiod stab. */
106*3d8817e4Smiod bfd_size_type *cumulative_skips;
107*3d8817e4Smiod
108*3d8817e4Smiod /* This is an array of string indices. For each stab symbol, we
109*3d8817e4Smiod store the string index here. If a stab symbol should not be
110*3d8817e4Smiod included in the final output, the string index is -1. */
111*3d8817e4Smiod bfd_size_type stridxs[1];
112*3d8817e4Smiod };
113*3d8817e4Smiod
114*3d8817e4Smiod
115*3d8817e4Smiod /* The function to create a new entry in the header file hash table. */
116*3d8817e4Smiod
117*3d8817e4Smiod static struct bfd_hash_entry *
stab_link_includes_newfunc(struct bfd_hash_entry * entry,struct bfd_hash_table * table,const char * string)118*3d8817e4Smiod stab_link_includes_newfunc (struct bfd_hash_entry *entry,
119*3d8817e4Smiod struct bfd_hash_table *table,
120*3d8817e4Smiod const char *string)
121*3d8817e4Smiod {
122*3d8817e4Smiod struct stab_link_includes_entry *ret =
123*3d8817e4Smiod (struct stab_link_includes_entry *) entry;
124*3d8817e4Smiod
125*3d8817e4Smiod /* Allocate the structure if it has not already been allocated by a
126*3d8817e4Smiod subclass. */
127*3d8817e4Smiod if (ret == NULL)
128*3d8817e4Smiod ret = bfd_hash_allocate (table,
129*3d8817e4Smiod sizeof (struct stab_link_includes_entry));
130*3d8817e4Smiod if (ret == NULL)
131*3d8817e4Smiod return NULL;
132*3d8817e4Smiod
133*3d8817e4Smiod /* Call the allocation method of the superclass. */
134*3d8817e4Smiod ret = ((struct stab_link_includes_entry *)
135*3d8817e4Smiod bfd_hash_newfunc ((struct bfd_hash_entry *) ret, table, string));
136*3d8817e4Smiod if (ret)
137*3d8817e4Smiod /* Set local fields. */
138*3d8817e4Smiod ret->totals = NULL;
139*3d8817e4Smiod
140*3d8817e4Smiod return (struct bfd_hash_entry *) ret;
141*3d8817e4Smiod }
142*3d8817e4Smiod
143*3d8817e4Smiod /* This function is called for each input file from the add_symbols
144*3d8817e4Smiod pass of the linker. */
145*3d8817e4Smiod
146*3d8817e4Smiod bfd_boolean
_bfd_link_section_stabs(bfd * abfd,struct stab_info * sinfo,asection * stabsec,asection * stabstrsec,void ** psecinfo,bfd_size_type * pstring_offset)147*3d8817e4Smiod _bfd_link_section_stabs (bfd *abfd,
148*3d8817e4Smiod struct stab_info *sinfo,
149*3d8817e4Smiod asection *stabsec,
150*3d8817e4Smiod asection *stabstrsec,
151*3d8817e4Smiod void * *psecinfo,
152*3d8817e4Smiod bfd_size_type *pstring_offset)
153*3d8817e4Smiod {
154*3d8817e4Smiod bfd_boolean first;
155*3d8817e4Smiod bfd_size_type count, amt;
156*3d8817e4Smiod struct stab_section_info *secinfo;
157*3d8817e4Smiod bfd_byte *stabbuf = NULL;
158*3d8817e4Smiod bfd_byte *stabstrbuf = NULL;
159*3d8817e4Smiod bfd_byte *sym, *symend;
160*3d8817e4Smiod bfd_size_type stroff, next_stroff, skip;
161*3d8817e4Smiod bfd_size_type *pstridx;
162*3d8817e4Smiod
163*3d8817e4Smiod if (stabsec->size == 0
164*3d8817e4Smiod || stabstrsec->size == 0)
165*3d8817e4Smiod /* This file does not contain stabs debugging information. */
166*3d8817e4Smiod return TRUE;
167*3d8817e4Smiod
168*3d8817e4Smiod if (stabsec->size % STABSIZE != 0)
169*3d8817e4Smiod /* Something is wrong with the format of these stab symbols.
170*3d8817e4Smiod Don't try to optimize them. */
171*3d8817e4Smiod return TRUE;
172*3d8817e4Smiod
173*3d8817e4Smiod if ((stabstrsec->flags & SEC_RELOC) != 0)
174*3d8817e4Smiod /* We shouldn't see relocations in the strings, and we aren't
175*3d8817e4Smiod prepared to handle them. */
176*3d8817e4Smiod return TRUE;
177*3d8817e4Smiod
178*3d8817e4Smiod if ((stabsec->output_section != NULL
179*3d8817e4Smiod && bfd_is_abs_section (stabsec->output_section))
180*3d8817e4Smiod || (stabstrsec->output_section != NULL
181*3d8817e4Smiod && bfd_is_abs_section (stabstrsec->output_section)))
182*3d8817e4Smiod /* At least one of the sections is being discarded from the
183*3d8817e4Smiod link, so we should just ignore them. */
184*3d8817e4Smiod return TRUE;
185*3d8817e4Smiod
186*3d8817e4Smiod first = FALSE;
187*3d8817e4Smiod
188*3d8817e4Smiod if (sinfo->stabstr == NULL)
189*3d8817e4Smiod {
190*3d8817e4Smiod /* Initialize the stabs information we need to keep track of. */
191*3d8817e4Smiod first = TRUE;
192*3d8817e4Smiod sinfo->strings = _bfd_stringtab_init ();
193*3d8817e4Smiod if (sinfo->strings == NULL)
194*3d8817e4Smiod goto error_return;
195*3d8817e4Smiod /* Make sure the first byte is zero. */
196*3d8817e4Smiod (void) _bfd_stringtab_add (sinfo->strings, "", TRUE, TRUE);
197*3d8817e4Smiod if (! bfd_hash_table_init (&sinfo->includes,
198*3d8817e4Smiod stab_link_includes_newfunc,
199*3d8817e4Smiod sizeof (struct stab_link_includes_entry)))
200*3d8817e4Smiod goto error_return;
201*3d8817e4Smiod sinfo->stabstr = bfd_make_section_anyway (abfd, ".stabstr");
202*3d8817e4Smiod if (sinfo->stabstr == NULL)
203*3d8817e4Smiod goto error_return;
204*3d8817e4Smiod sinfo->stabstr->flags |= (SEC_HAS_CONTENTS | SEC_READONLY
205*3d8817e4Smiod | SEC_DEBUGGING | SEC_LINKER_CREATED);
206*3d8817e4Smiod }
207*3d8817e4Smiod
208*3d8817e4Smiod /* Initialize the information we are going to store for this .stab
209*3d8817e4Smiod section. */
210*3d8817e4Smiod count = stabsec->size / STABSIZE;
211*3d8817e4Smiod
212*3d8817e4Smiod amt = sizeof (struct stab_section_info);
213*3d8817e4Smiod amt += (count - 1) * sizeof (bfd_size_type);
214*3d8817e4Smiod *psecinfo = bfd_alloc (abfd, amt);
215*3d8817e4Smiod if (*psecinfo == NULL)
216*3d8817e4Smiod goto error_return;
217*3d8817e4Smiod
218*3d8817e4Smiod secinfo = (struct stab_section_info *) *psecinfo;
219*3d8817e4Smiod secinfo->excls = NULL;
220*3d8817e4Smiod stabsec->rawsize = stabsec->size;
221*3d8817e4Smiod secinfo->cumulative_skips = NULL;
222*3d8817e4Smiod memset (secinfo->stridxs, 0, (size_t) count * sizeof (bfd_size_type));
223*3d8817e4Smiod
224*3d8817e4Smiod /* Read the stabs information from abfd. */
225*3d8817e4Smiod if (!bfd_malloc_and_get_section (abfd, stabsec, &stabbuf)
226*3d8817e4Smiod || !bfd_malloc_and_get_section (abfd, stabstrsec, &stabstrbuf))
227*3d8817e4Smiod goto error_return;
228*3d8817e4Smiod
229*3d8817e4Smiod /* Look through the stabs symbols, work out the new string indices,
230*3d8817e4Smiod and identify N_BINCL symbols which can be eliminated. */
231*3d8817e4Smiod stroff = 0;
232*3d8817e4Smiod /* The stabs sections can be split when
233*3d8817e4Smiod -split-by-reloc/-split-by-file is used. We must keep track of
234*3d8817e4Smiod each stab section's place in the single concatenated string
235*3d8817e4Smiod table. */
236*3d8817e4Smiod next_stroff = pstring_offset ? *pstring_offset : 0;
237*3d8817e4Smiod skip = 0;
238*3d8817e4Smiod
239*3d8817e4Smiod symend = stabbuf + stabsec->size;
240*3d8817e4Smiod for (sym = stabbuf, pstridx = secinfo->stridxs;
241*3d8817e4Smiod sym < symend;
242*3d8817e4Smiod sym += STABSIZE, ++pstridx)
243*3d8817e4Smiod {
244*3d8817e4Smiod bfd_size_type symstroff;
245*3d8817e4Smiod int type;
246*3d8817e4Smiod const char *string;
247*3d8817e4Smiod
248*3d8817e4Smiod if (*pstridx != 0)
249*3d8817e4Smiod /* This symbol has already been handled by an N_BINCL pass. */
250*3d8817e4Smiod continue;
251*3d8817e4Smiod
252*3d8817e4Smiod type = sym[TYPEOFF];
253*3d8817e4Smiod
254*3d8817e4Smiod if (type == 0)
255*3d8817e4Smiod {
256*3d8817e4Smiod /* Special type 0 stabs indicate the offset to the next
257*3d8817e4Smiod string table. We only copy the very first one. */
258*3d8817e4Smiod stroff = next_stroff;
259*3d8817e4Smiod next_stroff += bfd_get_32 (abfd, sym + 8);
260*3d8817e4Smiod if (pstring_offset)
261*3d8817e4Smiod *pstring_offset = next_stroff;
262*3d8817e4Smiod if (! first)
263*3d8817e4Smiod {
264*3d8817e4Smiod *pstridx = (bfd_size_type) -1;
265*3d8817e4Smiod ++skip;
266*3d8817e4Smiod continue;
267*3d8817e4Smiod }
268*3d8817e4Smiod first = FALSE;
269*3d8817e4Smiod }
270*3d8817e4Smiod
271*3d8817e4Smiod /* Store the string in the hash table, and record the index. */
272*3d8817e4Smiod symstroff = stroff + bfd_get_32 (abfd, sym + STRDXOFF);
273*3d8817e4Smiod if (symstroff >= stabstrsec->size)
274*3d8817e4Smiod {
275*3d8817e4Smiod (*_bfd_error_handler)
276*3d8817e4Smiod (_("%B(%A+0x%lx): Stabs entry has invalid string index."),
277*3d8817e4Smiod abfd, stabsec, (long) (sym - stabbuf));
278*3d8817e4Smiod bfd_set_error (bfd_error_bad_value);
279*3d8817e4Smiod goto error_return;
280*3d8817e4Smiod }
281*3d8817e4Smiod string = (char *) stabstrbuf + symstroff;
282*3d8817e4Smiod *pstridx = _bfd_stringtab_add (sinfo->strings, string, TRUE, TRUE);
283*3d8817e4Smiod
284*3d8817e4Smiod /* An N_BINCL symbol indicates the start of the stabs entries
285*3d8817e4Smiod for a header file. We need to scan ahead to the next N_EINCL
286*3d8817e4Smiod symbol, ignoring nesting, adding up all the characters in the
287*3d8817e4Smiod symbol names, not including the file numbers in types (the
288*3d8817e4Smiod first number after an open parenthesis). */
289*3d8817e4Smiod if (type == (int) N_BINCL)
290*3d8817e4Smiod {
291*3d8817e4Smiod bfd_vma sum_chars;
292*3d8817e4Smiod bfd_vma num_chars;
293*3d8817e4Smiod bfd_vma buf_len = 0;
294*3d8817e4Smiod char * symb;
295*3d8817e4Smiod char * symb_rover;
296*3d8817e4Smiod int nest;
297*3d8817e4Smiod bfd_byte * incl_sym;
298*3d8817e4Smiod struct stab_link_includes_entry * incl_entry;
299*3d8817e4Smiod struct stab_link_includes_totals * t;
300*3d8817e4Smiod struct stab_excl_list * ne;
301*3d8817e4Smiod
302*3d8817e4Smiod symb = symb_rover = NULL;
303*3d8817e4Smiod sum_chars = num_chars = 0;
304*3d8817e4Smiod nest = 0;
305*3d8817e4Smiod
306*3d8817e4Smiod for (incl_sym = sym + STABSIZE;
307*3d8817e4Smiod incl_sym < symend;
308*3d8817e4Smiod incl_sym += STABSIZE)
309*3d8817e4Smiod {
310*3d8817e4Smiod int incl_type;
311*3d8817e4Smiod
312*3d8817e4Smiod incl_type = incl_sym[TYPEOFF];
313*3d8817e4Smiod if (incl_type == 0)
314*3d8817e4Smiod break;
315*3d8817e4Smiod else if (incl_type == (int) N_EXCL)
316*3d8817e4Smiod continue;
317*3d8817e4Smiod else if (incl_type == (int) N_EINCL)
318*3d8817e4Smiod {
319*3d8817e4Smiod if (nest == 0)
320*3d8817e4Smiod break;
321*3d8817e4Smiod --nest;
322*3d8817e4Smiod }
323*3d8817e4Smiod else if (incl_type == (int) N_BINCL)
324*3d8817e4Smiod ++nest;
325*3d8817e4Smiod else if (nest == 0)
326*3d8817e4Smiod {
327*3d8817e4Smiod const char *str;
328*3d8817e4Smiod
329*3d8817e4Smiod str = ((char *) stabstrbuf
330*3d8817e4Smiod + stroff
331*3d8817e4Smiod + bfd_get_32 (abfd, incl_sym + STRDXOFF));
332*3d8817e4Smiod for (; *str != '\0'; str++)
333*3d8817e4Smiod {
334*3d8817e4Smiod if (num_chars >= buf_len)
335*3d8817e4Smiod {
336*3d8817e4Smiod buf_len += 32 * 1024;
337*3d8817e4Smiod symb = bfd_realloc (symb, buf_len);
338*3d8817e4Smiod if (symb == NULL)
339*3d8817e4Smiod goto error_return;
340*3d8817e4Smiod symb_rover = symb + num_chars;
341*3d8817e4Smiod }
342*3d8817e4Smiod * symb_rover ++ = * str;
343*3d8817e4Smiod sum_chars += *str;
344*3d8817e4Smiod num_chars ++;
345*3d8817e4Smiod if (*str == '(')
346*3d8817e4Smiod {
347*3d8817e4Smiod /* Skip the file number. */
348*3d8817e4Smiod ++str;
349*3d8817e4Smiod while (ISDIGIT (*str))
350*3d8817e4Smiod ++str;
351*3d8817e4Smiod --str;
352*3d8817e4Smiod }
353*3d8817e4Smiod }
354*3d8817e4Smiod }
355*3d8817e4Smiod }
356*3d8817e4Smiod
357*3d8817e4Smiod BFD_ASSERT (num_chars == (bfd_vma) (symb_rover - symb));
358*3d8817e4Smiod
359*3d8817e4Smiod /* If we have already included a header file with the same
360*3d8817e4Smiod value, then replaced this one with an N_EXCL symbol. */
361*3d8817e4Smiod incl_entry = (struct stab_link_includes_entry * )
362*3d8817e4Smiod bfd_hash_lookup (&sinfo->includes, string, TRUE, TRUE);
363*3d8817e4Smiod if (incl_entry == NULL)
364*3d8817e4Smiod goto error_return;
365*3d8817e4Smiod
366*3d8817e4Smiod for (t = incl_entry->totals; t != NULL; t = t->next)
367*3d8817e4Smiod if (t->sum_chars == sum_chars
368*3d8817e4Smiod && t->num_chars == num_chars
369*3d8817e4Smiod && memcmp (t->symb, symb, num_chars) == 0)
370*3d8817e4Smiod break;
371*3d8817e4Smiod
372*3d8817e4Smiod /* Record this symbol, so that we can set the value
373*3d8817e4Smiod correctly. */
374*3d8817e4Smiod amt = sizeof *ne;
375*3d8817e4Smiod ne = bfd_alloc (abfd, amt);
376*3d8817e4Smiod if (ne == NULL)
377*3d8817e4Smiod goto error_return;
378*3d8817e4Smiod ne->offset = sym - stabbuf;
379*3d8817e4Smiod ne->val = sum_chars;
380*3d8817e4Smiod ne->type = (int) N_BINCL;
381*3d8817e4Smiod ne->next = secinfo->excls;
382*3d8817e4Smiod secinfo->excls = ne;
383*3d8817e4Smiod
384*3d8817e4Smiod if (t == NULL)
385*3d8817e4Smiod {
386*3d8817e4Smiod /* This is the first time we have seen this header file
387*3d8817e4Smiod with this set of stabs strings. */
388*3d8817e4Smiod t = bfd_hash_allocate (&sinfo->includes, sizeof *t);
389*3d8817e4Smiod if (t == NULL)
390*3d8817e4Smiod goto error_return;
391*3d8817e4Smiod t->sum_chars = sum_chars;
392*3d8817e4Smiod t->num_chars = num_chars;
393*3d8817e4Smiod t->symb = bfd_realloc (symb, num_chars); /* Trim data down. */
394*3d8817e4Smiod t->next = incl_entry->totals;
395*3d8817e4Smiod incl_entry->totals = t;
396*3d8817e4Smiod }
397*3d8817e4Smiod else
398*3d8817e4Smiod {
399*3d8817e4Smiod bfd_size_type *incl_pstridx;
400*3d8817e4Smiod
401*3d8817e4Smiod /* We have seen this header file before. Tell the final
402*3d8817e4Smiod pass to change the type to N_EXCL. */
403*3d8817e4Smiod ne->type = (int) N_EXCL;
404*3d8817e4Smiod
405*3d8817e4Smiod /* Free off superfluous symbols. */
406*3d8817e4Smiod free (symb);
407*3d8817e4Smiod
408*3d8817e4Smiod /* Mark the skipped symbols. */
409*3d8817e4Smiod
410*3d8817e4Smiod nest = 0;
411*3d8817e4Smiod for (incl_sym = sym + STABSIZE, incl_pstridx = pstridx + 1;
412*3d8817e4Smiod incl_sym < symend;
413*3d8817e4Smiod incl_sym += STABSIZE, ++incl_pstridx)
414*3d8817e4Smiod {
415*3d8817e4Smiod int incl_type;
416*3d8817e4Smiod
417*3d8817e4Smiod incl_type = incl_sym[TYPEOFF];
418*3d8817e4Smiod
419*3d8817e4Smiod if (incl_type == (int) N_EINCL)
420*3d8817e4Smiod {
421*3d8817e4Smiod if (nest == 0)
422*3d8817e4Smiod {
423*3d8817e4Smiod *incl_pstridx = (bfd_size_type) -1;
424*3d8817e4Smiod ++skip;
425*3d8817e4Smiod break;
426*3d8817e4Smiod }
427*3d8817e4Smiod --nest;
428*3d8817e4Smiod }
429*3d8817e4Smiod else if (incl_type == (int) N_BINCL)
430*3d8817e4Smiod ++nest;
431*3d8817e4Smiod else if (incl_type == (int) N_EXCL)
432*3d8817e4Smiod /* Keep existing exclusion marks. */
433*3d8817e4Smiod continue;
434*3d8817e4Smiod else if (nest == 0)
435*3d8817e4Smiod {
436*3d8817e4Smiod *incl_pstridx = (bfd_size_type) -1;
437*3d8817e4Smiod ++skip;
438*3d8817e4Smiod }
439*3d8817e4Smiod }
440*3d8817e4Smiod }
441*3d8817e4Smiod }
442*3d8817e4Smiod }
443*3d8817e4Smiod
444*3d8817e4Smiod free (stabbuf);
445*3d8817e4Smiod stabbuf = NULL;
446*3d8817e4Smiod free (stabstrbuf);
447*3d8817e4Smiod stabstrbuf = NULL;
448*3d8817e4Smiod
449*3d8817e4Smiod /* We need to set the section sizes such that the linker will
450*3d8817e4Smiod compute the output section sizes correctly. We set the .stab
451*3d8817e4Smiod size to not include the entries we don't want. We set
452*3d8817e4Smiod SEC_EXCLUDE for the .stabstr section, so that it will be dropped
453*3d8817e4Smiod from the link. We record the size of the strtab in the first
454*3d8817e4Smiod .stabstr section we saw, and make sure we don't set SEC_EXCLUDE
455*3d8817e4Smiod for that section. */
456*3d8817e4Smiod stabsec->size = (count - skip) * STABSIZE;
457*3d8817e4Smiod if (stabsec->size == 0)
458*3d8817e4Smiod stabsec->flags |= SEC_EXCLUDE;
459*3d8817e4Smiod stabstrsec->flags |= SEC_EXCLUDE;
460*3d8817e4Smiod sinfo->stabstr->size = _bfd_stringtab_size (sinfo->strings);
461*3d8817e4Smiod
462*3d8817e4Smiod /* Calculate the `cumulative_skips' array now that stabs have been
463*3d8817e4Smiod deleted for this section. */
464*3d8817e4Smiod
465*3d8817e4Smiod if (skip != 0)
466*3d8817e4Smiod {
467*3d8817e4Smiod bfd_size_type i, offset;
468*3d8817e4Smiod bfd_size_type *pskips;
469*3d8817e4Smiod
470*3d8817e4Smiod amt = count * sizeof (bfd_size_type);
471*3d8817e4Smiod secinfo->cumulative_skips = bfd_alloc (abfd, amt);
472*3d8817e4Smiod if (secinfo->cumulative_skips == NULL)
473*3d8817e4Smiod goto error_return;
474*3d8817e4Smiod
475*3d8817e4Smiod pskips = secinfo->cumulative_skips;
476*3d8817e4Smiod pstridx = secinfo->stridxs;
477*3d8817e4Smiod offset = 0;
478*3d8817e4Smiod
479*3d8817e4Smiod for (i = 0; i < count; i++, pskips++, pstridx++)
480*3d8817e4Smiod {
481*3d8817e4Smiod *pskips = offset;
482*3d8817e4Smiod if (*pstridx == (bfd_size_type) -1)
483*3d8817e4Smiod offset += STABSIZE;
484*3d8817e4Smiod }
485*3d8817e4Smiod
486*3d8817e4Smiod BFD_ASSERT (offset != 0);
487*3d8817e4Smiod }
488*3d8817e4Smiod
489*3d8817e4Smiod return TRUE;
490*3d8817e4Smiod
491*3d8817e4Smiod error_return:
492*3d8817e4Smiod if (stabbuf != NULL)
493*3d8817e4Smiod free (stabbuf);
494*3d8817e4Smiod if (stabstrbuf != NULL)
495*3d8817e4Smiod free (stabstrbuf);
496*3d8817e4Smiod return FALSE;
497*3d8817e4Smiod }
498*3d8817e4Smiod
499*3d8817e4Smiod /* This function is called for each input file before the stab
500*3d8817e4Smiod section is relocated. It discards stab entries for discarded
501*3d8817e4Smiod functions and variables. The function returns TRUE iff
502*3d8817e4Smiod any entries have been deleted.
503*3d8817e4Smiod */
504*3d8817e4Smiod
505*3d8817e4Smiod bfd_boolean
_bfd_discard_section_stabs(bfd * abfd,asection * stabsec,void * psecinfo,bfd_boolean (* reloc_symbol_deleted_p)(bfd_vma,void *),void * cookie)506*3d8817e4Smiod _bfd_discard_section_stabs (bfd *abfd,
507*3d8817e4Smiod asection *stabsec,
508*3d8817e4Smiod void * psecinfo,
509*3d8817e4Smiod bfd_boolean (*reloc_symbol_deleted_p) (bfd_vma, void *),
510*3d8817e4Smiod void * cookie)
511*3d8817e4Smiod {
512*3d8817e4Smiod bfd_size_type count, amt;
513*3d8817e4Smiod struct stab_section_info *secinfo;
514*3d8817e4Smiod bfd_byte *stabbuf = NULL;
515*3d8817e4Smiod bfd_byte *sym, *symend;
516*3d8817e4Smiod bfd_size_type skip;
517*3d8817e4Smiod bfd_size_type *pstridx;
518*3d8817e4Smiod int deleting;
519*3d8817e4Smiod
520*3d8817e4Smiod if (stabsec->size == 0)
521*3d8817e4Smiod /* This file does not contain stabs debugging information. */
522*3d8817e4Smiod return FALSE;
523*3d8817e4Smiod
524*3d8817e4Smiod if (stabsec->size % STABSIZE != 0)
525*3d8817e4Smiod /* Something is wrong with the format of these stab symbols.
526*3d8817e4Smiod Don't try to optimize them. */
527*3d8817e4Smiod return FALSE;
528*3d8817e4Smiod
529*3d8817e4Smiod if ((stabsec->output_section != NULL
530*3d8817e4Smiod && bfd_is_abs_section (stabsec->output_section)))
531*3d8817e4Smiod /* At least one of the sections is being discarded from the
532*3d8817e4Smiod link, so we should just ignore them. */
533*3d8817e4Smiod return FALSE;
534*3d8817e4Smiod
535*3d8817e4Smiod /* We should have initialized our data in _bfd_link_stab_sections.
536*3d8817e4Smiod If there was some bizarre error reading the string sections, though,
537*3d8817e4Smiod we might not have. Bail rather than asserting. */
538*3d8817e4Smiod if (psecinfo == NULL)
539*3d8817e4Smiod return FALSE;
540*3d8817e4Smiod
541*3d8817e4Smiod count = stabsec->rawsize / STABSIZE;
542*3d8817e4Smiod secinfo = (struct stab_section_info *) psecinfo;
543*3d8817e4Smiod
544*3d8817e4Smiod /* Read the stabs information from abfd. */
545*3d8817e4Smiod if (!bfd_malloc_and_get_section (abfd, stabsec, &stabbuf))
546*3d8817e4Smiod goto error_return;
547*3d8817e4Smiod
548*3d8817e4Smiod /* Look through the stabs symbols and discard any information for
549*3d8817e4Smiod discarded functions. */
550*3d8817e4Smiod skip = 0;
551*3d8817e4Smiod deleting = -1;
552*3d8817e4Smiod
553*3d8817e4Smiod symend = stabbuf + stabsec->rawsize;
554*3d8817e4Smiod for (sym = stabbuf, pstridx = secinfo->stridxs;
555*3d8817e4Smiod sym < symend;
556*3d8817e4Smiod sym += STABSIZE, ++pstridx)
557*3d8817e4Smiod {
558*3d8817e4Smiod int type;
559*3d8817e4Smiod
560*3d8817e4Smiod if (*pstridx == (bfd_size_type) -1)
561*3d8817e4Smiod /* This stab was deleted in a previous pass. */
562*3d8817e4Smiod continue;
563*3d8817e4Smiod
564*3d8817e4Smiod type = sym[TYPEOFF];
565*3d8817e4Smiod
566*3d8817e4Smiod if (type == (int) N_FUN)
567*3d8817e4Smiod {
568*3d8817e4Smiod int strx = bfd_get_32 (abfd, sym + STRDXOFF);
569*3d8817e4Smiod
570*3d8817e4Smiod if (strx == 0)
571*3d8817e4Smiod {
572*3d8817e4Smiod if (deleting)
573*3d8817e4Smiod {
574*3d8817e4Smiod skip++;
575*3d8817e4Smiod *pstridx = -1;
576*3d8817e4Smiod }
577*3d8817e4Smiod deleting = -1;
578*3d8817e4Smiod continue;
579*3d8817e4Smiod }
580*3d8817e4Smiod deleting = 0;
581*3d8817e4Smiod if ((*reloc_symbol_deleted_p) (sym + VALOFF - stabbuf, cookie))
582*3d8817e4Smiod deleting = 1;
583*3d8817e4Smiod }
584*3d8817e4Smiod
585*3d8817e4Smiod if (deleting == 1)
586*3d8817e4Smiod {
587*3d8817e4Smiod *pstridx = -1;
588*3d8817e4Smiod skip++;
589*3d8817e4Smiod }
590*3d8817e4Smiod else if (deleting == -1)
591*3d8817e4Smiod {
592*3d8817e4Smiod /* Outside of a function. Check for deleted variables. */
593*3d8817e4Smiod if (type == (int) N_STSYM || type == (int) N_LCSYM)
594*3d8817e4Smiod if ((*reloc_symbol_deleted_p) (sym + VALOFF - stabbuf, cookie))
595*3d8817e4Smiod {
596*3d8817e4Smiod *pstridx = -1;
597*3d8817e4Smiod skip ++;
598*3d8817e4Smiod }
599*3d8817e4Smiod /* We should also check for N_GSYM entries which reference a
600*3d8817e4Smiod deleted global, but those are less harmful to debuggers
601*3d8817e4Smiod and would require parsing the stab strings. */
602*3d8817e4Smiod }
603*3d8817e4Smiod }
604*3d8817e4Smiod
605*3d8817e4Smiod free (stabbuf);
606*3d8817e4Smiod stabbuf = NULL;
607*3d8817e4Smiod
608*3d8817e4Smiod /* Shrink the stabsec as needed. */
609*3d8817e4Smiod stabsec->size -= skip * STABSIZE;
610*3d8817e4Smiod if (stabsec->size == 0)
611*3d8817e4Smiod stabsec->flags |= SEC_EXCLUDE;
612*3d8817e4Smiod
613*3d8817e4Smiod /* Recalculate the `cumulative_skips' array now that stabs have been
614*3d8817e4Smiod deleted for this section. */
615*3d8817e4Smiod
616*3d8817e4Smiod if (skip != 0)
617*3d8817e4Smiod {
618*3d8817e4Smiod bfd_size_type i, offset;
619*3d8817e4Smiod bfd_size_type *pskips;
620*3d8817e4Smiod
621*3d8817e4Smiod if (secinfo->cumulative_skips == NULL)
622*3d8817e4Smiod {
623*3d8817e4Smiod amt = count * sizeof (bfd_size_type);
624*3d8817e4Smiod secinfo->cumulative_skips = bfd_alloc (abfd, amt);
625*3d8817e4Smiod if (secinfo->cumulative_skips == NULL)
626*3d8817e4Smiod goto error_return;
627*3d8817e4Smiod }
628*3d8817e4Smiod
629*3d8817e4Smiod pskips = secinfo->cumulative_skips;
630*3d8817e4Smiod pstridx = secinfo->stridxs;
631*3d8817e4Smiod offset = 0;
632*3d8817e4Smiod
633*3d8817e4Smiod for (i = 0; i < count; i++, pskips++, pstridx++)
634*3d8817e4Smiod {
635*3d8817e4Smiod *pskips = offset;
636*3d8817e4Smiod if (*pstridx == (bfd_size_type) -1)
637*3d8817e4Smiod offset += STABSIZE;
638*3d8817e4Smiod }
639*3d8817e4Smiod
640*3d8817e4Smiod BFD_ASSERT (offset != 0);
641*3d8817e4Smiod }
642*3d8817e4Smiod
643*3d8817e4Smiod return skip > 0;
644*3d8817e4Smiod
645*3d8817e4Smiod error_return:
646*3d8817e4Smiod if (stabbuf != NULL)
647*3d8817e4Smiod free (stabbuf);
648*3d8817e4Smiod return FALSE;
649*3d8817e4Smiod }
650*3d8817e4Smiod
651*3d8817e4Smiod /* Write out the stab section. This is called with the relocated
652*3d8817e4Smiod contents. */
653*3d8817e4Smiod
654*3d8817e4Smiod bfd_boolean
_bfd_write_section_stabs(bfd * output_bfd,struct stab_info * sinfo,asection * stabsec,void ** psecinfo,bfd_byte * contents)655*3d8817e4Smiod _bfd_write_section_stabs (bfd *output_bfd,
656*3d8817e4Smiod struct stab_info *sinfo,
657*3d8817e4Smiod asection *stabsec,
658*3d8817e4Smiod void * *psecinfo,
659*3d8817e4Smiod bfd_byte *contents)
660*3d8817e4Smiod {
661*3d8817e4Smiod struct stab_section_info *secinfo;
662*3d8817e4Smiod struct stab_excl_list *e;
663*3d8817e4Smiod bfd_byte *sym, *tosym, *symend;
664*3d8817e4Smiod bfd_size_type *pstridx;
665*3d8817e4Smiod
666*3d8817e4Smiod secinfo = (struct stab_section_info *) *psecinfo;
667*3d8817e4Smiod
668*3d8817e4Smiod if (secinfo == NULL)
669*3d8817e4Smiod return bfd_set_section_contents (output_bfd, stabsec->output_section,
670*3d8817e4Smiod contents, stabsec->output_offset,
671*3d8817e4Smiod stabsec->size);
672*3d8817e4Smiod
673*3d8817e4Smiod /* Handle each N_BINCL entry. */
674*3d8817e4Smiod for (e = secinfo->excls; e != NULL; e = e->next)
675*3d8817e4Smiod {
676*3d8817e4Smiod bfd_byte *excl_sym;
677*3d8817e4Smiod
678*3d8817e4Smiod BFD_ASSERT (e->offset < stabsec->rawsize);
679*3d8817e4Smiod excl_sym = contents + e->offset;
680*3d8817e4Smiod bfd_put_32 (output_bfd, e->val, excl_sym + VALOFF);
681*3d8817e4Smiod excl_sym[TYPEOFF] = e->type;
682*3d8817e4Smiod }
683*3d8817e4Smiod
684*3d8817e4Smiod /* Copy over all the stabs symbols, omitting the ones we don't want,
685*3d8817e4Smiod and correcting the string indices for those we do want. */
686*3d8817e4Smiod tosym = contents;
687*3d8817e4Smiod symend = contents + stabsec->rawsize;
688*3d8817e4Smiod for (sym = contents, pstridx = secinfo->stridxs;
689*3d8817e4Smiod sym < symend;
690*3d8817e4Smiod sym += STABSIZE, ++pstridx)
691*3d8817e4Smiod {
692*3d8817e4Smiod if (*pstridx != (bfd_size_type) -1)
693*3d8817e4Smiod {
694*3d8817e4Smiod if (tosym != sym)
695*3d8817e4Smiod memcpy (tosym, sym, STABSIZE);
696*3d8817e4Smiod bfd_put_32 (output_bfd, *pstridx, tosym + STRDXOFF);
697*3d8817e4Smiod
698*3d8817e4Smiod if (sym[TYPEOFF] == 0)
699*3d8817e4Smiod {
700*3d8817e4Smiod /* This is the header symbol for the stabs section. We
701*3d8817e4Smiod don't really need one, since we have merged all the
702*3d8817e4Smiod input stabs sections into one, but we generate one
703*3d8817e4Smiod for the benefit of readers which expect to see one. */
704*3d8817e4Smiod BFD_ASSERT (sym == contents);
705*3d8817e4Smiod bfd_put_32 (output_bfd, _bfd_stringtab_size (sinfo->strings),
706*3d8817e4Smiod tosym + VALOFF);
707*3d8817e4Smiod bfd_put_16 (output_bfd,
708*3d8817e4Smiod stabsec->output_section->size / STABSIZE - 1,
709*3d8817e4Smiod tosym + DESCOFF);
710*3d8817e4Smiod }
711*3d8817e4Smiod
712*3d8817e4Smiod tosym += STABSIZE;
713*3d8817e4Smiod }
714*3d8817e4Smiod }
715*3d8817e4Smiod
716*3d8817e4Smiod BFD_ASSERT ((bfd_size_type) (tosym - contents) == stabsec->size);
717*3d8817e4Smiod
718*3d8817e4Smiod return bfd_set_section_contents (output_bfd, stabsec->output_section,
719*3d8817e4Smiod contents, (file_ptr) stabsec->output_offset,
720*3d8817e4Smiod stabsec->size);
721*3d8817e4Smiod }
722*3d8817e4Smiod
723*3d8817e4Smiod /* Write out the .stabstr section. */
724*3d8817e4Smiod
725*3d8817e4Smiod bfd_boolean
_bfd_write_stab_strings(bfd * output_bfd,struct stab_info * sinfo)726*3d8817e4Smiod _bfd_write_stab_strings (bfd *output_bfd, struct stab_info *sinfo)
727*3d8817e4Smiod {
728*3d8817e4Smiod if (bfd_is_abs_section (sinfo->stabstr->output_section))
729*3d8817e4Smiod /* The section was discarded from the link. */
730*3d8817e4Smiod return TRUE;
731*3d8817e4Smiod
732*3d8817e4Smiod BFD_ASSERT ((sinfo->stabstr->output_offset
733*3d8817e4Smiod + _bfd_stringtab_size (sinfo->strings))
734*3d8817e4Smiod <= sinfo->stabstr->output_section->size);
735*3d8817e4Smiod
736*3d8817e4Smiod if (bfd_seek (output_bfd,
737*3d8817e4Smiod (file_ptr) (sinfo->stabstr->output_section->filepos
738*3d8817e4Smiod + sinfo->stabstr->output_offset),
739*3d8817e4Smiod SEEK_SET) != 0)
740*3d8817e4Smiod return FALSE;
741*3d8817e4Smiod
742*3d8817e4Smiod if (! _bfd_stringtab_emit (output_bfd, sinfo->strings))
743*3d8817e4Smiod return FALSE;
744*3d8817e4Smiod
745*3d8817e4Smiod /* We no longer need the stabs information. */
746*3d8817e4Smiod _bfd_stringtab_free (sinfo->strings);
747*3d8817e4Smiod bfd_hash_table_free (&sinfo->includes);
748*3d8817e4Smiod
749*3d8817e4Smiod return TRUE;
750*3d8817e4Smiod }
751*3d8817e4Smiod
752*3d8817e4Smiod /* Adjust an address in the .stab section. Given OFFSET within
753*3d8817e4Smiod STABSEC, this returns the new offset in the adjusted stab section,
754*3d8817e4Smiod or -1 if the address refers to a stab which has been removed. */
755*3d8817e4Smiod
756*3d8817e4Smiod bfd_vma
_bfd_stab_section_offset(asection * stabsec,void * psecinfo,bfd_vma offset)757*3d8817e4Smiod _bfd_stab_section_offset (asection *stabsec,
758*3d8817e4Smiod void * psecinfo,
759*3d8817e4Smiod bfd_vma offset)
760*3d8817e4Smiod {
761*3d8817e4Smiod struct stab_section_info *secinfo;
762*3d8817e4Smiod
763*3d8817e4Smiod secinfo = (struct stab_section_info *) psecinfo;
764*3d8817e4Smiod
765*3d8817e4Smiod if (secinfo == NULL)
766*3d8817e4Smiod return offset;
767*3d8817e4Smiod
768*3d8817e4Smiod if (offset >= stabsec->rawsize)
769*3d8817e4Smiod return offset - stabsec->rawsize + stabsec->size;
770*3d8817e4Smiod
771*3d8817e4Smiod if (secinfo->cumulative_skips)
772*3d8817e4Smiod {
773*3d8817e4Smiod bfd_vma i;
774*3d8817e4Smiod
775*3d8817e4Smiod i = offset / STABSIZE;
776*3d8817e4Smiod
777*3d8817e4Smiod if (secinfo->stridxs [i] == (bfd_size_type) -1)
778*3d8817e4Smiod return (bfd_vma) -1;
779*3d8817e4Smiod
780*3d8817e4Smiod return offset - secinfo->cumulative_skips [i];
781*3d8817e4Smiod }
782*3d8817e4Smiod
783*3d8817e4Smiod return offset;
784*3d8817e4Smiod }
785