]> Git Repo - binutils.git/blob - bfd/elflink.h
Fix elf linker's handling of commons in archive maps
[binutils.git] / bfd / elflink.h
1 /* ELF linker support.
2    Copyright 1995, 1996, 1997, 1998, 1999 Free Software Foundation, Inc.
3
4 This file is part of BFD, the Binary File Descriptor library.
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
19
20 /* ELF linker code.  */
21
22 /* This struct is used to pass information to routines called via
23    elf_link_hash_traverse which must return failure.  */
24
25 struct elf_info_failed
26 {
27   boolean failed;
28   struct bfd_link_info *info;
29 };
30
31 static boolean elf_link_add_object_symbols
32   PARAMS ((bfd *, struct bfd_link_info *));
33 static boolean elf_link_add_archive_symbols
34   PARAMS ((bfd *, struct bfd_link_info *));
35 static boolean elf_merge_symbol
36   PARAMS ((bfd *, struct bfd_link_info *, const char *, Elf_Internal_Sym *,
37            asection **, bfd_vma *, struct elf_link_hash_entry **,
38            boolean *, boolean *, boolean *));
39 static boolean elf_export_symbol
40   PARAMS ((struct elf_link_hash_entry *, PTR));
41 static boolean elf_fix_symbol_flags
42   PARAMS ((struct elf_link_hash_entry *, struct elf_info_failed *));
43 static boolean elf_adjust_dynamic_symbol
44   PARAMS ((struct elf_link_hash_entry *, PTR));
45 static boolean elf_link_find_version_dependencies
46   PARAMS ((struct elf_link_hash_entry *, PTR));
47 static boolean elf_link_find_version_dependencies
48   PARAMS ((struct elf_link_hash_entry *, PTR));
49 static boolean elf_link_assign_sym_version
50   PARAMS ((struct elf_link_hash_entry *, PTR));
51 static boolean elf_collect_hash_codes
52   PARAMS ((struct elf_link_hash_entry *, PTR));
53 static boolean elf_link_read_relocs_from_section 
54   PARAMS ((bfd *, Elf_Internal_Shdr *, PTR, Elf_Internal_Rela *));
55 static void elf_link_output_relocs
56   PARAMS ((bfd *, asection *, Elf_Internal_Shdr *, Elf_Internal_Rela *));
57 static boolean elf_link_size_reloc_section
58   PARAMS ((bfd *, Elf_Internal_Shdr *, asection *));
59 static void elf_link_adjust_relocs 
60   PARAMS ((bfd *, Elf_Internal_Shdr *, unsigned int, 
61            struct elf_link_hash_entry **));
62
63 /* Given an ELF BFD, add symbols to the global hash table as
64    appropriate.  */
65
66 boolean
67 elf_bfd_link_add_symbols (abfd, info)
68      bfd *abfd;
69      struct bfd_link_info *info;
70 {
71   switch (bfd_get_format (abfd))
72     {
73     case bfd_object:
74       return elf_link_add_object_symbols (abfd, info);
75     case bfd_archive:
76       return elf_link_add_archive_symbols (abfd, info);
77     default:
78       bfd_set_error (bfd_error_wrong_format);
79       return false;
80     }
81 }
82 \f
83 /* Search the symbol table of the archive element of the archive ABFD
84    whoes archove map contains a mention of SYMDEF, and determine if
85    the symbol is defined in this element.  */
86 static boolean
87 elf_link_is_defined_archive_symbol (abfd, symdef)
88      bfd * abfd;
89      carsym * symdef;
90 {
91   Elf_Internal_Shdr * hdr;
92   Elf_External_Sym *  esym;
93   Elf_External_Sym *  esymend;
94   Elf_External_Sym *  buf = NULL;
95   size_t symcount;
96   size_t extsymcount;
97   size_t extsymoff;
98   boolean result = false;
99   
100   abfd = _bfd_get_elt_at_filepos (abfd, symdef->file_offset);
101   if (abfd == (bfd *) NULL)
102     return false;
103
104   if (! bfd_check_format (abfd, bfd_object))
105     return false;
106
107   /* Select the appropriate symbol table.  */
108   if ((abfd->flags & DYNAMIC) == 0 || elf_dynsymtab (abfd) == 0)
109     hdr = &elf_tdata (abfd)->symtab_hdr;
110   else
111     hdr = &elf_tdata (abfd)->dynsymtab_hdr;
112
113   symcount = hdr->sh_size / sizeof (Elf_External_Sym);
114
115   /* The sh_info field of the symtab header tells us where the
116      external symbols start.  We don't care about the local symbols.  */
117   if (elf_bad_symtab (abfd))
118     {
119       extsymcount = symcount;
120       extsymoff = 0;
121     }
122   else
123     {
124       extsymcount = symcount - hdr->sh_info;
125       extsymoff = hdr->sh_info;
126     }
127
128   buf = ((Elf_External_Sym *)
129          bfd_malloc (extsymcount * sizeof (Elf_External_Sym)));
130   if (buf == NULL && extsymcount != 0)
131     return false;
132
133   /* Read in the symbol table.
134      FIXME:  This ought to be cached somewhere.  */
135   if (bfd_seek (abfd,
136                 hdr->sh_offset + extsymoff * sizeof (Elf_External_Sym),
137                 SEEK_SET) != 0
138       || (bfd_read ((PTR) buf, sizeof (Elf_External_Sym), extsymcount, abfd)
139           != extsymcount * sizeof (Elf_External_Sym)))
140     {
141       free (buf);
142       return false;
143     }
144
145   /* Scan the symbol table looking for SYMDEF.  */
146   esymend = buf + extsymcount;
147   for (esym = buf;
148        esym < esymend;
149        esym++)
150     {
151       Elf_Internal_Sym sym;
152       const char * name;
153
154       elf_swap_symbol_in (abfd, esym, & sym);
155
156       name = bfd_elf_string_from_elf_section (abfd, hdr->sh_link, sym.st_name);
157       if (name == (const char *) NULL)
158         break;
159
160       if (strcmp (name, symdef->name) == 0)
161         {
162           result =
163             (ELF_ST_BIND (sym.st_info) == STB_GLOBAL)
164             && (sym.st_shndx != SHN_UNDEF);
165           break;
166         }
167     }
168
169   free (buf);
170   
171   return result;
172 }
173 \f
174
175 /* Add symbols from an ELF archive file to the linker hash table.  We
176    don't use _bfd_generic_link_add_archive_symbols because of a
177    problem which arises on UnixWare.  The UnixWare libc.so is an
178    archive which includes an entry libc.so.1 which defines a bunch of
179    symbols.  The libc.so archive also includes a number of other
180    object files, which also define symbols, some of which are the same
181    as those defined in libc.so.1.  Correct linking requires that we
182    consider each object file in turn, and include it if it defines any
183    symbols we need.  _bfd_generic_link_add_archive_symbols does not do
184    this; it looks through the list of undefined symbols, and includes
185    any object file which defines them.  When this algorithm is used on
186    UnixWare, it winds up pulling in libc.so.1 early and defining a
187    bunch of symbols.  This means that some of the other objects in the
188    archive are not included in the link, which is incorrect since they
189    precede libc.so.1 in the archive.
190
191    Fortunately, ELF archive handling is simpler than that done by
192    _bfd_generic_link_add_archive_symbols, which has to allow for a.out
193    oddities.  In ELF, if we find a symbol in the archive map, and the
194    symbol is currently undefined, we know that we must pull in that
195    object file.
196
197    Unfortunately, we do have to make multiple passes over the symbol
198    table until nothing further is resolved.  */
199
200 static boolean
201 elf_link_add_archive_symbols (abfd, info)
202      bfd *abfd;
203      struct bfd_link_info *info;
204 {
205   symindex c;
206   boolean *defined = NULL;
207   boolean *included = NULL;
208   carsym *symdefs;
209   boolean loop;
210
211   if (! bfd_has_map (abfd))
212     {
213       /* An empty archive is a special case.  */
214       if (bfd_openr_next_archived_file (abfd, (bfd *) NULL) == NULL)
215         return true;
216       bfd_set_error (bfd_error_no_armap);
217       return false;
218     }
219
220   /* Keep track of all symbols we know to be already defined, and all
221      files we know to be already included.  This is to speed up the
222      second and subsequent passes.  */
223   c = bfd_ardata (abfd)->symdef_count;
224   if (c == 0)
225     return true;
226   defined = (boolean *) bfd_malloc (c * sizeof (boolean));
227   included = (boolean *) bfd_malloc (c * sizeof (boolean));
228   if (defined == (boolean *) NULL || included == (boolean *) NULL)
229     goto error_return;
230   memset (defined, 0, c * sizeof (boolean));
231   memset (included, 0, c * sizeof (boolean));
232
233   symdefs = bfd_ardata (abfd)->symdefs;
234
235   do
236     {
237       file_ptr last;
238       symindex i;
239       carsym *symdef;
240       carsym *symdefend;
241
242       loop = false;
243       last = -1;
244
245       symdef = symdefs;
246       symdefend = symdef + c;
247       for (i = 0; symdef < symdefend; symdef++, i++)
248         {
249           struct elf_link_hash_entry *h;
250           bfd *element;
251           struct bfd_link_hash_entry *undefs_tail;
252           symindex mark;
253
254           if (defined[i] || included[i])
255             continue;
256           if (symdef->file_offset == last)
257             {
258               included[i] = true;
259               continue;
260             }
261
262           h = elf_link_hash_lookup (elf_hash_table (info), symdef->name,
263                                     false, false, false);
264
265           if (h == NULL)
266             {
267               char *p, *copy;
268
269               /* If this is a default version (the name contains @@),
270                  look up the symbol again without the version.  The
271                  effect is that references to the symbol without the
272                  version will be matched by the default symbol in the
273                  archive.  */
274
275               p = strchr (symdef->name, ELF_VER_CHR);
276               if (p == NULL || p[1] != ELF_VER_CHR)
277                 continue;
278
279               copy = bfd_alloc (abfd, p - symdef->name + 1);
280               if (copy == NULL)
281                 goto error_return;
282               memcpy (copy, symdef->name, p - symdef->name);
283               copy[p - symdef->name] = '\0';
284
285               h = elf_link_hash_lookup (elf_hash_table (info), copy,
286                                         false, false, false);
287
288               bfd_release (abfd, copy);
289             }
290
291           if (h == NULL)
292             continue;
293
294           if (h->root.type == bfd_link_hash_common)
295             {
296               /* We currently have a common symbol.  The archive map contains
297                  a reference to this symbol, so we may want to include it.  We
298                  only want to include it however, if this archive element
299                  contains a definition of the symbol, not just another common
300                  declaration of it.
301
302                  Unfortunately some archivers (including GNU ar) will put
303                  declarations of common symbols into their archive maps, as
304                  well as real definitions, so we cannot just go by the archive
305                  map alone.  Instead we must read in the element's symbol
306                  table and check that to see what kind of symbol definition
307                  this is.  */
308               if (! elf_link_is_defined_archive_symbol (abfd, symdef))
309                 continue;
310             }
311           else if (h->root.type != bfd_link_hash_undefined)
312             {
313               if (h->root.type != bfd_link_hash_undefweak)
314                 defined[i] = true;
315               continue;
316             }
317
318           /* We need to include this archive member.  */
319
320           element = _bfd_get_elt_at_filepos (abfd, symdef->file_offset);
321           if (element == (bfd *) NULL)
322             goto error_return;
323
324           if (! bfd_check_format (element, bfd_object))
325             goto error_return;
326
327           /* Doublecheck that we have not included this object
328              already--it should be impossible, but there may be
329              something wrong with the archive.  */
330           if (element->archive_pass != 0)
331             {
332               bfd_set_error (bfd_error_bad_value);
333               goto error_return;
334             }
335           element->archive_pass = 1;
336
337           undefs_tail = info->hash->undefs_tail;
338
339           if (! (*info->callbacks->add_archive_element) (info, element,
340                                                          symdef->name))
341             goto error_return;
342           if (! elf_link_add_object_symbols (element, info))
343             goto error_return;
344
345           /* If there are any new undefined symbols, we need to make
346              another pass through the archive in order to see whether
347              they can be defined.  FIXME: This isn't perfect, because
348              common symbols wind up on undefs_tail and because an
349              undefined symbol which is defined later on in this pass
350              does not require another pass.  This isn't a bug, but it
351              does make the code less efficient than it could be.  */
352           if (undefs_tail != info->hash->undefs_tail)
353             loop = true;
354
355           /* Look backward to mark all symbols from this object file
356              which we have already seen in this pass.  */
357           mark = i;
358           do
359             {
360               included[mark] = true;
361               if (mark == 0)
362                 break;
363               --mark;
364             }
365           while (symdefs[mark].file_offset == symdef->file_offset);
366
367           /* We mark subsequent symbols from this object file as we go
368              on through the loop.  */
369           last = symdef->file_offset;
370         }
371     }
372   while (loop);
373
374   free (defined);
375   free (included);
376
377   return true;
378
379  error_return:
380   if (defined != (boolean *) NULL)
381     free (defined);
382   if (included != (boolean *) NULL)
383     free (included);
384   return false;
385 }
386
387 /* This function is called when we want to define a new symbol.  It
388    handles the various cases which arise when we find a definition in
389    a dynamic object, or when there is already a definition in a
390    dynamic object.  The new symbol is described by NAME, SYM, PSEC,
391    and PVALUE.  We set SYM_HASH to the hash table entry.  We set
392    OVERRIDE if the old symbol is overriding a new definition.  We set
393    TYPE_CHANGE_OK if it is OK for the type to change.  We set
394    SIZE_CHANGE_OK if it is OK for the size to change.  By OK to
395    change, we mean that we shouldn't warn if the type or size does
396    change.  */
397
398 static boolean
399 elf_merge_symbol (abfd, info, name, sym, psec, pvalue, sym_hash,
400                   override, type_change_ok, size_change_ok)
401      bfd *abfd;
402      struct bfd_link_info *info;
403      const char *name;
404      Elf_Internal_Sym *sym;
405      asection **psec;
406      bfd_vma *pvalue;
407      struct elf_link_hash_entry **sym_hash;
408      boolean *override;
409      boolean *type_change_ok;
410      boolean *size_change_ok;
411 {
412   asection *sec;
413   struct elf_link_hash_entry *h;
414   int bind;
415   bfd *oldbfd;
416   boolean newdyn, olddyn, olddef, newdef, newdyncommon, olddyncommon;
417
418   *override = false;
419
420   sec = *psec;
421   bind = ELF_ST_BIND (sym->st_info);
422
423   if (! bfd_is_und_section (sec))
424     h = elf_link_hash_lookup (elf_hash_table (info), name, true, false, false);
425   else
426     h = ((struct elf_link_hash_entry *)
427          bfd_wrapped_link_hash_lookup (abfd, info, name, true, false, false));
428   if (h == NULL)
429     return false;
430   *sym_hash = h;
431
432   /* This code is for coping with dynamic objects, and is only useful
433      if we are doing an ELF link.  */
434   if (info->hash->creator != abfd->xvec)
435     return true;
436
437   /* For merging, we only care about real symbols.  */
438
439   while (h->root.type == bfd_link_hash_indirect
440          || h->root.type == bfd_link_hash_warning)
441     h = (struct elf_link_hash_entry *) h->root.u.i.link;
442
443   /* If we just created the symbol, mark it as being an ELF symbol.
444      Other than that, there is nothing to do--there is no merge issue
445      with a newly defined symbol--so we just return.  */
446
447   if (h->root.type == bfd_link_hash_new)
448     {
449       h->elf_link_hash_flags &=~ ELF_LINK_NON_ELF;
450       return true;
451     }
452
453   /* OLDBFD is a BFD associated with the existing symbol.  */
454
455   switch (h->root.type)
456     {
457     default:
458       oldbfd = NULL;
459       break;
460
461     case bfd_link_hash_undefined:
462     case bfd_link_hash_undefweak:
463       oldbfd = h->root.u.undef.abfd;
464       break;
465
466     case bfd_link_hash_defined:
467     case bfd_link_hash_defweak:
468       oldbfd = h->root.u.def.section->owner;
469       break;
470
471     case bfd_link_hash_common:
472       oldbfd = h->root.u.c.p->section->owner;
473       break;
474     }
475
476   /* In cases involving weak versioned symbols, we may wind up trying
477      to merge a symbol with itself.  Catch that here, to avoid the
478      confusion that results if we try to override a symbol with
479      itself.  The additional tests catch cases like
480      _GLOBAL_OFFSET_TABLE_, which are regular symbols defined in a
481      dynamic object, which we do want to handle here.  */
482   if (abfd == oldbfd
483       && ((abfd->flags & DYNAMIC) == 0
484           || (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0))
485     return true;
486
487   /* NEWDYN and OLDDYN indicate whether the new or old symbol,
488      respectively, is from a dynamic object.  */
489
490   if ((abfd->flags & DYNAMIC) != 0)
491     newdyn = true;
492   else
493     newdyn = false;
494
495   if (oldbfd != NULL)
496     olddyn = (oldbfd->flags & DYNAMIC) != 0;
497   else
498     {
499       asection *hsec;
500
501       /* This code handles the special SHN_MIPS_{TEXT,DATA} section
502          indices used by MIPS ELF.  */
503       switch (h->root.type)
504         {
505         default:
506           hsec = NULL;
507           break;
508
509         case bfd_link_hash_defined:
510         case bfd_link_hash_defweak:
511           hsec = h->root.u.def.section;
512           break;
513
514         case bfd_link_hash_common:
515           hsec = h->root.u.c.p->section;
516           break;
517         }
518
519       if (hsec == NULL)
520         olddyn = false;
521       else
522         olddyn = (hsec->symbol->flags & BSF_DYNAMIC) != 0;
523     }
524
525   /* NEWDEF and OLDDEF indicate whether the new or old symbol,
526      respectively, appear to be a definition rather than reference.  */
527
528   if (bfd_is_und_section (sec) || bfd_is_com_section (sec))
529     newdef = false;
530   else
531     newdef = true;
532
533   if (h->root.type == bfd_link_hash_undefined
534       || h->root.type == bfd_link_hash_undefweak
535       || h->root.type == bfd_link_hash_common)
536     olddef = false;
537   else
538     olddef = true;
539
540   /* NEWDYNCOMMON and OLDDYNCOMMON indicate whether the new or old
541      symbol, respectively, appears to be a common symbol in a dynamic
542      object.  If a symbol appears in an uninitialized section, and is
543      not weak, and is not a function, then it may be a common symbol
544      which was resolved when the dynamic object was created.  We want
545      to treat such symbols specially, because they raise special
546      considerations when setting the symbol size: if the symbol
547      appears as a common symbol in a regular object, and the size in
548      the regular object is larger, we must make sure that we use the
549      larger size.  This problematic case can always be avoided in C,
550      but it must be handled correctly when using Fortran shared
551      libraries.
552
553      Note that if NEWDYNCOMMON is set, NEWDEF will be set, and
554      likewise for OLDDYNCOMMON and OLDDEF.
555
556      Note that this test is just a heuristic, and that it is quite
557      possible to have an uninitialized symbol in a shared object which
558      is really a definition, rather than a common symbol.  This could
559      lead to some minor confusion when the symbol really is a common
560      symbol in some regular object.  However, I think it will be
561      harmless.  */
562
563   if (newdyn
564       && newdef
565       && (sec->flags & SEC_ALLOC) != 0
566       && (sec->flags & SEC_LOAD) == 0
567       && sym->st_size > 0
568       && bind != STB_WEAK
569       && ELF_ST_TYPE (sym->st_info) != STT_FUNC)
570     newdyncommon = true;
571   else
572     newdyncommon = false;
573
574   if (olddyn
575       && olddef
576       && h->root.type == bfd_link_hash_defined
577       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0
578       && (h->root.u.def.section->flags & SEC_ALLOC) != 0
579       && (h->root.u.def.section->flags & SEC_LOAD) == 0
580       && h->size > 0
581       && h->type != STT_FUNC)
582     olddyncommon = true;
583   else
584     olddyncommon = false;
585
586   /* It's OK to change the type if either the existing symbol or the
587      new symbol is weak.  */
588
589   if (h->root.type == bfd_link_hash_defweak
590       || h->root.type == bfd_link_hash_undefweak
591       || bind == STB_WEAK)
592     *type_change_ok = true;
593
594   /* It's OK to change the size if either the existing symbol or the
595      new symbol is weak, or if the old symbol is undefined.  */
596
597   if (*type_change_ok
598       || h->root.type == bfd_link_hash_undefined)
599     *size_change_ok = true;
600
601   /* If both the old and the new symbols look like common symbols in a
602      dynamic object, set the size of the symbol to the larger of the
603      two.  */
604
605   if (olddyncommon
606       && newdyncommon
607       && sym->st_size != h->size)
608     {
609       /* Since we think we have two common symbols, issue a multiple
610          common warning if desired.  Note that we only warn if the
611          size is different.  If the size is the same, we simply let
612          the old symbol override the new one as normally happens with
613          symbols defined in dynamic objects.  */
614
615       if (! ((*info->callbacks->multiple_common)
616              (info, h->root.root.string, oldbfd, bfd_link_hash_common,
617               h->size, abfd, bfd_link_hash_common, sym->st_size)))
618         return false;
619
620       if (sym->st_size > h->size)
621         h->size = sym->st_size;
622
623       *size_change_ok = true;
624     }
625
626   /* If we are looking at a dynamic object, and we have found a
627      definition, we need to see if the symbol was already defined by
628      some other object.  If so, we want to use the existing
629      definition, and we do not want to report a multiple symbol
630      definition error; we do this by clobbering *PSEC to be
631      bfd_und_section_ptr.
632
633      We treat a common symbol as a definition if the symbol in the
634      shared library is a function, since common symbols always
635      represent variables; this can cause confusion in principle, but
636      any such confusion would seem to indicate an erroneous program or
637      shared library.  We also permit a common symbol in a regular
638      object to override a weak symbol in a shared object.
639
640      We prefer a non-weak definition in a shared library to a weak
641      definition in the executable.  */
642
643   if (newdyn
644       && newdef
645       && (olddef
646           || (h->root.type == bfd_link_hash_common
647               && (bind == STB_WEAK
648                   || ELF_ST_TYPE (sym->st_info) == STT_FUNC)))
649       && (h->root.type != bfd_link_hash_defweak
650           || bind == STB_WEAK))
651     {
652       *override = true;
653       newdef = false;
654       newdyncommon = false;
655
656       *psec = sec = bfd_und_section_ptr;
657       *size_change_ok = true;
658
659       /* If we get here when the old symbol is a common symbol, then
660          we are explicitly letting it override a weak symbol or
661          function in a dynamic object, and we don't want to warn about
662          a type change.  If the old symbol is a defined symbol, a type
663          change warning may still be appropriate.  */
664
665       if (h->root.type == bfd_link_hash_common)
666         *type_change_ok = true;
667     }
668
669   /* Handle the special case of an old common symbol merging with a
670      new symbol which looks like a common symbol in a shared object.
671      We change *PSEC and *PVALUE to make the new symbol look like a
672      common symbol, and let _bfd_generic_link_add_one_symbol will do
673      the right thing.  */
674
675   if (newdyncommon
676       && h->root.type == bfd_link_hash_common)
677     {
678       *override = true;
679       newdef = false;
680       newdyncommon = false;
681       *pvalue = sym->st_size;
682       *psec = sec = bfd_com_section_ptr;
683       *size_change_ok = true;
684     }
685
686   /* If the old symbol is from a dynamic object, and the new symbol is
687      a definition which is not from a dynamic object, then the new
688      symbol overrides the old symbol.  Symbols from regular files
689      always take precedence over symbols from dynamic objects, even if
690      they are defined after the dynamic object in the link.
691
692      As above, we again permit a common symbol in a regular object to
693      override a definition in a shared object if the shared object
694      symbol is a function or is weak.
695
696      As above, we permit a non-weak definition in a shared object to
697      override a weak definition in a regular object.  */
698
699   if (! newdyn
700       && (newdef
701           || (bfd_is_com_section (sec)
702               && (h->root.type == bfd_link_hash_defweak
703                   || h->type == STT_FUNC)))
704       && olddyn
705       && olddef
706       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0
707       && (bind != STB_WEAK
708           || h->root.type == bfd_link_hash_defweak))
709     {
710       /* Change the hash table entry to undefined, and let
711          _bfd_generic_link_add_one_symbol do the right thing with the
712          new definition.  */
713
714       h->root.type = bfd_link_hash_undefined;
715       h->root.u.undef.abfd = h->root.u.def.section->owner;
716       *size_change_ok = true;
717
718       olddef = false;
719       olddyncommon = false;
720
721       /* We again permit a type change when a common symbol may be
722          overriding a function.  */
723
724       if (bfd_is_com_section (sec))
725         *type_change_ok = true;
726
727       /* This union may have been set to be non-NULL when this symbol
728          was seen in a dynamic object.  We must force the union to be
729          NULL, so that it is correct for a regular symbol.  */
730
731       h->verinfo.vertree = NULL;
732
733       /* In this special case, if H is the target of an indirection,
734          we want the caller to frob with H rather than with the
735          indirect symbol.  That will permit the caller to redefine the
736          target of the indirection, rather than the indirect symbol
737          itself.  FIXME: This will break the -y option if we store a
738          symbol with a different name.  */
739       *sym_hash = h;
740     }
741
742   /* Handle the special case of a new common symbol merging with an
743      old symbol that looks like it might be a common symbol defined in
744      a shared object.  Note that we have already handled the case in
745      which a new common symbol should simply override the definition
746      in the shared library.  */
747
748   if (! newdyn
749       && bfd_is_com_section (sec)
750       && olddyncommon)
751     {
752       /* It would be best if we could set the hash table entry to a
753          common symbol, but we don't know what to use for the section
754          or the alignment.  */
755       if (! ((*info->callbacks->multiple_common)
756              (info, h->root.root.string, oldbfd, bfd_link_hash_common,
757               h->size, abfd, bfd_link_hash_common, sym->st_size)))
758         return false;
759
760       /* If the predumed common symbol in the dynamic object is
761          larger, pretend that the new symbol has its size.  */
762
763       if (h->size > *pvalue)
764         *pvalue = h->size;
765
766       /* FIXME: We no longer know the alignment required by the symbol
767          in the dynamic object, so we just wind up using the one from
768          the regular object.  */
769
770       olddef = false;
771       olddyncommon = false;
772
773       h->root.type = bfd_link_hash_undefined;
774       h->root.u.undef.abfd = h->root.u.def.section->owner;
775
776       *size_change_ok = true;
777       *type_change_ok = true;
778
779       h->verinfo.vertree = NULL;
780     }
781
782   /* Handle the special case of a weak definition in a regular object
783      followed by a non-weak definition in a shared object.  In this
784      case, we prefer the definition in the shared object.  */
785   if (olddef
786       && h->root.type == bfd_link_hash_defweak
787       && newdef
788       && newdyn
789       && bind != STB_WEAK)
790     {
791       /* To make this work we have to frob the flags so that the rest
792          of the code does not think we are using the regular
793          definition.  */
794       if ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) != 0)
795         h->elf_link_hash_flags |= ELF_LINK_HASH_REF_REGULAR;
796       else if ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0)
797         h->elf_link_hash_flags |= ELF_LINK_HASH_REF_DYNAMIC;
798       h->elf_link_hash_flags &= ~ (ELF_LINK_HASH_DEF_REGULAR
799                                    | ELF_LINK_HASH_DEF_DYNAMIC);
800
801       /* If H is the target of an indirection, we want the caller to
802          use H rather than the indirect symbol.  Otherwise if we are
803          defining a new indirect symbol we will wind up attaching it
804          to the entry we are overriding.  */
805       *sym_hash = h;
806     }
807
808   /* Handle the special case of a non-weak definition in a shared
809      object followed by a weak definition in a regular object.  In
810      this case we prefer to definition in the shared object.  To make
811      this work we have to tell the caller to not treat the new symbol
812      as a definition.  */
813   if (olddef
814       && olddyn
815       && h->root.type != bfd_link_hash_defweak
816       && newdef
817       && ! newdyn
818       && bind == STB_WEAK)
819     *override = true;
820
821   return true;
822 }
823
824 /* Add symbols from an ELF object file to the linker hash table.  */
825
826 static boolean
827 elf_link_add_object_symbols (abfd, info)
828      bfd *abfd;
829      struct bfd_link_info *info;
830 {
831   boolean (*add_symbol_hook) PARAMS ((bfd *, struct bfd_link_info *,
832                                       const Elf_Internal_Sym *,
833                                       const char **, flagword *,
834                                       asection **, bfd_vma *));
835   boolean (*check_relocs) PARAMS ((bfd *, struct bfd_link_info *,
836                                    asection *, const Elf_Internal_Rela *));
837   boolean collect;
838   Elf_Internal_Shdr *hdr;
839   size_t symcount;
840   size_t extsymcount;
841   size_t extsymoff;
842   Elf_External_Sym *buf = NULL;
843   struct elf_link_hash_entry **sym_hash;
844   boolean dynamic;
845   bfd_byte *dynver = NULL;
846   Elf_External_Versym *extversym = NULL;
847   Elf_External_Versym *ever;
848   Elf_External_Dyn *dynbuf = NULL;
849   struct elf_link_hash_entry *weaks;
850   Elf_External_Sym *esym;
851   Elf_External_Sym *esymend;
852
853   add_symbol_hook = get_elf_backend_data (abfd)->elf_add_symbol_hook;
854   collect = get_elf_backend_data (abfd)->collect;
855
856   if ((abfd->flags & DYNAMIC) == 0)
857     dynamic = false;
858   else
859     {
860       dynamic = true;
861
862       /* You can't use -r against a dynamic object.  Also, there's no
863          hope of using a dynamic object which does not exactly match
864          the format of the output file.  */
865       if (info->relocateable || info->hash->creator != abfd->xvec)
866         {
867           bfd_set_error (bfd_error_invalid_operation);
868           goto error_return;
869         }
870     }
871
872   /* As a GNU extension, any input sections which are named
873      .gnu.warning.SYMBOL are treated as warning symbols for the given
874      symbol.  This differs from .gnu.warning sections, which generate
875      warnings when they are included in an output file.  */
876   if (! info->shared)
877     {
878       asection *s;
879
880       for (s = abfd->sections; s != NULL; s = s->next)
881         {
882           const char *name;
883
884           name = bfd_get_section_name (abfd, s);
885           if (strncmp (name, ".gnu.warning.", sizeof ".gnu.warning." - 1) == 0)
886             {
887               char *msg;
888               bfd_size_type sz;
889
890               name += sizeof ".gnu.warning." - 1;
891
892               /* If this is a shared object, then look up the symbol
893                  in the hash table.  If it is there, and it is already
894                  been defined, then we will not be using the entry
895                  from this shared object, so we don't need to warn.
896                  FIXME: If we see the definition in a regular object
897                  later on, we will warn, but we shouldn't.  The only
898                  fix is to keep track of what warnings we are supposed
899                  to emit, and then handle them all at the end of the
900                  link.  */
901               if (dynamic && abfd->xvec == info->hash->creator)
902                 {
903                   struct elf_link_hash_entry *h;
904
905                   h = elf_link_hash_lookup (elf_hash_table (info), name,
906                                             false, false, true);
907
908                   /* FIXME: What about bfd_link_hash_common?  */
909                   if (h != NULL
910                       && (h->root.type == bfd_link_hash_defined
911                           || h->root.type == bfd_link_hash_defweak))
912                     {
913                       /* We don't want to issue this warning.  Clobber
914                          the section size so that the warning does not
915                          get copied into the output file.  */
916                       s->_raw_size = 0;
917                       continue;
918                     }
919                 }
920
921               sz = bfd_section_size (abfd, s);
922               msg = (char *) bfd_alloc (abfd, sz + 1);
923               if (msg == NULL)
924                 goto error_return;
925
926               if (! bfd_get_section_contents (abfd, s, msg, (file_ptr) 0, sz))
927                 goto error_return;
928
929               msg[sz] = '\0';
930
931               if (! (_bfd_generic_link_add_one_symbol
932                      (info, abfd, name, BSF_WARNING, s, (bfd_vma) 0, msg,
933                       false, collect, (struct bfd_link_hash_entry **) NULL)))
934                 goto error_return;
935
936               if (! info->relocateable)
937                 {
938                   /* Clobber the section size so that the warning does
939                      not get copied into the output file.  */
940                   s->_raw_size = 0;
941                 }
942             }
943         }
944     }
945
946   /* If this is a dynamic object, we always link against the .dynsym
947      symbol table, not the .symtab symbol table.  The dynamic linker
948      will only see the .dynsym symbol table, so there is no reason to
949      look at .symtab for a dynamic object.  */
950
951   if (! dynamic || elf_dynsymtab (abfd) == 0)
952     hdr = &elf_tdata (abfd)->symtab_hdr;
953   else
954     hdr = &elf_tdata (abfd)->dynsymtab_hdr;
955
956   if (dynamic)
957     {
958       /* Read in any version definitions.  */
959
960       if (! _bfd_elf_slurp_version_tables (abfd))
961         goto error_return;
962
963       /* Read in the symbol versions, but don't bother to convert them
964          to internal format.  */
965       if (elf_dynversym (abfd) != 0)
966         {
967           Elf_Internal_Shdr *versymhdr;
968
969           versymhdr = &elf_tdata (abfd)->dynversym_hdr;
970           extversym = (Elf_External_Versym *) bfd_malloc (hdr->sh_size);
971           if (extversym == NULL)
972             goto error_return;
973           if (bfd_seek (abfd, versymhdr->sh_offset, SEEK_SET) != 0
974               || (bfd_read ((PTR) extversym, 1, versymhdr->sh_size, abfd)
975                   != versymhdr->sh_size))
976             goto error_return;
977         }
978     }
979
980   symcount = hdr->sh_size / sizeof (Elf_External_Sym);
981
982   /* The sh_info field of the symtab header tells us where the
983      external symbols start.  We don't care about the local symbols at
984      this point.  */
985   if (elf_bad_symtab (abfd))
986     {
987       extsymcount = symcount;
988       extsymoff = 0;
989     }
990   else
991     {
992       extsymcount = symcount - hdr->sh_info;
993       extsymoff = hdr->sh_info;
994     }
995
996   buf = ((Elf_External_Sym *)
997          bfd_malloc (extsymcount * sizeof (Elf_External_Sym)));
998   if (buf == NULL && extsymcount != 0)
999     goto error_return;
1000
1001   /* We store a pointer to the hash table entry for each external
1002      symbol.  */
1003   sym_hash = ((struct elf_link_hash_entry **)
1004               bfd_alloc (abfd,
1005                          extsymcount * sizeof (struct elf_link_hash_entry *)));
1006   if (sym_hash == NULL)
1007     goto error_return;
1008   elf_sym_hashes (abfd) = sym_hash;
1009
1010   if (! dynamic)
1011     {
1012       /* If we are creating a shared library, create all the dynamic
1013          sections immediately.  We need to attach them to something,
1014          so we attach them to this BFD, provided it is the right
1015          format.  FIXME: If there are no input BFD's of the same
1016          format as the output, we can't make a shared library.  */
1017       if (info->shared
1018           && ! elf_hash_table (info)->dynamic_sections_created
1019           && abfd->xvec == info->hash->creator)
1020         {
1021           if (! elf_link_create_dynamic_sections (abfd, info))
1022             goto error_return;
1023         }
1024     }
1025   else
1026     {
1027       asection *s;
1028       boolean add_needed;
1029       const char *name;
1030       bfd_size_type oldsize;
1031       bfd_size_type strindex;
1032
1033       /* Find the name to use in a DT_NEEDED entry that refers to this
1034          object.  If the object has a DT_SONAME entry, we use it.
1035          Otherwise, if the generic linker stuck something in
1036          elf_dt_name, we use that.  Otherwise, we just use the file
1037          name.  If the generic linker put a null string into
1038          elf_dt_name, we don't make a DT_NEEDED entry at all, even if
1039          there is a DT_SONAME entry.  */
1040       add_needed = true;
1041       name = bfd_get_filename (abfd);
1042       if (elf_dt_name (abfd) != NULL)
1043         {
1044           name = elf_dt_name (abfd);
1045           if (*name == '\0')
1046             add_needed = false;
1047         }
1048       s = bfd_get_section_by_name (abfd, ".dynamic");
1049       if (s != NULL)
1050         {
1051           Elf_External_Dyn *extdyn;
1052           Elf_External_Dyn *extdynend;
1053           int elfsec;
1054           unsigned long link;
1055
1056           dynbuf = (Elf_External_Dyn *) bfd_malloc ((size_t) s->_raw_size);
1057           if (dynbuf == NULL)
1058             goto error_return;
1059
1060           if (! bfd_get_section_contents (abfd, s, (PTR) dynbuf,
1061                                           (file_ptr) 0, s->_raw_size))
1062             goto error_return;
1063
1064           elfsec = _bfd_elf_section_from_bfd_section (abfd, s);
1065           if (elfsec == -1)
1066             goto error_return;
1067           link = elf_elfsections (abfd)[elfsec]->sh_link;
1068
1069           {
1070             /* The shared libraries distributed with hpux11 have a bogus
1071                sh_link field for the ".dynamic" section.  This code detects
1072                when LINK refers to a section that is not a string table and
1073                tries to find the string table for the ".dynsym" section
1074                instead.  */
1075             Elf_Internal_Shdr *hdr = elf_elfsections (abfd)[link];
1076             if (hdr->sh_type != SHT_STRTAB)
1077               {
1078                 asection *s = bfd_get_section_by_name (abfd, ".dynsym");
1079                 int elfsec = _bfd_elf_section_from_bfd_section (abfd, s);
1080                 if (elfsec == -1)
1081                   goto error_return;
1082                 link = elf_elfsections (abfd)[elfsec]->sh_link;
1083               }
1084           }
1085
1086           extdyn = dynbuf;
1087           extdynend = extdyn + s->_raw_size / sizeof (Elf_External_Dyn);
1088           for (; extdyn < extdynend; extdyn++)
1089             {
1090               Elf_Internal_Dyn dyn;
1091
1092               elf_swap_dyn_in (abfd, extdyn, &dyn);
1093               if (dyn.d_tag == DT_SONAME)
1094                 {
1095                   name = bfd_elf_string_from_elf_section (abfd, link,
1096                                                           dyn.d_un.d_val);
1097                   if (name == NULL)
1098                     goto error_return;
1099                 }
1100               if (dyn.d_tag == DT_NEEDED)
1101                 {
1102                   struct bfd_link_needed_list *n, **pn;
1103                   char *fnm, *anm;
1104
1105                   n = ((struct bfd_link_needed_list *)
1106                        bfd_alloc (abfd, sizeof (struct bfd_link_needed_list)));
1107                   fnm = bfd_elf_string_from_elf_section (abfd, link,
1108                                                          dyn.d_un.d_val);
1109                   if (n == NULL || fnm == NULL)
1110                     goto error_return;
1111                   anm = bfd_alloc (abfd, strlen (fnm) + 1);
1112                   if (anm == NULL)
1113                     goto error_return;
1114                   strcpy (anm, fnm);
1115                   n->name = anm;
1116                   n->by = abfd;
1117                   n->next = NULL;
1118                   for (pn = &elf_hash_table (info)->needed;
1119                        *pn != NULL;
1120                        pn = &(*pn)->next)
1121                     ;
1122                   *pn = n;
1123                 }
1124             }
1125
1126           free (dynbuf);
1127           dynbuf = NULL;
1128         }
1129
1130       /* We do not want to include any of the sections in a dynamic
1131          object in the output file.  We hack by simply clobbering the
1132          list of sections in the BFD.  This could be handled more
1133          cleanly by, say, a new section flag; the existing
1134          SEC_NEVER_LOAD flag is not the one we want, because that one
1135          still implies that the section takes up space in the output
1136          file.  */
1137       abfd->sections = NULL;
1138       abfd->section_count = 0;
1139
1140       /* If this is the first dynamic object found in the link, create
1141          the special sections required for dynamic linking.  */
1142       if (! elf_hash_table (info)->dynamic_sections_created)
1143         {
1144           if (! elf_link_create_dynamic_sections (abfd, info))
1145             goto error_return;
1146         }
1147
1148       if (add_needed)
1149         {
1150           /* Add a DT_NEEDED entry for this dynamic object.  */
1151           oldsize = _bfd_stringtab_size (elf_hash_table (info)->dynstr);
1152           strindex = _bfd_stringtab_add (elf_hash_table (info)->dynstr, name,
1153                                          true, false);
1154           if (strindex == (bfd_size_type) -1)
1155             goto error_return;
1156
1157           if (oldsize == _bfd_stringtab_size (elf_hash_table (info)->dynstr))
1158             {
1159               asection *sdyn;
1160               Elf_External_Dyn *dyncon, *dynconend;
1161
1162               /* The hash table size did not change, which means that
1163                  the dynamic object name was already entered.  If we
1164                  have already included this dynamic object in the
1165                  link, just ignore it.  There is no reason to include
1166                  a particular dynamic object more than once.  */
1167               sdyn = bfd_get_section_by_name (elf_hash_table (info)->dynobj,
1168                                               ".dynamic");
1169               BFD_ASSERT (sdyn != NULL);
1170
1171               dyncon = (Elf_External_Dyn *) sdyn->contents;
1172               dynconend = (Elf_External_Dyn *) (sdyn->contents +
1173                                                 sdyn->_raw_size);
1174               for (; dyncon < dynconend; dyncon++)
1175                 {
1176                   Elf_Internal_Dyn dyn;
1177
1178                   elf_swap_dyn_in (elf_hash_table (info)->dynobj, dyncon,
1179                                    &dyn);
1180                   if (dyn.d_tag == DT_NEEDED
1181                       && dyn.d_un.d_val == strindex)
1182                     {
1183                       if (buf != NULL)
1184                         free (buf);
1185                       if (extversym != NULL)
1186                         free (extversym);
1187                       return true;
1188                     }
1189                 }
1190             }
1191
1192           if (! elf_add_dynamic_entry (info, DT_NEEDED, strindex))
1193             goto error_return;
1194         }
1195
1196       /* Save the SONAME, if there is one, because sometimes the
1197          linker emulation code will need to know it.  */
1198       if (*name == '\0')
1199         name = bfd_get_filename (abfd);
1200       elf_dt_name (abfd) = name;
1201     }
1202
1203   if (bfd_seek (abfd,
1204                 hdr->sh_offset + extsymoff * sizeof (Elf_External_Sym),
1205                 SEEK_SET) != 0
1206       || (bfd_read ((PTR) buf, sizeof (Elf_External_Sym), extsymcount, abfd)
1207           != extsymcount * sizeof (Elf_External_Sym)))
1208     goto error_return;
1209
1210   weaks = NULL;
1211
1212   ever = extversym != NULL ? extversym + extsymoff : NULL;
1213   esymend = buf + extsymcount;
1214   for (esym = buf;
1215        esym < esymend;
1216        esym++, sym_hash++, ever = (ever != NULL ? ever + 1 : NULL))
1217     {
1218       Elf_Internal_Sym sym;
1219       int bind;
1220       bfd_vma value;
1221       asection *sec;
1222       flagword flags;
1223       const char *name;
1224       struct elf_link_hash_entry *h;
1225       boolean definition;
1226       boolean size_change_ok, type_change_ok;
1227       boolean new_weakdef;
1228       unsigned int old_alignment;
1229
1230       elf_swap_symbol_in (abfd, esym, &sym);
1231
1232       flags = BSF_NO_FLAGS;
1233       sec = NULL;
1234       value = sym.st_value;
1235       *sym_hash = NULL;
1236
1237       bind = ELF_ST_BIND (sym.st_info);
1238       if (bind == STB_LOCAL)
1239         {
1240           /* This should be impossible, since ELF requires that all
1241              global symbols follow all local symbols, and that sh_info
1242              point to the first global symbol.  Unfortunatealy, Irix 5
1243              screws this up.  */
1244           continue;
1245         }
1246       else if (bind == STB_GLOBAL)
1247         {
1248           if (sym.st_shndx != SHN_UNDEF
1249               && sym.st_shndx != SHN_COMMON)
1250             flags = BSF_GLOBAL;
1251           else
1252             flags = 0;
1253         }
1254       else if (bind == STB_WEAK)
1255         flags = BSF_WEAK;
1256       else
1257         {
1258           /* Leave it up to the processor backend.  */
1259         }
1260
1261       if (sym.st_shndx == SHN_UNDEF)
1262         sec = bfd_und_section_ptr;
1263       else if (sym.st_shndx > 0 && sym.st_shndx < SHN_LORESERVE)
1264         {
1265           sec = section_from_elf_index (abfd, sym.st_shndx);
1266           if (sec == NULL)
1267             sec = bfd_abs_section_ptr;
1268           else if ((abfd->flags & (EXEC_P | DYNAMIC)) != 0)
1269             value -= sec->vma;
1270         }
1271       else if (sym.st_shndx == SHN_ABS)
1272         sec = bfd_abs_section_ptr;
1273       else if (sym.st_shndx == SHN_COMMON)
1274         {
1275           sec = bfd_com_section_ptr;
1276           /* What ELF calls the size we call the value.  What ELF
1277              calls the value we call the alignment.  */
1278           value = sym.st_size;
1279         }
1280       else
1281         {
1282           /* Leave it up to the processor backend.  */
1283         }
1284
1285       name = bfd_elf_string_from_elf_section (abfd, hdr->sh_link, sym.st_name);
1286       if (name == (const char *) NULL)
1287         goto error_return;
1288
1289       if (add_symbol_hook)
1290         {
1291           if (! (*add_symbol_hook) (abfd, info, &sym, &name, &flags, &sec,
1292                                     &value))
1293             goto error_return;
1294
1295           /* The hook function sets the name to NULL if this symbol
1296              should be skipped for some reason.  */
1297           if (name == (const char *) NULL)
1298             continue;
1299         }
1300
1301       /* Sanity check that all possibilities were handled.  */
1302       if (sec == (asection *) NULL)
1303         {
1304           bfd_set_error (bfd_error_bad_value);
1305           goto error_return;
1306         }
1307
1308       if (bfd_is_und_section (sec)
1309           || bfd_is_com_section (sec))
1310         definition = false;
1311       else
1312         definition = true;
1313
1314       size_change_ok = false;
1315       type_change_ok = get_elf_backend_data (abfd)->type_change_ok;
1316       old_alignment = 0;
1317       if (info->hash->creator->flavour == bfd_target_elf_flavour)
1318         {
1319           Elf_Internal_Versym iver;
1320           unsigned int vernum = 0;
1321           boolean override;
1322
1323           if (ever != NULL)
1324             {
1325               _bfd_elf_swap_versym_in (abfd, ever, &iver);
1326               vernum = iver.vs_vers & VERSYM_VERSION;
1327
1328               /* If this is a hidden symbol, or if it is not version
1329                  1, we append the version name to the symbol name.
1330                  However, we do not modify a non-hidden absolute
1331                  symbol, because it might be the version symbol
1332                  itself.  FIXME: What if it isn't?  */
1333               if ((iver.vs_vers & VERSYM_HIDDEN) != 0
1334                   || (vernum > 1 && ! bfd_is_abs_section (sec)))
1335                 {
1336                   const char *verstr;
1337                   int namelen, newlen;
1338                   char *newname, *p;
1339
1340                   if (sym.st_shndx != SHN_UNDEF)
1341                     {
1342                       if (vernum > elf_tdata (abfd)->dynverdef_hdr.sh_info)
1343                         {
1344                           (*_bfd_error_handler)
1345                             (_("%s: %s: invalid version %u (max %d)"),
1346                              bfd_get_filename (abfd), name, vernum,
1347                              elf_tdata (abfd)->dynverdef_hdr.sh_info);
1348                           bfd_set_error (bfd_error_bad_value);
1349                           goto error_return;
1350                         }
1351                       else if (vernum > 1)
1352                         verstr =
1353                           elf_tdata (abfd)->verdef[vernum - 1].vd_nodename;
1354                       else
1355                         verstr = "";
1356                     }
1357                   else
1358                     {
1359                       /* We cannot simply test for the number of
1360                          entries in the VERNEED section since the
1361                          numbers for the needed versions do not start
1362                          at 0.  */
1363                       Elf_Internal_Verneed *t;
1364
1365                       verstr = NULL;
1366                       for (t = elf_tdata (abfd)->verref;
1367                            t != NULL;
1368                            t = t->vn_nextref)
1369                         {
1370                           Elf_Internal_Vernaux *a;
1371
1372                           for (a = t->vn_auxptr; a != NULL; a = a->vna_nextptr)
1373                             {
1374                               if (a->vna_other == vernum)
1375                                 {
1376                                   verstr = a->vna_nodename;
1377                                   break;
1378                                 }
1379                             }
1380                           if (a != NULL)
1381                             break;
1382                         }
1383                       if (verstr == NULL)
1384                         {
1385                           (*_bfd_error_handler)
1386                             (_("%s: %s: invalid needed version %d"),
1387                              bfd_get_filename (abfd), name, vernum);
1388                           bfd_set_error (bfd_error_bad_value);
1389                           goto error_return;
1390                         }
1391                     }
1392
1393                   namelen = strlen (name);
1394                   newlen = namelen + strlen (verstr) + 2;
1395                   if ((iver.vs_vers & VERSYM_HIDDEN) == 0)
1396                     ++newlen;
1397
1398                   newname = (char *) bfd_alloc (abfd, newlen);
1399                   if (newname == NULL)
1400                     goto error_return;
1401                   strcpy (newname, name);
1402                   p = newname + namelen;
1403                   *p++ = ELF_VER_CHR;
1404                   if ((iver.vs_vers & VERSYM_HIDDEN) == 0)
1405                     *p++ = ELF_VER_CHR;
1406                   strcpy (p, verstr);
1407
1408                   name = newname;
1409                 }
1410             }
1411
1412           if (! elf_merge_symbol (abfd, info, name, &sym, &sec, &value,
1413                                   sym_hash, &override, &type_change_ok,
1414                                   &size_change_ok))
1415             goto error_return;
1416
1417           if (override)
1418             definition = false;
1419
1420           h = *sym_hash;
1421           while (h->root.type == bfd_link_hash_indirect
1422                  || h->root.type == bfd_link_hash_warning)
1423             h = (struct elf_link_hash_entry *) h->root.u.i.link;
1424
1425           /* Remember the old alignment if this is a common symbol, so
1426              that we don't reduce the alignment later on.  We can't
1427              check later, because _bfd_generic_link_add_one_symbol
1428              will set a default for the alignment which we want to
1429              override.  */
1430           if (h->root.type == bfd_link_hash_common)
1431             old_alignment = h->root.u.c.p->alignment_power;
1432
1433           if (elf_tdata (abfd)->verdef != NULL
1434               && ! override
1435               && vernum > 1
1436               && definition)
1437             h->verinfo.verdef = &elf_tdata (abfd)->verdef[vernum - 1];
1438         }
1439
1440       if (! (_bfd_generic_link_add_one_symbol
1441              (info, abfd, name, flags, sec, value, (const char *) NULL,
1442               false, collect, (struct bfd_link_hash_entry **) sym_hash)))
1443         goto error_return;
1444
1445       h = *sym_hash;
1446       while (h->root.type == bfd_link_hash_indirect
1447              || h->root.type == bfd_link_hash_warning)
1448         h = (struct elf_link_hash_entry *) h->root.u.i.link;
1449       *sym_hash = h;
1450
1451       new_weakdef = false;
1452       if (dynamic
1453           && definition
1454           && (flags & BSF_WEAK) != 0
1455           && ELF_ST_TYPE (sym.st_info) != STT_FUNC
1456           && info->hash->creator->flavour == bfd_target_elf_flavour
1457           && h->weakdef == NULL)
1458         {
1459           /* Keep a list of all weak defined non function symbols from
1460              a dynamic object, using the weakdef field.  Later in this
1461              function we will set the weakdef field to the correct
1462              value.  We only put non-function symbols from dynamic
1463              objects on this list, because that happens to be the only
1464              time we need to know the normal symbol corresponding to a
1465              weak symbol, and the information is time consuming to
1466              figure out.  If the weakdef field is not already NULL,
1467              then this symbol was already defined by some previous
1468              dynamic object, and we will be using that previous
1469              definition anyhow.  */
1470
1471           h->weakdef = weaks;
1472           weaks = h;
1473           new_weakdef = true;
1474         }
1475
1476       /* Set the alignment of a common symbol.  */
1477       if (sym.st_shndx == SHN_COMMON
1478           && h->root.type == bfd_link_hash_common)
1479         {
1480           unsigned int align;
1481
1482           align = bfd_log2 (sym.st_value);
1483           if (align > old_alignment)
1484             h->root.u.c.p->alignment_power = align;
1485         }
1486
1487       if (info->hash->creator->flavour == bfd_target_elf_flavour)
1488         {
1489           int old_flags;
1490           boolean dynsym;
1491           int new_flag;
1492
1493           /* Remember the symbol size and type.  */
1494           if (sym.st_size != 0
1495               && (definition || h->size == 0))
1496             {
1497               if (h->size != 0 && h->size != sym.st_size && ! size_change_ok)
1498                 (*_bfd_error_handler)
1499                   (_("Warning: size of symbol `%s' changed from %lu to %lu in %s"),
1500                    name, (unsigned long) h->size, (unsigned long) sym.st_size,
1501                    bfd_get_filename (abfd));
1502
1503               h->size = sym.st_size;
1504             }
1505
1506           /* If this is a common symbol, then we always want H->SIZE
1507              to be the size of the common symbol.  The code just above
1508              won't fix the size if a common symbol becomes larger.  We
1509              don't warn about a size change here, because that is
1510              covered by --warn-common.  */
1511           if (h->root.type == bfd_link_hash_common)
1512             h->size = h->root.u.c.size;
1513
1514           if (ELF_ST_TYPE (sym.st_info) != STT_NOTYPE
1515               && (definition || h->type == STT_NOTYPE))
1516             {
1517               if (h->type != STT_NOTYPE
1518                   && h->type != ELF_ST_TYPE (sym.st_info)
1519                   && ! type_change_ok)
1520                 (*_bfd_error_handler)
1521                   (_("Warning: type of symbol `%s' changed from %d to %d in %s"),
1522                    name, h->type, ELF_ST_TYPE (sym.st_info),
1523                    bfd_get_filename (abfd));
1524
1525               h->type = ELF_ST_TYPE (sym.st_info);
1526             }
1527
1528           if (sym.st_other != 0
1529               && (definition || h->other == 0))
1530             h->other = sym.st_other;
1531
1532           /* Set a flag in the hash table entry indicating the type of
1533              reference or definition we just found.  Keep a count of
1534              the number of dynamic symbols we find.  A dynamic symbol
1535              is one which is referenced or defined by both a regular
1536              object and a shared object.  */
1537           old_flags = h->elf_link_hash_flags;
1538           dynsym = false;
1539           if (! dynamic)
1540             {
1541               if (! definition)
1542                 {
1543                   new_flag = ELF_LINK_HASH_REF_REGULAR;
1544                   if (bind != STB_WEAK)
1545                     new_flag |= ELF_LINK_HASH_REF_REGULAR_NONWEAK;
1546                 }
1547               else
1548                 new_flag = ELF_LINK_HASH_DEF_REGULAR;
1549               if (info->shared
1550                   || (old_flags & (ELF_LINK_HASH_DEF_DYNAMIC
1551                                    | ELF_LINK_HASH_REF_DYNAMIC)) != 0)
1552                 dynsym = true;
1553             }
1554           else
1555             {
1556               if (! definition)
1557                 new_flag = ELF_LINK_HASH_REF_DYNAMIC;
1558               else
1559                 new_flag = ELF_LINK_HASH_DEF_DYNAMIC;
1560               if ((old_flags & (ELF_LINK_HASH_DEF_REGULAR
1561                                 | ELF_LINK_HASH_REF_REGULAR)) != 0
1562                   || (h->weakdef != NULL
1563                       && ! new_weakdef
1564                       && h->weakdef->dynindx != -1))
1565                 dynsym = true;
1566             }
1567
1568           h->elf_link_hash_flags |= new_flag;
1569
1570           /* If this symbol has a version, and it is the default
1571              version, we create an indirect symbol from the default
1572              name to the fully decorated name.  This will cause
1573              external references which do not specify a version to be
1574              bound to this version of the symbol.  */
1575           if (definition)
1576             {
1577               char *p;
1578
1579               p = strchr (name, ELF_VER_CHR);
1580               if (p != NULL && p[1] == ELF_VER_CHR)
1581                 {
1582                   char *shortname;
1583                   struct elf_link_hash_entry *hi;
1584                   boolean override;
1585
1586                   shortname = bfd_hash_allocate (&info->hash->table,
1587                                                  p - name + 1);
1588                   if (shortname == NULL)
1589                     goto error_return;
1590                   strncpy (shortname, name, p - name);
1591                   shortname[p - name] = '\0';
1592
1593                   /* We are going to create a new symbol.  Merge it
1594                      with any existing symbol with this name.  For the
1595                      purposes of the merge, act as though we were
1596                      defining the symbol we just defined, although we
1597                      actually going to define an indirect symbol.  */
1598                   type_change_ok = false;
1599                   size_change_ok = false;
1600                   if (! elf_merge_symbol (abfd, info, shortname, &sym, &sec,
1601                                           &value, &hi, &override,
1602                                           &type_change_ok, &size_change_ok))
1603                     goto error_return;
1604
1605                   if (! override)
1606                     {
1607                       if (! (_bfd_generic_link_add_one_symbol
1608                              (info, abfd, shortname, BSF_INDIRECT,
1609                               bfd_ind_section_ptr, (bfd_vma) 0, name, false,
1610                               collect, (struct bfd_link_hash_entry **) &hi)))
1611                         goto error_return;
1612                     }
1613                   else
1614                     {
1615                       /* In this case the symbol named SHORTNAME is
1616                          overriding the indirect symbol we want to
1617                          add.  We were planning on making SHORTNAME an
1618                          indirect symbol referring to NAME.  SHORTNAME
1619                          is the name without a version.  NAME is the
1620                          fully versioned name, and it is the default
1621                          version.
1622
1623                          Overriding means that we already saw a
1624                          definition for the symbol SHORTNAME in a
1625                          regular object, and it is overriding the
1626                          symbol defined in the dynamic object.
1627
1628                          When this happens, we actually want to change
1629                          NAME, the symbol we just added, to refer to
1630                          SHORTNAME.  This will cause references to
1631                          NAME in the shared object to become
1632                          references to SHORTNAME in the regular
1633                          object.  This is what we expect when we
1634                          override a function in a shared object: that
1635                          the references in the shared object will be
1636                          mapped to the definition in the regular
1637                          object.  */
1638
1639                       while (hi->root.type == bfd_link_hash_indirect
1640                              || hi->root.type == bfd_link_hash_warning)
1641                         hi = (struct elf_link_hash_entry *) hi->root.u.i.link;
1642
1643                       h->root.type = bfd_link_hash_indirect;
1644                       h->root.u.i.link = (struct bfd_link_hash_entry *) hi;
1645                       if (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC)
1646                         {
1647                           h->elf_link_hash_flags &=~ ELF_LINK_HASH_DEF_DYNAMIC;
1648                           hi->elf_link_hash_flags |= ELF_LINK_HASH_REF_DYNAMIC;
1649                           if (hi->elf_link_hash_flags
1650                               & (ELF_LINK_HASH_REF_REGULAR
1651                                  | ELF_LINK_HASH_DEF_REGULAR))
1652                             {
1653                               if (! _bfd_elf_link_record_dynamic_symbol (info,
1654                                                                          hi))
1655                                 goto error_return;
1656                             }
1657                         }
1658
1659                       /* Now set HI to H, so that the following code
1660                          will set the other fields correctly.  */
1661                       hi = h;
1662                     }
1663
1664                   /* If there is a duplicate definition somewhere,
1665                      then HI may not point to an indirect symbol.  We
1666                      will have reported an error to the user in that
1667                      case.  */
1668
1669                   if (hi->root.type == bfd_link_hash_indirect)
1670                     {
1671                       struct elf_link_hash_entry *ht;
1672
1673                       /* If the symbol became indirect, then we assume
1674                          that we have not seen a definition before.  */
1675                       BFD_ASSERT ((hi->elf_link_hash_flags
1676                                    & (ELF_LINK_HASH_DEF_DYNAMIC
1677                                       | ELF_LINK_HASH_DEF_REGULAR))
1678                                   == 0);
1679
1680                       ht = (struct elf_link_hash_entry *) hi->root.u.i.link;
1681
1682                       /* Copy down any references that we may have
1683                          already seen to the symbol which just became
1684                          indirect.  */
1685                       ht->elf_link_hash_flags |=
1686                         (hi->elf_link_hash_flags
1687                          & (ELF_LINK_HASH_REF_DYNAMIC
1688                             | ELF_LINK_HASH_REF_REGULAR
1689                             | ELF_LINK_HASH_REF_REGULAR_NONWEAK
1690                             | ELF_LINK_NON_GOT_REF));
1691
1692                       /* Copy over the global and procedure linkage table
1693                          offset entries.  These may have been already set
1694                          up by a check_relocs routine.  */
1695                       if (ht->got.offset == (bfd_vma) -1)
1696                         {
1697                           ht->got.offset = hi->got.offset;
1698                           hi->got.offset = (bfd_vma) -1;
1699                         }
1700                       BFD_ASSERT (hi->got.offset == (bfd_vma) -1);
1701
1702                       if (ht->plt.offset == (bfd_vma) -1)
1703                         {
1704                           ht->plt.offset = hi->plt.offset;
1705                           hi->plt.offset = (bfd_vma) -1;
1706                         }
1707                       BFD_ASSERT (hi->plt.offset == (bfd_vma) -1);
1708
1709                       if (ht->dynindx == -1)
1710                         {
1711                           ht->dynindx = hi->dynindx;
1712                           ht->dynstr_index = hi->dynstr_index;
1713                           hi->dynindx = -1;
1714                           hi->dynstr_index = 0;
1715                         }
1716                       BFD_ASSERT (hi->dynindx == -1);
1717
1718                       /* FIXME: There may be other information to copy
1719                          over for particular targets.  */
1720
1721                       /* See if the new flags lead us to realize that
1722                          the symbol must be dynamic.  */
1723                       if (! dynsym)
1724                         {
1725                           if (! dynamic)
1726                             {
1727                               if (info->shared
1728                                   || ((hi->elf_link_hash_flags
1729                                        & ELF_LINK_HASH_REF_DYNAMIC)
1730                                       != 0))
1731                                 dynsym = true;
1732                             }
1733                           else
1734                             {
1735                               if ((hi->elf_link_hash_flags
1736                                    & ELF_LINK_HASH_REF_REGULAR) != 0)
1737                                 dynsym = true;
1738                             }
1739                         }
1740                     }
1741
1742                   /* We also need to define an indirection from the
1743                      nondefault version of the symbol.  */
1744
1745                   shortname = bfd_hash_allocate (&info->hash->table,
1746                                                  strlen (name));
1747                   if (shortname == NULL)
1748                     goto error_return;
1749                   strncpy (shortname, name, p - name);
1750                   strcpy (shortname + (p - name), p + 1);
1751
1752                   /* Once again, merge with any existing symbol.  */
1753                   type_change_ok = false;
1754                   size_change_ok = false;
1755                   if (! elf_merge_symbol (abfd, info, shortname, &sym, &sec,
1756                                           &value, &hi, &override,
1757                                           &type_change_ok, &size_change_ok))
1758                     goto error_return;
1759
1760                   if (override)
1761                     {
1762                       /* Here SHORTNAME is a versioned name, so we
1763                          don't expect to see the type of override we
1764                          do in the case above.  */
1765                       (*_bfd_error_handler)
1766                         (_("%s: warning: unexpected redefinition of `%s'"),
1767                          bfd_get_filename (abfd), shortname);
1768                     }
1769                   else
1770                     {
1771                       if (! (_bfd_generic_link_add_one_symbol
1772                              (info, abfd, shortname, BSF_INDIRECT,
1773                               bfd_ind_section_ptr, (bfd_vma) 0, name, false,
1774                               collect, (struct bfd_link_hash_entry **) &hi)))
1775                         goto error_return;
1776
1777                       /* If there is a duplicate definition somewhere,
1778                          then HI may not point to an indirect symbol.
1779                          We will have reported an error to the user in
1780                          that case.  */
1781
1782                       if (hi->root.type == bfd_link_hash_indirect)
1783                         {
1784                           /* If the symbol became indirect, then we
1785                              assume that we have not seen a definition
1786                              before.  */
1787                           BFD_ASSERT ((hi->elf_link_hash_flags
1788                                        & (ELF_LINK_HASH_DEF_DYNAMIC
1789                                           | ELF_LINK_HASH_DEF_REGULAR))
1790                                       == 0);
1791
1792                           /* Copy down any references that we may have
1793                              already seen to the symbol which just
1794                              became indirect.  */
1795                           h->elf_link_hash_flags |=
1796                             (hi->elf_link_hash_flags
1797                              & (ELF_LINK_HASH_REF_DYNAMIC
1798                                 | ELF_LINK_HASH_REF_REGULAR
1799                                 | ELF_LINK_HASH_REF_REGULAR_NONWEAK
1800                                 | ELF_LINK_NON_GOT_REF));
1801
1802                           /* Copy over the global and procedure linkage
1803                              table offset entries.  These may have been
1804                              already set up by a check_relocs routine.  */
1805                           if (h->got.offset == (bfd_vma) -1)
1806                             {
1807                               h->got.offset = hi->got.offset;
1808                               hi->got.offset = (bfd_vma) -1;
1809                             }
1810                           BFD_ASSERT (hi->got.offset == (bfd_vma) -1);
1811
1812                           if (h->plt.offset == (bfd_vma) -1)
1813                             {
1814                               h->plt.offset = hi->plt.offset;
1815                               hi->plt.offset = (bfd_vma) -1;
1816                             }
1817                           BFD_ASSERT (hi->got.offset == (bfd_vma) -1);
1818
1819                           if (h->dynindx == -1)
1820                             {
1821                               h->dynindx = hi->dynindx;
1822                               h->dynstr_index = hi->dynstr_index;
1823                               hi->dynindx = -1;
1824                               hi->dynstr_index = 0;
1825                             }
1826                           BFD_ASSERT (hi->dynindx == -1);
1827
1828                           /* FIXME: There may be other information to
1829                              copy over for particular targets.  */
1830
1831                           /* See if the new flags lead us to realize
1832                              that the symbol must be dynamic.  */
1833                           if (! dynsym)
1834                             {
1835                               if (! dynamic)
1836                                 {
1837                                   if (info->shared
1838                                       || ((hi->elf_link_hash_flags
1839                                            & ELF_LINK_HASH_REF_DYNAMIC)
1840                                           != 0))
1841                                     dynsym = true;
1842                                 }
1843                               else
1844                                 {
1845                                   if ((hi->elf_link_hash_flags
1846                                        & ELF_LINK_HASH_REF_REGULAR) != 0)
1847                                     dynsym = true;
1848                                 }
1849                             }
1850                         }
1851                     }
1852                 }
1853             }
1854
1855           if (dynsym && h->dynindx == -1)
1856             {
1857               if (! _bfd_elf_link_record_dynamic_symbol (info, h))
1858                 goto error_return;
1859               if (h->weakdef != NULL
1860                   && ! new_weakdef
1861                   && h->weakdef->dynindx == -1)
1862                 {
1863                   if (! _bfd_elf_link_record_dynamic_symbol (info,
1864                                                              h->weakdef))
1865                     goto error_return;
1866                 }
1867             }
1868         }
1869     }
1870
1871   /* Now set the weakdefs field correctly for all the weak defined
1872      symbols we found.  The only way to do this is to search all the
1873      symbols.  Since we only need the information for non functions in
1874      dynamic objects, that's the only time we actually put anything on
1875      the list WEAKS.  We need this information so that if a regular
1876      object refers to a symbol defined weakly in a dynamic object, the
1877      real symbol in the dynamic object is also put in the dynamic
1878      symbols; we also must arrange for both symbols to point to the
1879      same memory location.  We could handle the general case of symbol
1880      aliasing, but a general symbol alias can only be generated in
1881      assembler code, handling it correctly would be very time
1882      consuming, and other ELF linkers don't handle general aliasing
1883      either.  */
1884   while (weaks != NULL)
1885     {
1886       struct elf_link_hash_entry *hlook;
1887       asection *slook;
1888       bfd_vma vlook;
1889       struct elf_link_hash_entry **hpp;
1890       struct elf_link_hash_entry **hppend;
1891
1892       hlook = weaks;
1893       weaks = hlook->weakdef;
1894       hlook->weakdef = NULL;
1895
1896       BFD_ASSERT (hlook->root.type == bfd_link_hash_defined
1897                   || hlook->root.type == bfd_link_hash_defweak
1898                   || hlook->root.type == bfd_link_hash_common
1899                   || hlook->root.type == bfd_link_hash_indirect);
1900       slook = hlook->root.u.def.section;
1901       vlook = hlook->root.u.def.value;
1902
1903       hpp = elf_sym_hashes (abfd);
1904       hppend = hpp + extsymcount;
1905       for (; hpp < hppend; hpp++)
1906         {
1907           struct elf_link_hash_entry *h;
1908
1909           h = *hpp;
1910           if (h != NULL && h != hlook
1911               && h->root.type == bfd_link_hash_defined
1912               && h->root.u.def.section == slook
1913               && h->root.u.def.value == vlook)
1914             {
1915               hlook->weakdef = h;
1916
1917               /* If the weak definition is in the list of dynamic
1918                  symbols, make sure the real definition is put there
1919                  as well.  */
1920               if (hlook->dynindx != -1
1921                   && h->dynindx == -1)
1922                 {
1923                   if (! _bfd_elf_link_record_dynamic_symbol (info, h))
1924                     goto error_return;
1925                 }
1926
1927               /* If the real definition is in the list of dynamic
1928                  symbols, make sure the weak definition is put there
1929                  as well.  If we don't do this, then the dynamic
1930                  loader might not merge the entries for the real
1931                  definition and the weak definition.  */
1932               if (h->dynindx != -1
1933                   && hlook->dynindx == -1)
1934                 {
1935                   if (! _bfd_elf_link_record_dynamic_symbol (info, hlook))
1936                     goto error_return;
1937                 }
1938
1939               break;
1940             }
1941         }
1942     }
1943
1944   if (buf != NULL)
1945     {
1946       free (buf);
1947       buf = NULL;
1948     }
1949
1950   if (extversym != NULL)
1951     {
1952       free (extversym);
1953       extversym = NULL;
1954     }
1955
1956   /* If this object is the same format as the output object, and it is
1957      not a shared library, then let the backend look through the
1958      relocs.
1959
1960      This is required to build global offset table entries and to
1961      arrange for dynamic relocs.  It is not required for the
1962      particular common case of linking non PIC code, even when linking
1963      against shared libraries, but unfortunately there is no way of
1964      knowing whether an object file has been compiled PIC or not.
1965      Looking through the relocs is not particularly time consuming.
1966      The problem is that we must either (1) keep the relocs in memory,
1967      which causes the linker to require additional runtime memory or
1968      (2) read the relocs twice from the input file, which wastes time.
1969      This would be a good case for using mmap.
1970
1971      I have no idea how to handle linking PIC code into a file of a
1972      different format.  It probably can't be done.  */
1973   check_relocs = get_elf_backend_data (abfd)->check_relocs;
1974   if (! dynamic
1975       && abfd->xvec == info->hash->creator
1976       && check_relocs != NULL)
1977     {
1978       asection *o;
1979
1980       for (o = abfd->sections; o != NULL; o = o->next)
1981         {
1982           Elf_Internal_Rela *internal_relocs;
1983           boolean ok;
1984
1985           if ((o->flags & SEC_RELOC) == 0
1986               || o->reloc_count == 0
1987               || ((info->strip == strip_all || info->strip == strip_debugger)
1988                   && (o->flags & SEC_DEBUGGING) != 0)
1989               || bfd_is_abs_section (o->output_section))
1990             continue;
1991
1992           internal_relocs = (NAME(_bfd_elf,link_read_relocs)
1993                              (abfd, o, (PTR) NULL,
1994                               (Elf_Internal_Rela *) NULL,
1995                               info->keep_memory));
1996           if (internal_relocs == NULL)
1997             goto error_return;
1998
1999           ok = (*check_relocs) (abfd, info, o, internal_relocs);
2000
2001           if (! info->keep_memory)
2002             free (internal_relocs);
2003
2004           if (! ok)
2005             goto error_return;
2006         }
2007     }
2008
2009   /* If this is a non-traditional, non-relocateable link, try to
2010      optimize the handling of the .stab/.stabstr sections.  */
2011   if (! dynamic
2012       && ! info->relocateable
2013       && ! info->traditional_format
2014       && info->hash->creator->flavour == bfd_target_elf_flavour
2015       && (info->strip != strip_all && info->strip != strip_debugger))
2016     {
2017       asection *stab, *stabstr;
2018
2019       stab = bfd_get_section_by_name (abfd, ".stab");
2020       if (stab != NULL)
2021         {
2022           stabstr = bfd_get_section_by_name (abfd, ".stabstr");
2023
2024           if (stabstr != NULL)
2025             {
2026               struct bfd_elf_section_data *secdata;
2027
2028               secdata = elf_section_data (stab);
2029               if (! _bfd_link_section_stabs (abfd,
2030                                              &elf_hash_table (info)->stab_info,
2031                                              stab, stabstr,
2032                                              &secdata->stab_info))
2033                 goto error_return;
2034             }
2035         }
2036     }
2037
2038   return true;
2039
2040  error_return:
2041   if (buf != NULL)
2042     free (buf);
2043   if (dynbuf != NULL)
2044     free (dynbuf);
2045   if (dynver != NULL)
2046     free (dynver);
2047   if (extversym != NULL)
2048     free (extversym);
2049   return false;
2050 }
2051
2052 /* Create some sections which will be filled in with dynamic linking
2053    information.  ABFD is an input file which requires dynamic sections
2054    to be created.  The dynamic sections take up virtual memory space
2055    when the final executable is run, so we need to create them before
2056    addresses are assigned to the output sections.  We work out the
2057    actual contents and size of these sections later.  */
2058
2059 boolean
2060 elf_link_create_dynamic_sections (abfd, info)
2061      bfd *abfd;
2062      struct bfd_link_info *info;
2063 {
2064   flagword flags;
2065   register asection *s;
2066   struct elf_link_hash_entry *h;
2067   struct elf_backend_data *bed;
2068
2069   if (elf_hash_table (info)->dynamic_sections_created)
2070     return true;
2071
2072   /* Make sure that all dynamic sections use the same input BFD.  */
2073   if (elf_hash_table (info)->dynobj == NULL)
2074     elf_hash_table (info)->dynobj = abfd;
2075   else
2076     abfd = elf_hash_table (info)->dynobj;
2077
2078   /* Note that we set the SEC_IN_MEMORY flag for all of these
2079      sections.  */
2080   flags = (SEC_ALLOC | SEC_LOAD | SEC_HAS_CONTENTS
2081            | SEC_IN_MEMORY | SEC_LINKER_CREATED);
2082
2083   /* A dynamically linked executable has a .interp section, but a
2084      shared library does not.  */
2085   if (! info->shared)
2086     {
2087       s = bfd_make_section (abfd, ".interp");
2088       if (s == NULL
2089           || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY))
2090         return false;
2091     }
2092
2093   /* Create sections to hold version informations.  These are removed
2094      if they are not needed.  */
2095   s = bfd_make_section (abfd, ".gnu.version_d");
2096   if (s == NULL
2097       || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY)
2098       || ! bfd_set_section_alignment (abfd, s, LOG_FILE_ALIGN))
2099     return false;
2100
2101   s = bfd_make_section (abfd, ".gnu.version");
2102   if (s == NULL
2103       || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY)
2104       || ! bfd_set_section_alignment (abfd, s, 1))
2105     return false;
2106
2107   s = bfd_make_section (abfd, ".gnu.version_r");
2108   if (s == NULL
2109       || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY)
2110       || ! bfd_set_section_alignment (abfd, s, LOG_FILE_ALIGN))
2111     return false;
2112
2113   s = bfd_make_section (abfd, ".dynsym");
2114   if (s == NULL
2115       || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY)
2116       || ! bfd_set_section_alignment (abfd, s, LOG_FILE_ALIGN))
2117     return false;
2118
2119   s = bfd_make_section (abfd, ".dynstr");
2120   if (s == NULL
2121       || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY))
2122     return false;
2123
2124   /* Create a strtab to hold the dynamic symbol names.  */
2125   if (elf_hash_table (info)->dynstr == NULL)
2126     {
2127       elf_hash_table (info)->dynstr = elf_stringtab_init ();
2128       if (elf_hash_table (info)->dynstr == NULL)
2129         return false;
2130     }
2131
2132   s = bfd_make_section (abfd, ".dynamic");
2133   if (s == NULL
2134       || ! bfd_set_section_flags (abfd, s, flags)
2135       || ! bfd_set_section_alignment (abfd, s, LOG_FILE_ALIGN))
2136     return false;
2137
2138   /* The special symbol _DYNAMIC is always set to the start of the
2139      .dynamic section.  This call occurs before we have processed the
2140      symbols for any dynamic object, so we don't have to worry about
2141      overriding a dynamic definition.  We could set _DYNAMIC in a
2142      linker script, but we only want to define it if we are, in fact,
2143      creating a .dynamic section.  We don't want to define it if there
2144      is no .dynamic section, since on some ELF platforms the start up
2145      code examines it to decide how to initialize the process.  */
2146   h = NULL;
2147   if (! (_bfd_generic_link_add_one_symbol
2148          (info, abfd, "_DYNAMIC", BSF_GLOBAL, s, (bfd_vma) 0,
2149           (const char *) NULL, false, get_elf_backend_data (abfd)->collect,
2150           (struct bfd_link_hash_entry **) &h)))
2151     return false;
2152   h->elf_link_hash_flags |= ELF_LINK_HASH_DEF_REGULAR;
2153   h->type = STT_OBJECT;
2154
2155   if (info->shared
2156       && ! _bfd_elf_link_record_dynamic_symbol (info, h))
2157     return false;
2158
2159   bed = get_elf_backend_data (abfd);
2160
2161   s = bfd_make_section (abfd, ".hash");
2162   if (s == NULL
2163       || ! bfd_set_section_flags (abfd, s, flags | SEC_READONLY)
2164       || ! bfd_set_section_alignment (abfd, s, LOG_FILE_ALIGN))
2165     return false;
2166   elf_section_data (s)->this_hdr.sh_entsize = bed->s->sizeof_hash_entry;
2167
2168   /* Let the backend create the rest of the sections.  This lets the
2169      backend set the right flags.  The backend will normally create
2170      the .got and .plt sections.  */
2171   if (! (*bed->elf_backend_create_dynamic_sections) (abfd, info))
2172     return false;
2173
2174   elf_hash_table (info)->dynamic_sections_created = true;
2175
2176   return true;
2177 }
2178
2179 /* Add an entry to the .dynamic table.  */
2180
2181 boolean
2182 elf_add_dynamic_entry (info, tag, val)
2183      struct bfd_link_info *info;
2184      bfd_vma tag;
2185      bfd_vma val;
2186 {
2187   Elf_Internal_Dyn dyn;
2188   bfd *dynobj;
2189   asection *s;
2190   size_t newsize;
2191   bfd_byte *newcontents;
2192
2193   dynobj = elf_hash_table (info)->dynobj;
2194
2195   s = bfd_get_section_by_name (dynobj, ".dynamic");
2196   BFD_ASSERT (s != NULL);
2197
2198   newsize = s->_raw_size + sizeof (Elf_External_Dyn);
2199   newcontents = (bfd_byte *) bfd_realloc (s->contents, newsize);
2200   if (newcontents == NULL)
2201     return false;
2202
2203   dyn.d_tag = tag;
2204   dyn.d_un.d_val = val;
2205   elf_swap_dyn_out (dynobj, &dyn,
2206                     (Elf_External_Dyn *) (newcontents + s->_raw_size));
2207
2208   s->_raw_size = newsize;
2209   s->contents = newcontents;
2210
2211   return true;
2212 }
2213
2214 /* Record a new local dynamic symbol.  */
2215
2216 boolean
2217 elf_link_record_local_dynamic_symbol (info, input_bfd, input_indx)
2218      struct bfd_link_info *info;
2219      bfd *input_bfd;
2220      long input_indx;
2221 {
2222   struct elf_link_local_dynamic_entry *entry;
2223   struct elf_link_hash_table *eht;
2224   struct bfd_strtab_hash *dynstr;
2225   Elf_External_Sym esym;
2226   unsigned long dynstr_index;
2227   char *name;
2228
2229   /* See if the entry exists already.  */
2230   for (entry = elf_hash_table (info)->dynlocal; entry ; entry = entry->next)
2231     if (entry->input_bfd == input_bfd && entry->input_indx == input_indx)
2232       return true;
2233
2234   entry = (struct elf_link_local_dynamic_entry *)
2235     bfd_alloc (input_bfd, sizeof (*entry));
2236   if (entry == NULL)
2237     return false;
2238
2239   /* Go find the symbol, so that we can find it's name.  */
2240   if (bfd_seek (input_bfd,
2241                 (elf_tdata (input_bfd)->symtab_hdr.sh_offset
2242                  + input_indx * sizeof (Elf_External_Sym)),
2243                 SEEK_SET) != 0
2244       || (bfd_read (&esym, sizeof (Elf_External_Sym), 1, input_bfd)
2245           != sizeof (Elf_External_Sym)))
2246     return false;
2247   elf_swap_symbol_in (input_bfd, &esym, &entry->isym);
2248
2249   name = (bfd_elf_string_from_elf_section
2250           (input_bfd, elf_tdata (input_bfd)->symtab_hdr.sh_link,
2251            entry->isym.st_name));
2252
2253   dynstr = elf_hash_table (info)->dynstr;
2254   if (dynstr == NULL)
2255     {
2256       /* Create a strtab to hold the dynamic symbol names.  */
2257       elf_hash_table (info)->dynstr = dynstr = _bfd_elf_stringtab_init ();
2258       if (dynstr == NULL)
2259         return false;
2260     }
2261
2262   dynstr_index = _bfd_stringtab_add (dynstr, name, true, false);
2263   if (dynstr_index == (unsigned long) -1)
2264     return false;
2265   entry->isym.st_name = dynstr_index;
2266
2267   eht = elf_hash_table (info);
2268
2269   entry->next = eht->dynlocal;
2270   eht->dynlocal = entry;
2271   entry->input_bfd = input_bfd;
2272   entry->input_indx = input_indx;
2273   eht->dynsymcount++;
2274
2275   /* Whatever binding the symbol had before, it's now local.  */
2276   entry->isym.st_info
2277     = ELF_ST_INFO (STB_LOCAL, ELF_ST_TYPE (entry->isym.st_info));
2278
2279   /* The dynindx will be set at the end of size_dynamic_sections.  */
2280
2281   return true;
2282 }
2283 \f
2284
2285 /* Read and swap the relocs from the section indicated by SHDR.  This
2286    may be either a REL or a RELA section.  The relocations are
2287    translated into RELA relocations and stored in INTERNAL_RELOCS,
2288    which should have already been allocated to contain enough space.
2289    The EXTERNAL_RELOCS are a buffer where the external form of the
2290    relocations should be stored.
2291
2292    Returns false if something goes wrong.  */
2293
2294 static boolean
2295 elf_link_read_relocs_from_section (abfd, shdr, external_relocs,
2296                                    internal_relocs)
2297      bfd *abfd;
2298      Elf_Internal_Shdr *shdr;
2299      PTR external_relocs;
2300      Elf_Internal_Rela *internal_relocs;
2301 {
2302   struct elf_backend_data *bed;
2303
2304   /* If there aren't any relocations, that's OK.  */
2305   if (!shdr)
2306     return true;
2307
2308   /* Position ourselves at the start of the section.  */
2309   if (bfd_seek (abfd, shdr->sh_offset, SEEK_SET) != 0)
2310     return false;
2311
2312   /* Read the relocations.  */
2313   if (bfd_read (external_relocs, 1, shdr->sh_size, abfd)
2314       != shdr->sh_size)
2315     return false;
2316
2317   bed = get_elf_backend_data (abfd);
2318
2319   /* Convert the external relocations to the internal format.  */
2320   if (shdr->sh_entsize == sizeof (Elf_External_Rel))
2321     {
2322       Elf_External_Rel *erel;
2323       Elf_External_Rel *erelend;
2324       Elf_Internal_Rela *irela;
2325       Elf_Internal_Rel *irel;
2326
2327       erel = (Elf_External_Rel *) external_relocs;
2328       erelend = erel + shdr->sh_size / shdr->sh_entsize;
2329       irela = internal_relocs;
2330       irel = bfd_alloc (abfd, (bed->s->int_rels_per_ext_rel
2331                                * sizeof (Elf_Internal_Rel)));
2332       for (; erel < erelend; erel++, irela += bed->s->int_rels_per_ext_rel)
2333         {
2334           unsigned char i;
2335
2336           if (bed->s->swap_reloc_in)
2337             (*bed->s->swap_reloc_in) (abfd, (bfd_byte *) erel, irel);
2338           else
2339             elf_swap_reloc_in (abfd, erel, irel);
2340
2341           for (i = 0; i < bed->s->int_rels_per_ext_rel; ++i)
2342             {
2343               irela[i].r_offset = irel[i].r_offset;
2344               irela[i].r_info = irel[i].r_info;
2345               irela[i].r_addend = 0;
2346             }
2347         }
2348     }
2349   else
2350     {
2351       Elf_External_Rela *erela;
2352       Elf_External_Rela *erelaend;
2353       Elf_Internal_Rela *irela;
2354
2355       BFD_ASSERT (shdr->sh_entsize == sizeof (Elf_External_Rela));
2356
2357       erela = (Elf_External_Rela *) external_relocs;
2358       erelaend = erela + shdr->sh_size / shdr->sh_entsize;
2359       irela = internal_relocs;
2360       for (; erela < erelaend; erela++, irela += bed->s->int_rels_per_ext_rel)
2361         {
2362           if (bed->s->swap_reloca_in)
2363             (*bed->s->swap_reloca_in) (abfd, (bfd_byte *) erela, irela);
2364           else
2365             elf_swap_reloca_in (abfd, erela, irela);
2366         }
2367     }
2368
2369   return true;
2370 }
2371
2372 /* Read and swap the relocs for a section O.  They may have been
2373    cached.  If the EXTERNAL_RELOCS and INTERNAL_RELOCS arguments are
2374    not NULL, they are used as buffers to read into.  They are known to
2375    be large enough.  If the INTERNAL_RELOCS relocs argument is NULL,
2376    the return value is allocated using either malloc or bfd_alloc,
2377    according to the KEEP_MEMORY argument.  If O has two relocation
2378    sections (both REL and RELA relocations), then the REL_HDR
2379    relocations will appear first in INTERNAL_RELOCS, followed by the
2380    REL_HDR2 relocations.  */
2381
2382 Elf_Internal_Rela *
2383 NAME(_bfd_elf,link_read_relocs) (abfd, o, external_relocs, internal_relocs,
2384                                  keep_memory)
2385      bfd *abfd;
2386      asection *o;
2387      PTR external_relocs;
2388      Elf_Internal_Rela *internal_relocs;
2389      boolean keep_memory;
2390 {
2391   Elf_Internal_Shdr *rel_hdr;
2392   PTR alloc1 = NULL;
2393   Elf_Internal_Rela *alloc2 = NULL;
2394   struct elf_backend_data *bed = get_elf_backend_data (abfd);
2395
2396   if (elf_section_data (o)->relocs != NULL)
2397     return elf_section_data (o)->relocs;
2398
2399   if (o->reloc_count == 0)
2400     return NULL;
2401
2402   rel_hdr = &elf_section_data (o)->rel_hdr;
2403
2404   if (internal_relocs == NULL)
2405     {
2406       size_t size;
2407
2408       size = (o->reloc_count * bed->s->int_rels_per_ext_rel 
2409               * sizeof (Elf_Internal_Rela));
2410       if (keep_memory)
2411         internal_relocs = (Elf_Internal_Rela *) bfd_alloc (abfd, size);
2412       else
2413         internal_relocs = alloc2 = (Elf_Internal_Rela *) bfd_malloc (size);
2414       if (internal_relocs == NULL)
2415         goto error_return;
2416     }
2417
2418   if (external_relocs == NULL)
2419     {
2420       size_t size = (size_t) rel_hdr->sh_size;
2421
2422       if (elf_section_data (o)->rel_hdr2)
2423         size += (size_t) elf_section_data (o)->rel_hdr2->sh_size;
2424       alloc1 = (PTR) bfd_malloc (size);
2425       if (alloc1 == NULL)
2426         goto error_return;
2427       external_relocs = alloc1;
2428     }
2429
2430   if (!elf_link_read_relocs_from_section (abfd, rel_hdr,
2431                                           external_relocs,
2432                                           internal_relocs))
2433     goto error_return;
2434   if (!elf_link_read_relocs_from_section 
2435       (abfd, 
2436        elf_section_data (o)->rel_hdr2,
2437        ((bfd_byte *) external_relocs) + rel_hdr->sh_size,
2438        internal_relocs + (rel_hdr->sh_size / rel_hdr->sh_entsize
2439                           * bed->s->int_rels_per_ext_rel)))
2440     goto error_return;
2441
2442   /* Cache the results for next time, if we can.  */
2443   if (keep_memory)
2444     elf_section_data (o)->relocs = internal_relocs;
2445
2446   if (alloc1 != NULL)
2447     free (alloc1);
2448
2449   /* Don't free alloc2, since if it was allocated we are passing it
2450      back (under the name of internal_relocs).  */
2451
2452   return internal_relocs;
2453
2454  error_return:
2455   if (alloc1 != NULL)
2456     free (alloc1);
2457   if (alloc2 != NULL)
2458     free (alloc2);
2459   return NULL;
2460 }
2461 \f
2462
2463 /* Record an assignment to a symbol made by a linker script.  We need
2464    this in case some dynamic object refers to this symbol.  */
2465
2466 /*ARGSUSED*/
2467 boolean
2468 NAME(bfd_elf,record_link_assignment) (output_bfd, info, name, provide)
2469      bfd *output_bfd ATTRIBUTE_UNUSED;
2470      struct bfd_link_info *info;
2471      const char *name;
2472      boolean provide;
2473 {
2474   struct elf_link_hash_entry *h;
2475
2476   if (info->hash->creator->flavour != bfd_target_elf_flavour)
2477     return true;
2478
2479   h = elf_link_hash_lookup (elf_hash_table (info), name, true, true, false);
2480   if (h == NULL)
2481     return false;
2482
2483   if (h->root.type == bfd_link_hash_new)
2484     h->elf_link_hash_flags &=~ ELF_LINK_NON_ELF;
2485
2486   /* If this symbol is being provided by the linker script, and it is
2487      currently defined by a dynamic object, but not by a regular
2488      object, then mark it as undefined so that the generic linker will
2489      force the correct value.  */
2490   if (provide
2491       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0
2492       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0)
2493     h->root.type = bfd_link_hash_undefined;
2494
2495   /* If this symbol is not being provided by the linker script, and it is
2496      currently defined by a dynamic object, but not by a regular object,
2497      then clear out any version information because the symbol will not be
2498      associated with the dynamic object any more.  */
2499   if (!provide
2500       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0
2501       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0)
2502     h->verinfo.verdef = NULL;
2503
2504   h->elf_link_hash_flags |= ELF_LINK_HASH_DEF_REGULAR;
2505
2506   /* When possible, keep the original type of the symbol */
2507   if (h->type == STT_NOTYPE)
2508     h->type = STT_OBJECT;
2509
2510   if (((h->elf_link_hash_flags & (ELF_LINK_HASH_DEF_DYNAMIC
2511                                   | ELF_LINK_HASH_REF_DYNAMIC)) != 0
2512        || info->shared)
2513       && h->dynindx == -1)
2514     {
2515       if (! _bfd_elf_link_record_dynamic_symbol (info, h))
2516         return false;
2517
2518       /* If this is a weak defined symbol, and we know a corresponding
2519          real symbol from the same dynamic object, make sure the real
2520          symbol is also made into a dynamic symbol.  */
2521       if (h->weakdef != NULL
2522           && h->weakdef->dynindx == -1)
2523         {
2524           if (! _bfd_elf_link_record_dynamic_symbol (info, h->weakdef))
2525             return false;
2526         }
2527     }
2528
2529   return true;
2530 }
2531 \f
2532 /* This structure is used to pass information to
2533    elf_link_assign_sym_version.  */
2534
2535 struct elf_assign_sym_version_info
2536 {
2537   /* Output BFD.  */
2538   bfd *output_bfd;
2539   /* General link information.  */
2540   struct bfd_link_info *info;
2541   /* Version tree.  */
2542   struct bfd_elf_version_tree *verdefs;
2543   /* Whether we are exporting all dynamic symbols.  */
2544   boolean export_dynamic;
2545   /* Whether we had a failure.  */
2546   boolean failed;
2547 };
2548
2549 /* This structure is used to pass information to
2550    elf_link_find_version_dependencies.  */
2551
2552 struct elf_find_verdep_info
2553 {
2554   /* Output BFD.  */
2555   bfd *output_bfd;
2556   /* General link information.  */
2557   struct bfd_link_info *info;
2558   /* The number of dependencies.  */
2559   unsigned int vers;
2560   /* Whether we had a failure.  */
2561   boolean failed;
2562 };
2563
2564 /* Array used to determine the number of hash table buckets to use
2565    based on the number of symbols there are.  If there are fewer than
2566    3 symbols we use 1 bucket, fewer than 17 symbols we use 3 buckets,
2567    fewer than 37 we use 17 buckets, and so forth.  We never use more
2568    than 32771 buckets.  */
2569
2570 static const size_t elf_buckets[] =
2571 {
2572   1, 3, 17, 37, 67, 97, 131, 197, 263, 521, 1031, 2053, 4099, 8209,
2573   16411, 32771, 0
2574 };
2575
2576 /* Compute bucket count for hashing table.  We do not use a static set
2577    of possible tables sizes anymore.  Instead we determine for all
2578    possible reasonable sizes of the table the outcome (i.e., the
2579    number of collisions etc) and choose the best solution.  The
2580    weighting functions are not too simple to allow the table to grow
2581    without bounds.  Instead one of the weighting factors is the size.
2582    Therefore the result is always a good payoff between few collisions
2583    (= short chain lengths) and table size.  */
2584 static size_t
2585 compute_bucket_count (info)
2586      struct bfd_link_info *info;
2587 {
2588   size_t dynsymcount = elf_hash_table (info)->dynsymcount;
2589   size_t best_size = 0;
2590   unsigned long int *hashcodes;
2591   unsigned long int *hashcodesp;
2592   unsigned long int i;
2593
2594   /* Compute the hash values for all exported symbols.  At the same
2595      time store the values in an array so that we could use them for
2596      optimizations.  */
2597   hashcodes = (unsigned long int *) bfd_malloc (dynsymcount
2598                                                 * sizeof (unsigned long int));
2599   if (hashcodes == NULL)
2600     return 0;
2601   hashcodesp = hashcodes;
2602
2603   /* Put all hash values in HASHCODES.  */
2604   elf_link_hash_traverse (elf_hash_table (info),
2605                           elf_collect_hash_codes, &hashcodesp);
2606
2607 /* We have a problem here.  The following code to optimize the table
2608    size requires an integer type with more the 32 bits.  If
2609    BFD_HOST_U_64_BIT is set we know about such a type.  */
2610 #ifdef BFD_HOST_U_64_BIT
2611   if (info->optimize == true)
2612     {
2613       unsigned long int nsyms = hashcodesp - hashcodes;
2614       size_t minsize;
2615       size_t maxsize;
2616       BFD_HOST_U_64_BIT best_chlen = ~((BFD_HOST_U_64_BIT) 0);
2617       unsigned long int *counts ;
2618
2619       /* Possible optimization parameters: if we have NSYMS symbols we say
2620          that the hashing table must at least have NSYMS/4 and at most
2621          2*NSYMS buckets.  */
2622       minsize = nsyms / 4;
2623       if (minsize == 0)
2624         minsize = 1;
2625       best_size = maxsize = nsyms * 2;
2626
2627       /* Create array where we count the collisions in.  We must use bfd_malloc
2628          since the size could be large.  */
2629       counts = (unsigned long int *) bfd_malloc (maxsize
2630                                                  * sizeof (unsigned long int));
2631       if (counts == NULL)
2632         {
2633           free (hashcodes);
2634           return 0;
2635         }
2636
2637       /* Compute the "optimal" size for the hash table.  The criteria is a
2638          minimal chain length.  The minor criteria is (of course) the size
2639          of the table.  */
2640       for (i = minsize; i < maxsize; ++i)
2641         {
2642           /* Walk through the array of hashcodes and count the collisions.  */
2643           BFD_HOST_U_64_BIT max;
2644           unsigned long int j;
2645           unsigned long int fact;
2646
2647           memset (counts, '\0', i * sizeof (unsigned long int));
2648
2649           /* Determine how often each hash bucket is used.  */
2650           for (j = 0; j < nsyms; ++j)
2651             ++counts[hashcodes[j] % i];
2652
2653           /* For the weight function we need some information about the
2654              pagesize on the target.  This is information need not be 100%
2655              accurate.  Since this information is not available (so far) we
2656              define it here to a reasonable default value.  If it is crucial
2657              to have a better value some day simply define this value.  */
2658 # ifndef BFD_TARGET_PAGESIZE
2659 #  define BFD_TARGET_PAGESIZE   (4096)
2660 # endif
2661
2662           /* We in any case need 2 + NSYMS entries for the size values and
2663              the chains.  */
2664           max = (2 + nsyms) * (ARCH_SIZE / 8);
2665
2666 # if 1
2667           /* Variant 1: optimize for short chains.  We add the squares
2668              of all the chain lengths (which favous many small chain
2669              over a few long chains).  */
2670           for (j = 0; j < i; ++j)
2671             max += counts[j] * counts[j];
2672
2673           /* This adds penalties for the overall size of the table.  */
2674           fact = i / (BFD_TARGET_PAGESIZE / (ARCH_SIZE / 8)) + 1;
2675           max *= fact * fact;
2676 # else
2677           /* Variant 2: Optimize a lot more for small table.  Here we
2678              also add squares of the size but we also add penalties for
2679              empty slots (the +1 term).  */
2680           for (j = 0; j < i; ++j)
2681             max += (1 + counts[j]) * (1 + counts[j]);
2682
2683           /* The overall size of the table is considered, but not as
2684              strong as in variant 1, where it is squared.  */
2685           fact = i / (BFD_TARGET_PAGESIZE / (ARCH_SIZE / 8)) + 1;
2686           max *= fact;
2687 # endif
2688
2689           /* Compare with current best results.  */
2690           if (max < best_chlen)
2691             {
2692               best_chlen = max;
2693               best_size = i;
2694             }
2695         }
2696
2697       free (counts);
2698     }
2699   else
2700 #endif /* defined (BFD_HOST_U_64_BIT) */
2701     {
2702       /* This is the fallback solution if no 64bit type is available or if we
2703          are not supposed to spend much time on optimizations.  We select the
2704          bucket count using a fixed set of numbers.  */
2705       for (i = 0; elf_buckets[i] != 0; i++)
2706         {
2707           best_size = elf_buckets[i];
2708           if (dynsymcount < elf_buckets[i + 1])
2709             break;
2710         }
2711     }
2712
2713   /* Free the arrays we needed.  */
2714   free (hashcodes);
2715
2716   return best_size;
2717 }
2718
2719 /* Set up the sizes and contents of the ELF dynamic sections.  This is
2720    called by the ELF linker emulation before_allocation routine.  We
2721    must set the sizes of the sections before the linker sets the
2722    addresses of the various sections.  */
2723
2724 boolean
2725 NAME(bfd_elf,size_dynamic_sections) (output_bfd, soname, rpath,
2726                                      export_dynamic, filter_shlib,
2727                                      auxiliary_filters, info, sinterpptr,
2728                                      verdefs)
2729      bfd *output_bfd;
2730      const char *soname;
2731      const char *rpath;
2732      boolean export_dynamic;
2733      const char *filter_shlib;
2734      const char * const *auxiliary_filters;
2735      struct bfd_link_info *info;
2736      asection **sinterpptr;
2737      struct bfd_elf_version_tree *verdefs;
2738 {
2739   bfd_size_type soname_indx;
2740   bfd *dynobj;
2741   struct elf_backend_data *bed;
2742   struct elf_assign_sym_version_info asvinfo;
2743
2744   *sinterpptr = NULL;
2745
2746   soname_indx = (bfd_size_type) -1;
2747
2748   if (info->hash->creator->flavour != bfd_target_elf_flavour)
2749     return true;
2750
2751   /* The backend may have to create some sections regardless of whether
2752      we're dynamic or not.  */
2753   bed = get_elf_backend_data (output_bfd);
2754   if (bed->elf_backend_always_size_sections
2755       && ! (*bed->elf_backend_always_size_sections) (output_bfd, info))
2756     return false;
2757
2758   dynobj = elf_hash_table (info)->dynobj;
2759
2760   /* If there were no dynamic objects in the link, there is nothing to
2761      do here.  */
2762   if (dynobj == NULL)
2763     return true;
2764
2765   /* If we are supposed to export all symbols into the dynamic symbol
2766      table (this is not the normal case), then do so.  */
2767   if (export_dynamic)
2768     {
2769       struct elf_info_failed eif;
2770
2771       eif.failed = false;
2772       eif.info = info;
2773       elf_link_hash_traverse (elf_hash_table (info), elf_export_symbol,
2774                               (PTR) &eif);
2775       if (eif.failed)
2776         return false;
2777     }
2778
2779   if (elf_hash_table (info)->dynamic_sections_created)
2780     {
2781       struct elf_info_failed eif;
2782       struct elf_link_hash_entry *h;
2783       bfd_size_type strsize;
2784
2785       *sinterpptr = bfd_get_section_by_name (dynobj, ".interp");
2786       BFD_ASSERT (*sinterpptr != NULL || info->shared);
2787
2788       if (soname != NULL)
2789         {
2790           soname_indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
2791                                             soname, true, true);
2792           if (soname_indx == (bfd_size_type) -1
2793               || ! elf_add_dynamic_entry (info, DT_SONAME, soname_indx))
2794             return false;
2795         }
2796
2797       if (info->symbolic)
2798         {
2799           if (! elf_add_dynamic_entry (info, DT_SYMBOLIC, 0))
2800             return false;
2801         }
2802
2803       if (rpath != NULL)
2804         {
2805           bfd_size_type indx;
2806
2807           indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr, rpath,
2808                                      true, true);
2809           if (indx == (bfd_size_type) -1
2810               || ! elf_add_dynamic_entry (info, DT_RPATH, indx))
2811             return false;
2812         }
2813
2814       if (filter_shlib != NULL)
2815         {
2816           bfd_size_type indx;
2817
2818           indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
2819                                      filter_shlib, true, true);
2820           if (indx == (bfd_size_type) -1
2821               || ! elf_add_dynamic_entry (info, DT_FILTER, indx))
2822             return false;
2823         }
2824
2825       if (auxiliary_filters != NULL)
2826         {
2827           const char * const *p;
2828
2829           for (p = auxiliary_filters; *p != NULL; p++)
2830             {
2831               bfd_size_type indx;
2832
2833               indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
2834                                          *p, true, true);
2835               if (indx == (bfd_size_type) -1
2836                   || ! elf_add_dynamic_entry (info, DT_AUXILIARY, indx))
2837                 return false;
2838             }
2839         }
2840
2841       /* Attach all the symbols to their version information.  */
2842       asvinfo.output_bfd = output_bfd;
2843       asvinfo.info = info;
2844       asvinfo.verdefs = verdefs;
2845       asvinfo.export_dynamic = export_dynamic;
2846       asvinfo.failed = false;
2847
2848       elf_link_hash_traverse (elf_hash_table (info),
2849                               elf_link_assign_sym_version,
2850                               (PTR) &asvinfo);
2851       if (asvinfo.failed)
2852         return false;
2853
2854       /* Find all symbols which were defined in a dynamic object and make
2855          the backend pick a reasonable value for them.  */
2856       eif.failed = false;
2857       eif.info = info;
2858       elf_link_hash_traverse (elf_hash_table (info),
2859                               elf_adjust_dynamic_symbol,
2860                               (PTR) &eif);
2861       if (eif.failed)
2862         return false;
2863
2864       /* Add some entries to the .dynamic section.  We fill in some of the
2865          values later, in elf_bfd_final_link, but we must add the entries
2866          now so that we know the final size of the .dynamic section.  */
2867
2868       /* If there are initialization and/or finalization functions to
2869          call then add the corresponding DT_INIT/DT_FINI entries.  */
2870       h = (info->init_function
2871            ? elf_link_hash_lookup (elf_hash_table (info), 
2872                                    info->init_function, false,
2873                                    false, false)
2874            : NULL);
2875       if (h != NULL
2876           && (h->elf_link_hash_flags & (ELF_LINK_HASH_REF_REGULAR
2877                                         | ELF_LINK_HASH_DEF_REGULAR)) != 0)
2878         {
2879           if (! elf_add_dynamic_entry (info, DT_INIT, 0))
2880             return false;
2881         }
2882       h = (info->fini_function
2883            ? elf_link_hash_lookup (elf_hash_table (info), 
2884                                    info->fini_function, false,
2885                                    false, false)
2886            : NULL);
2887       if (h != NULL
2888           && (h->elf_link_hash_flags & (ELF_LINK_HASH_REF_REGULAR
2889                                         | ELF_LINK_HASH_DEF_REGULAR)) != 0)
2890         {
2891           if (! elf_add_dynamic_entry (info, DT_FINI, 0))
2892             return false;
2893         }
2894
2895       strsize = _bfd_stringtab_size (elf_hash_table (info)->dynstr);
2896       if (! elf_add_dynamic_entry (info, DT_HASH, 0)
2897           || ! elf_add_dynamic_entry (info, DT_STRTAB, 0)
2898           || ! elf_add_dynamic_entry (info, DT_SYMTAB, 0)
2899           || ! elf_add_dynamic_entry (info, DT_STRSZ, strsize)
2900           || ! elf_add_dynamic_entry (info, DT_SYMENT,
2901                                       sizeof (Elf_External_Sym)))
2902         return false;
2903     }
2904
2905   /* The backend must work out the sizes of all the other dynamic
2906      sections.  */
2907   if (bed->elf_backend_size_dynamic_sections
2908       && ! (*bed->elf_backend_size_dynamic_sections) (output_bfd, info))
2909     return false;
2910
2911   if (elf_hash_table (info)->dynamic_sections_created)
2912     {
2913       size_t dynsymcount;
2914       asection *s;
2915       size_t bucketcount = 0;
2916       Elf_Internal_Sym isym;
2917       size_t hash_entry_size;
2918
2919       /* Set up the version definition section.  */
2920       s = bfd_get_section_by_name (dynobj, ".gnu.version_d");
2921       BFD_ASSERT (s != NULL);
2922
2923       /* We may have created additional version definitions if we are
2924          just linking a regular application.  */
2925       verdefs = asvinfo.verdefs;
2926
2927       if (verdefs == NULL)
2928         _bfd_strip_section_from_output (s);
2929       else
2930         {
2931           unsigned int cdefs;
2932           bfd_size_type size;
2933           struct bfd_elf_version_tree *t;
2934           bfd_byte *p;
2935           Elf_Internal_Verdef def;
2936           Elf_Internal_Verdaux defaux;
2937
2938           cdefs = 0;
2939           size = 0;
2940
2941           /* Make space for the base version.  */
2942           size += sizeof (Elf_External_Verdef);
2943           size += sizeof (Elf_External_Verdaux);
2944           ++cdefs;
2945
2946           for (t = verdefs; t != NULL; t = t->next)
2947             {
2948               struct bfd_elf_version_deps *n;
2949
2950               size += sizeof (Elf_External_Verdef);
2951               size += sizeof (Elf_External_Verdaux);
2952               ++cdefs;
2953
2954               for (n = t->deps; n != NULL; n = n->next)
2955                 size += sizeof (Elf_External_Verdaux);
2956             }
2957
2958           s->_raw_size = size;
2959           s->contents = (bfd_byte *) bfd_alloc (output_bfd, s->_raw_size);
2960           if (s->contents == NULL && s->_raw_size != 0)
2961             return false;
2962
2963           /* Fill in the version definition section.  */
2964
2965           p = s->contents;
2966
2967           def.vd_version = VER_DEF_CURRENT;
2968           def.vd_flags = VER_FLG_BASE;
2969           def.vd_ndx = 1;
2970           def.vd_cnt = 1;
2971           def.vd_aux = sizeof (Elf_External_Verdef);
2972           def.vd_next = (sizeof (Elf_External_Verdef)
2973                          + sizeof (Elf_External_Verdaux));
2974
2975           if (soname_indx != (bfd_size_type) -1)
2976             {
2977               def.vd_hash = bfd_elf_hash (soname);
2978               defaux.vda_name = soname_indx;
2979             }
2980           else
2981             {
2982               const char *name;
2983               bfd_size_type indx;
2984
2985               name = output_bfd->filename;
2986               def.vd_hash = bfd_elf_hash (name);
2987               indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
2988                                             name, true, false);
2989               if (indx == (bfd_size_type) -1)
2990                 return false;
2991               defaux.vda_name = indx;
2992             }
2993           defaux.vda_next = 0;
2994
2995           _bfd_elf_swap_verdef_out (output_bfd, &def,
2996                                     (Elf_External_Verdef *)p);
2997           p += sizeof (Elf_External_Verdef);
2998           _bfd_elf_swap_verdaux_out (output_bfd, &defaux,
2999                                      (Elf_External_Verdaux *) p);
3000           p += sizeof (Elf_External_Verdaux);
3001
3002           for (t = verdefs; t != NULL; t = t->next)
3003             {
3004               unsigned int cdeps;
3005               struct bfd_elf_version_deps *n;
3006               struct elf_link_hash_entry *h;
3007
3008               cdeps = 0;
3009               for (n = t->deps; n != NULL; n = n->next)
3010                 ++cdeps;
3011
3012               /* Add a symbol representing this version.  */
3013               h = NULL;
3014               if (! (_bfd_generic_link_add_one_symbol
3015                      (info, dynobj, t->name, BSF_GLOBAL, bfd_abs_section_ptr,
3016                       (bfd_vma) 0, (const char *) NULL, false,
3017                       get_elf_backend_data (dynobj)->collect,
3018                       (struct bfd_link_hash_entry **) &h)))
3019                 return false;
3020               h->elf_link_hash_flags &= ~ ELF_LINK_NON_ELF;
3021               h->elf_link_hash_flags |= ELF_LINK_HASH_DEF_REGULAR;
3022               h->type = STT_OBJECT;
3023               h->verinfo.vertree = t;
3024
3025               if (! _bfd_elf_link_record_dynamic_symbol (info, h))
3026                 return false;
3027
3028               def.vd_version = VER_DEF_CURRENT;
3029               def.vd_flags = 0;
3030               if (t->globals == NULL && t->locals == NULL && ! t->used)
3031                 def.vd_flags |= VER_FLG_WEAK;
3032               def.vd_ndx = t->vernum + 1;
3033               def.vd_cnt = cdeps + 1;
3034               def.vd_hash = bfd_elf_hash (t->name);
3035               def.vd_aux = sizeof (Elf_External_Verdef);
3036               if (t->next != NULL)
3037                 def.vd_next = (sizeof (Elf_External_Verdef)
3038                                + (cdeps + 1) * sizeof (Elf_External_Verdaux));
3039               else
3040                 def.vd_next = 0;
3041
3042               _bfd_elf_swap_verdef_out (output_bfd, &def,
3043                                         (Elf_External_Verdef *) p);
3044               p += sizeof (Elf_External_Verdef);
3045
3046               defaux.vda_name = h->dynstr_index;
3047               if (t->deps == NULL)
3048                 defaux.vda_next = 0;
3049               else
3050                 defaux.vda_next = sizeof (Elf_External_Verdaux);
3051               t->name_indx = defaux.vda_name;
3052
3053               _bfd_elf_swap_verdaux_out (output_bfd, &defaux,
3054                                          (Elf_External_Verdaux *) p);
3055               p += sizeof (Elf_External_Verdaux);
3056
3057               for (n = t->deps; n != NULL; n = n->next)
3058                 {
3059                   if (n->version_needed == NULL)
3060                     {
3061                       /* This can happen if there was an error in the
3062                          version script.  */
3063                       defaux.vda_name = 0;
3064                     }
3065                   else
3066                     defaux.vda_name = n->version_needed->name_indx;
3067                   if (n->next == NULL)
3068                     defaux.vda_next = 0;
3069                   else
3070                     defaux.vda_next = sizeof (Elf_External_Verdaux);
3071
3072                   _bfd_elf_swap_verdaux_out (output_bfd, &defaux,
3073                                              (Elf_External_Verdaux *) p);
3074                   p += sizeof (Elf_External_Verdaux);
3075                 }
3076             }
3077
3078           if (! elf_add_dynamic_entry (info, DT_VERDEF, 0)
3079               || ! elf_add_dynamic_entry (info, DT_VERDEFNUM, cdefs))
3080             return false;
3081
3082           elf_tdata (output_bfd)->cverdefs = cdefs;
3083         }
3084
3085       /* Work out the size of the version reference section.  */
3086
3087       s = bfd_get_section_by_name (dynobj, ".gnu.version_r");
3088       BFD_ASSERT (s != NULL);
3089       {
3090         struct elf_find_verdep_info sinfo;
3091
3092         sinfo.output_bfd = output_bfd;
3093         sinfo.info = info;
3094         sinfo.vers = elf_tdata (output_bfd)->cverdefs;
3095         if (sinfo.vers == 0)
3096           sinfo.vers = 1;
3097         sinfo.failed = false;
3098
3099         elf_link_hash_traverse (elf_hash_table (info),
3100                                 elf_link_find_version_dependencies,
3101                                 (PTR) &sinfo);
3102
3103         if (elf_tdata (output_bfd)->verref == NULL)
3104           _bfd_strip_section_from_output (s);
3105         else
3106           {
3107             Elf_Internal_Verneed *t;
3108             unsigned int size;
3109             unsigned int crefs;
3110             bfd_byte *p;
3111
3112             /* Build the version definition section.  */
3113             size = 0;
3114             crefs = 0;
3115             for (t = elf_tdata (output_bfd)->verref;
3116                  t != NULL;
3117                  t = t->vn_nextref)
3118               {
3119                 Elf_Internal_Vernaux *a;
3120
3121                 size += sizeof (Elf_External_Verneed);
3122                 ++crefs;
3123                 for (a = t->vn_auxptr; a != NULL; a = a->vna_nextptr)
3124                   size += sizeof (Elf_External_Vernaux);
3125               }
3126
3127             s->_raw_size = size;
3128             s->contents = (bfd_byte *) bfd_alloc (output_bfd, size);
3129             if (s->contents == NULL)
3130               return false;
3131
3132             p = s->contents;
3133             for (t = elf_tdata (output_bfd)->verref;
3134                  t != NULL;
3135                  t = t->vn_nextref)
3136               {
3137                 unsigned int caux;
3138                 Elf_Internal_Vernaux *a;
3139                 bfd_size_type indx;
3140
3141                 caux = 0;
3142                 for (a = t->vn_auxptr; a != NULL; a = a->vna_nextptr)
3143                   ++caux;
3144
3145                 t->vn_version = VER_NEED_CURRENT;
3146                 t->vn_cnt = caux;
3147                 if (elf_dt_name (t->vn_bfd) != NULL)
3148                   indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
3149                                              elf_dt_name (t->vn_bfd),
3150                                              true, false);
3151                 else
3152                   indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
3153                                              t->vn_bfd->filename, true, false);
3154                 if (indx == (bfd_size_type) -1)
3155                   return false;
3156                 t->vn_file = indx;
3157                 t->vn_aux = sizeof (Elf_External_Verneed);
3158                 if (t->vn_nextref == NULL)
3159                   t->vn_next = 0;
3160                 else
3161                   t->vn_next = (sizeof (Elf_External_Verneed)
3162                                 + caux * sizeof (Elf_External_Vernaux));
3163
3164                 _bfd_elf_swap_verneed_out (output_bfd, t,
3165                                            (Elf_External_Verneed *) p);
3166                 p += sizeof (Elf_External_Verneed);
3167
3168                 for (a = t->vn_auxptr; a != NULL; a = a->vna_nextptr)
3169                   {
3170                     a->vna_hash = bfd_elf_hash (a->vna_nodename);
3171                     indx = _bfd_stringtab_add (elf_hash_table (info)->dynstr,
3172                                                a->vna_nodename, true, false);
3173                     if (indx == (bfd_size_type) -1)
3174                       return false;
3175                     a->vna_name = indx;
3176                     if (a->vna_nextptr == NULL)
3177                       a->vna_next = 0;
3178                     else
3179                       a->vna_next = sizeof (Elf_External_Vernaux);
3180
3181                     _bfd_elf_swap_vernaux_out (output_bfd, a,
3182                                                (Elf_External_Vernaux *) p);
3183                     p += sizeof (Elf_External_Vernaux);
3184                   }
3185               }
3186
3187             if (! elf_add_dynamic_entry (info, DT_VERNEED, 0)
3188                 || ! elf_add_dynamic_entry (info, DT_VERNEEDNUM, crefs))
3189               return false;
3190
3191             elf_tdata (output_bfd)->cverrefs = crefs;
3192           }
3193       }
3194
3195       /* Assign dynsym indicies.  In a shared library we generate a 
3196          section symbol for each output section, which come first.
3197          Next come all of the back-end allocated local dynamic syms,
3198          followed by the rest of the global symbols.  */
3199
3200       dynsymcount = _bfd_elf_link_renumber_dynsyms (output_bfd, info);
3201
3202       /* Work out the size of the symbol version section.  */
3203       s = bfd_get_section_by_name (dynobj, ".gnu.version");
3204       BFD_ASSERT (s != NULL);
3205       if (dynsymcount == 0
3206           || (verdefs == NULL && elf_tdata (output_bfd)->verref == NULL))
3207         {
3208           _bfd_strip_section_from_output (s);
3209           /* The DYNSYMCOUNT might have changed if we were going to
3210              output a dynamic symbol table entry for S.  */
3211           dynsymcount = _bfd_elf_link_renumber_dynsyms (output_bfd, info);
3212         }
3213       else
3214         {
3215           s->_raw_size = dynsymcount * sizeof (Elf_External_Versym);
3216           s->contents = (bfd_byte *) bfd_zalloc (output_bfd, s->_raw_size);
3217           if (s->contents == NULL)
3218             return false;
3219
3220           if (! elf_add_dynamic_entry (info, DT_VERSYM, 0))
3221             return false;
3222         }
3223
3224       /* Set the size of the .dynsym and .hash sections.  We counted
3225          the number of dynamic symbols in elf_link_add_object_symbols.
3226          We will build the contents of .dynsym and .hash when we build
3227          the final symbol table, because until then we do not know the
3228          correct value to give the symbols.  We built the .dynstr
3229          section as we went along in elf_link_add_object_symbols.  */
3230       s = bfd_get_section_by_name (dynobj, ".dynsym");
3231       BFD_ASSERT (s != NULL);
3232       s->_raw_size = dynsymcount * sizeof (Elf_External_Sym);
3233       s->contents = (bfd_byte *) bfd_alloc (output_bfd, s->_raw_size);
3234       if (s->contents == NULL && s->_raw_size != 0)
3235         return false;
3236
3237       /* The first entry in .dynsym is a dummy symbol.  */
3238       isym.st_value = 0;
3239       isym.st_size = 0;
3240       isym.st_name = 0;
3241       isym.st_info = 0;
3242       isym.st_other = 0;
3243       isym.st_shndx = 0;
3244       elf_swap_symbol_out (output_bfd, &isym,
3245                            (PTR) (Elf_External_Sym *) s->contents);
3246
3247       /* Compute the size of the hashing table.  As a side effect this
3248          computes the hash values for all the names we export.  */
3249       bucketcount = compute_bucket_count (info);
3250
3251       s = bfd_get_section_by_name (dynobj, ".hash");
3252       BFD_ASSERT (s != NULL);
3253       hash_entry_size = elf_section_data (s)->this_hdr.sh_entsize;
3254       s->_raw_size = ((2 + bucketcount + dynsymcount) * hash_entry_size);
3255       s->contents = (bfd_byte *) bfd_alloc (output_bfd, s->_raw_size);
3256       if (s->contents == NULL)
3257         return false;
3258       memset (s->contents, 0, (size_t) s->_raw_size);
3259
3260       bfd_put (8 * hash_entry_size, output_bfd, bucketcount, s->contents);
3261       bfd_put (8 * hash_entry_size, output_bfd, dynsymcount, 
3262                s->contents + hash_entry_size);
3263
3264       elf_hash_table (info)->bucketcount = bucketcount;
3265
3266       s = bfd_get_section_by_name (dynobj, ".dynstr");
3267       BFD_ASSERT (s != NULL);
3268       s->_raw_size = _bfd_stringtab_size (elf_hash_table (info)->dynstr);
3269
3270       if (! elf_add_dynamic_entry (info, DT_NULL, 0))
3271         return false;
3272     }
3273
3274   return true;
3275 }
3276 \f
3277 /* Fix up the flags for a symbol.  This handles various cases which
3278    can only be fixed after all the input files are seen.  This is
3279    currently called by both adjust_dynamic_symbol and
3280    assign_sym_version, which is unnecessary but perhaps more robust in
3281    the face of future changes.  */
3282
3283 static boolean
3284 elf_fix_symbol_flags (h, eif)
3285      struct elf_link_hash_entry *h;
3286      struct elf_info_failed *eif;
3287 {
3288   /* If this symbol was mentioned in a non-ELF file, try to set
3289      DEF_REGULAR and REF_REGULAR correctly.  This is the only way to
3290      permit a non-ELF file to correctly refer to a symbol defined in
3291      an ELF dynamic object.  */
3292   if ((h->elf_link_hash_flags & ELF_LINK_NON_ELF) != 0)
3293     {
3294       if (h->root.type != bfd_link_hash_defined
3295           && h->root.type != bfd_link_hash_defweak)
3296         h->elf_link_hash_flags |= (ELF_LINK_HASH_REF_REGULAR
3297                                    | ELF_LINK_HASH_REF_REGULAR_NONWEAK);
3298       else
3299         {
3300           if (h->root.u.def.section->owner != NULL
3301               && (bfd_get_flavour (h->root.u.def.section->owner)
3302                   == bfd_target_elf_flavour))
3303             h->elf_link_hash_flags |= (ELF_LINK_HASH_REF_REGULAR
3304                                        | ELF_LINK_HASH_REF_REGULAR_NONWEAK);
3305           else
3306             h->elf_link_hash_flags |= ELF_LINK_HASH_DEF_REGULAR;
3307         }
3308
3309       if (h->dynindx == -1
3310           && ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0
3311               || (h->elf_link_hash_flags & ELF_LINK_HASH_REF_DYNAMIC) != 0))
3312         {
3313           if (! _bfd_elf_link_record_dynamic_symbol (eif->info, h))
3314             {
3315               eif->failed = true;
3316               return false;
3317             }
3318         }
3319     }
3320   else
3321     {
3322       /* Unfortunately, ELF_LINK_NON_ELF is only correct if the symbol
3323          was first seen in a non-ELF file.  Fortunately, if the symbol
3324          was first seen in an ELF file, we're probably OK unless the
3325          symbol was defined in a non-ELF file.  Catch that case here.
3326          FIXME: We're still in trouble if the symbol was first seen in
3327          a dynamic object, and then later in a non-ELF regular object.  */
3328       if ((h->root.type == bfd_link_hash_defined
3329            || h->root.type == bfd_link_hash_defweak)
3330           && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0
3331           && (h->root.u.def.section->owner != NULL
3332               ? (bfd_get_flavour (h->root.u.def.section->owner)
3333                  != bfd_target_elf_flavour)
3334               : (bfd_is_abs_section (h->root.u.def.section)
3335                  && (h->elf_link_hash_flags
3336                      & ELF_LINK_HASH_DEF_DYNAMIC) == 0)))
3337         h->elf_link_hash_flags |= ELF_LINK_HASH_DEF_REGULAR;
3338     }
3339
3340   /* If this is a final link, and the symbol was defined as a common
3341      symbol in a regular object file, and there was no definition in
3342      any dynamic object, then the linker will have allocated space for
3343      the symbol in a common section but the ELF_LINK_HASH_DEF_REGULAR
3344      flag will not have been set.  */
3345   if (h->root.type == bfd_link_hash_defined
3346       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0
3347       && (h->elf_link_hash_flags & ELF_LINK_HASH_REF_REGULAR) != 0
3348       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) == 0
3349       && (h->root.u.def.section->owner->flags & DYNAMIC) == 0)
3350     h->elf_link_hash_flags |= ELF_LINK_HASH_DEF_REGULAR;
3351
3352   /* If -Bsymbolic was used (which means to bind references to global
3353      symbols to the definition within the shared object), and this
3354      symbol was defined in a regular object, then it actually doesn't
3355      need a PLT entry.  */
3356   if ((h->elf_link_hash_flags & ELF_LINK_HASH_NEEDS_PLT) != 0
3357       && eif->info->shared
3358       && eif->info->symbolic
3359       && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) != 0)
3360     {
3361       h->elf_link_hash_flags &=~ ELF_LINK_HASH_NEEDS_PLT;
3362       h->plt.offset = (bfd_vma) -1;
3363     }
3364
3365   /* If this is a weak defined symbol in a dynamic object, and we know
3366      the real definition in the dynamic object, copy interesting flags
3367      over to the real definition.  */
3368   if (h->weakdef != NULL)
3369     {
3370       struct elf_link_hash_entry *weakdef;
3371
3372       BFD_ASSERT (h->root.type == bfd_link_hash_defined
3373                   || h->root.type == bfd_link_hash_defweak);
3374       weakdef = h->weakdef;
3375       BFD_ASSERT (weakdef->root.type == bfd_link_hash_defined
3376                   || weakdef->root.type == bfd_link_hash_defweak);
3377       BFD_ASSERT (weakdef->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC);
3378
3379       /* If the real definition is defined by a regular object file,
3380          don't do anything special.  See the longer description in
3381          elf_adjust_dynamic_symbol, below.  */
3382       if ((weakdef->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) != 0)
3383         h->weakdef = NULL;
3384       else
3385         weakdef->elf_link_hash_flags |=
3386           (h->elf_link_hash_flags
3387            & (ELF_LINK_HASH_REF_REGULAR
3388               | ELF_LINK_HASH_REF_REGULAR_NONWEAK
3389               | ELF_LINK_NON_GOT_REF));
3390     }
3391
3392   return true;
3393 }
3394
3395 /* Make the backend pick a good value for a dynamic symbol.  This is
3396    called via elf_link_hash_traverse, and also calls itself
3397    recursively.  */
3398
3399 static boolean
3400 elf_adjust_dynamic_symbol (h, data)
3401      struct elf_link_hash_entry *h;
3402      PTR data;
3403 {
3404   struct elf_info_failed *eif = (struct elf_info_failed *) data;
3405   bfd *dynobj;
3406   struct elf_backend_data *bed;
3407
3408   /* Ignore indirect symbols.  These are added by the versioning code.  */
3409   if (h->root.type == bfd_link_hash_indirect)
3410     return true;
3411
3412   /* Fix the symbol flags.  */
3413   if (! elf_fix_symbol_flags (h, eif))
3414     return false;
3415
3416   /* If this symbol does not require a PLT entry, and it is not
3417      defined by a dynamic object, or is not referenced by a regular
3418      object, ignore it.  We do have to handle a weak defined symbol,
3419      even if no regular object refers to it, if we decided to add it
3420      to the dynamic symbol table.  FIXME: Do we normally need to worry
3421      about symbols which are defined by one dynamic object and
3422      referenced by another one?  */
3423   if ((h->elf_link_hash_flags & ELF_LINK_HASH_NEEDS_PLT) == 0
3424       && ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) != 0
3425           || (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) == 0
3426           || ((h->elf_link_hash_flags & ELF_LINK_HASH_REF_REGULAR) == 0
3427               && (h->weakdef == NULL || h->weakdef->dynindx == -1))))
3428     {
3429       h->plt.offset = (bfd_vma) -1;
3430       return true;
3431     }
3432
3433   /* If we've already adjusted this symbol, don't do it again.  This
3434      can happen via a recursive call.  */
3435   if ((h->elf_link_hash_flags & ELF_LINK_HASH_DYNAMIC_ADJUSTED) != 0)
3436     return true;
3437
3438   /* Don't look at this symbol again.  Note that we must set this
3439      after checking the above conditions, because we may look at a
3440      symbol once, decide not to do anything, and then get called
3441      recursively later after REF_REGULAR is set below.  */
3442   h->elf_link_hash_flags |= ELF_LINK_HASH_DYNAMIC_ADJUSTED;
3443
3444   /* If this is a weak definition, and we know a real definition, and
3445      the real symbol is not itself defined by a regular object file,
3446      then get a good value for the real definition.  We handle the
3447      real symbol first, for the convenience of the backend routine.
3448
3449      Note that there is a confusing case here.  If the real definition
3450      is defined by a regular object file, we don't get the real symbol
3451      from the dynamic object, but we do get the weak symbol.  If the
3452      processor backend uses a COPY reloc, then if some routine in the
3453      dynamic object changes the real symbol, we will not see that
3454      change in the corresponding weak symbol.  This is the way other
3455      ELF linkers work as well, and seems to be a result of the shared
3456      library model.
3457
3458      I will clarify this issue.  Most SVR4 shared libraries define the
3459      variable _timezone and define timezone as a weak synonym.  The
3460      tzset call changes _timezone.  If you write
3461        extern int timezone;
3462        int _timezone = 5;
3463        int main () { tzset (); printf ("%d %d\n", timezone, _timezone); }
3464      you might expect that, since timezone is a synonym for _timezone,
3465      the same number will print both times.  However, if the processor
3466      backend uses a COPY reloc, then actually timezone will be copied
3467      into your process image, and, since you define _timezone
3468      yourself, _timezone will not.  Thus timezone and _timezone will
3469      wind up at different memory locations.  The tzset call will set
3470      _timezone, leaving timezone unchanged.  */
3471
3472   if (h->weakdef != NULL)
3473     {
3474       /* If we get to this point, we know there is an implicit
3475          reference by a regular object file via the weak symbol H.
3476          FIXME: Is this really true?  What if the traversal finds
3477          H->WEAKDEF before it finds H?  */
3478       h->weakdef->elf_link_hash_flags |= ELF_LINK_HASH_REF_REGULAR;
3479
3480       if (! elf_adjust_dynamic_symbol (h->weakdef, (PTR) eif))
3481         return false;
3482     }
3483
3484   /* If a symbol has no type and no size and does not require a PLT
3485      entry, then we are probably about to do the wrong thing here: we
3486      are probably going to create a COPY reloc for an empty object.
3487      This case can arise when a shared object is built with assembly
3488      code, and the assembly code fails to set the symbol type.  */
3489   if (h->size == 0
3490       && h->type == STT_NOTYPE
3491       && (h->elf_link_hash_flags & ELF_LINK_HASH_NEEDS_PLT) == 0)
3492     (*_bfd_error_handler)
3493       (_("warning: type and size of dynamic symbol `%s' are not defined"),
3494          h->root.root.string);
3495
3496   dynobj = elf_hash_table (eif->info)->dynobj;
3497   bed = get_elf_backend_data (dynobj);
3498   if (! (*bed->elf_backend_adjust_dynamic_symbol) (eif->info, h))
3499     {
3500       eif->failed = true;
3501       return false;
3502     }
3503
3504   return true;
3505 }
3506 \f
3507 /* This routine is used to export all defined symbols into the dynamic
3508    symbol table.  It is called via elf_link_hash_traverse.  */
3509
3510 static boolean
3511 elf_export_symbol (h, data)
3512      struct elf_link_hash_entry *h;
3513      PTR data;
3514 {
3515   struct elf_info_failed *eif = (struct elf_info_failed *) data;
3516
3517   /* Ignore indirect symbols.  These are added by the versioning code.  */
3518   if (h->root.type == bfd_link_hash_indirect)
3519     return true;
3520
3521   if (h->dynindx == -1
3522       && (h->elf_link_hash_flags
3523           & (ELF_LINK_HASH_DEF_REGULAR | ELF_LINK_HASH_REF_REGULAR)) != 0)
3524     {
3525       if (! _bfd_elf_link_record_dynamic_symbol (eif->info, h))
3526         {
3527           eif->failed = true;
3528           return false;
3529         }
3530     }
3531
3532   return true;
3533 }
3534 \f
3535 /* Look through the symbols which are defined in other shared
3536    libraries and referenced here.  Update the list of version
3537    dependencies.  This will be put into the .gnu.version_r section.
3538    This function is called via elf_link_hash_traverse.  */
3539
3540 static boolean
3541 elf_link_find_version_dependencies (h, data)
3542      struct elf_link_hash_entry *h;
3543      PTR data;
3544 {
3545   struct elf_find_verdep_info *rinfo = (struct elf_find_verdep_info *) data;
3546   Elf_Internal_Verneed *t;
3547   Elf_Internal_Vernaux *a;
3548
3549   /* We only care about symbols defined in shared objects with version
3550      information.  */
3551   if ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) == 0
3552       || (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) != 0
3553       || h->dynindx == -1
3554       || h->verinfo.verdef == NULL)
3555     return true;
3556
3557   /* See if we already know about this version.  */
3558   for (t = elf_tdata (rinfo->output_bfd)->verref; t != NULL; t = t->vn_nextref)
3559     {
3560       if (t->vn_bfd != h->verinfo.verdef->vd_bfd)
3561         continue;
3562
3563       for (a = t->vn_auxptr; a != NULL; a = a->vna_nextptr)
3564         if (a->vna_nodename == h->verinfo.verdef->vd_nodename)
3565           return true;
3566
3567       break;
3568     }
3569
3570   /* This is a new version.  Add it to tree we are building.  */
3571
3572   if (t == NULL)
3573     {
3574       t = (Elf_Internal_Verneed *) bfd_zalloc (rinfo->output_bfd, sizeof *t);
3575       if (t == NULL)
3576         {
3577           rinfo->failed = true;
3578           return false;
3579         }
3580
3581       t->vn_bfd = h->verinfo.verdef->vd_bfd;
3582       t->vn_nextref = elf_tdata (rinfo->output_bfd)->verref;
3583       elf_tdata (rinfo->output_bfd)->verref = t;
3584     }
3585
3586   a = (Elf_Internal_Vernaux *) bfd_zalloc (rinfo->output_bfd, sizeof *a);
3587
3588   /* Note that we are copying a string pointer here, and testing it
3589      above.  If bfd_elf_string_from_elf_section is ever changed to
3590      discard the string data when low in memory, this will have to be
3591      fixed.  */
3592   a->vna_nodename = h->verinfo.verdef->vd_nodename;
3593
3594   a->vna_flags = h->verinfo.verdef->vd_flags;
3595   a->vna_nextptr = t->vn_auxptr;
3596
3597   h->verinfo.verdef->vd_exp_refno = rinfo->vers;
3598   ++rinfo->vers;
3599
3600   a->vna_other = h->verinfo.verdef->vd_exp_refno + 1;
3601
3602   t->vn_auxptr = a;
3603
3604   return true;
3605 }
3606
3607 /* Figure out appropriate versions for all the symbols.  We may not
3608    have the version number script until we have read all of the input
3609    files, so until that point we don't know which symbols should be
3610    local.  This function is called via elf_link_hash_traverse.  */
3611
3612 static boolean
3613 elf_link_assign_sym_version (h, data)
3614      struct elf_link_hash_entry *h;
3615      PTR data;
3616 {
3617   struct elf_assign_sym_version_info *sinfo =
3618     (struct elf_assign_sym_version_info *) data;
3619   struct bfd_link_info *info = sinfo->info;
3620   struct elf_info_failed eif;
3621   char *p;
3622
3623   /* Fix the symbol flags.  */
3624   eif.failed = false;
3625   eif.info = info;
3626   if (! elf_fix_symbol_flags (h, &eif))
3627     {
3628       if (eif.failed)
3629         sinfo->failed = true;
3630       return false;
3631     }
3632
3633   /* We only need version numbers for symbols defined in regular
3634      objects.  */
3635   if ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0)
3636     return true;
3637
3638   p = strchr (h->root.root.string, ELF_VER_CHR);
3639   if (p != NULL && h->verinfo.vertree == NULL)
3640     {
3641       struct bfd_elf_version_tree *t;
3642       boolean hidden;
3643
3644       hidden = true;
3645
3646       /* There are two consecutive ELF_VER_CHR characters if this is
3647          not a hidden symbol.  */
3648       ++p;
3649       if (*p == ELF_VER_CHR)
3650         {
3651           hidden = false;
3652           ++p;
3653         }
3654
3655       /* If there is no version string, we can just return out.  */
3656       if (*p == '\0')
3657         {
3658           if (hidden)
3659             h->elf_link_hash_flags |= ELF_LINK_HIDDEN;
3660           return true;
3661         }
3662
3663       /* Look for the version.  If we find it, it is no longer weak.  */
3664       for (t = sinfo->verdefs; t != NULL; t = t->next)
3665         {
3666           if (strcmp (t->name, p) == 0)
3667             {
3668               int len;
3669               char *alc;
3670               struct bfd_elf_version_expr *d;
3671
3672               len = p - h->root.root.string;
3673               alc = bfd_alloc (sinfo->output_bfd, len);
3674               if (alc == NULL)
3675                 return false;
3676               strncpy (alc, h->root.root.string, len - 1);
3677               alc[len - 1] = '\0';
3678               if (alc[len - 2] == ELF_VER_CHR)
3679                 alc[len - 2] = '\0';
3680
3681               h->verinfo.vertree = t;
3682               t->used = true;
3683               d = NULL;
3684
3685               if (t->globals != NULL)
3686                 {
3687                   for (d = t->globals; d != NULL; d = d->next)
3688                     if ((*d->match) (d, alc))
3689                       break;
3690                 }
3691
3692               /* See if there is anything to force this symbol to
3693                  local scope.  */
3694               if (d == NULL && t->locals != NULL)
3695                 {
3696                   for (d = t->locals; d != NULL; d = d->next)
3697                     {
3698                       if ((*d->match) (d, alc))
3699                         {
3700                           if (h->dynindx != -1
3701                               && info->shared
3702                               && ! sinfo->export_dynamic)
3703                             {
3704                               h->elf_link_hash_flags |= ELF_LINK_FORCED_LOCAL;
3705                               h->elf_link_hash_flags &=~
3706                                 ELF_LINK_HASH_NEEDS_PLT;
3707                               h->dynindx = -1;
3708                               h->plt.offset = (bfd_vma) -1;
3709                               /* FIXME: The name of the symbol has
3710                                  already been recorded in the dynamic
3711                                  string table section.  */
3712                             }
3713
3714                           break;
3715                         }
3716                     }
3717                 }
3718
3719               bfd_release (sinfo->output_bfd, alc);
3720               break;
3721             }
3722         }
3723
3724       /* If we are building an application, we need to create a
3725          version node for this version.  */
3726       if (t == NULL && ! info->shared)
3727         {
3728           struct bfd_elf_version_tree **pp;
3729           int version_index;
3730
3731           /* If we aren't going to export this symbol, we don't need
3732              to worry about it. */
3733           if (h->dynindx == -1)
3734             return true;
3735
3736           t = ((struct bfd_elf_version_tree *)
3737                bfd_alloc (sinfo->output_bfd, sizeof *t));
3738           if (t == NULL)
3739             {
3740               sinfo->failed = true;
3741               return false;
3742             }
3743
3744           t->next = NULL;
3745           t->name = p;
3746           t->globals = NULL;
3747           t->locals = NULL;
3748           t->deps = NULL;
3749           t->name_indx = (unsigned int) -1;
3750           t->used = true;
3751
3752           version_index = 1;
3753           for (pp = &sinfo->verdefs; *pp != NULL; pp = &(*pp)->next)
3754             ++version_index;
3755           t->vernum = version_index;
3756
3757           *pp = t;
3758
3759           h->verinfo.vertree = t;
3760         }
3761       else if (t == NULL)
3762         {
3763           /* We could not find the version for a symbol when
3764              generating a shared archive.  Return an error.  */
3765           (*_bfd_error_handler)
3766             (_("%s: undefined versioned symbol name %s"),
3767              bfd_get_filename (sinfo->output_bfd), h->root.root.string);
3768           bfd_set_error (bfd_error_bad_value);
3769           sinfo->failed = true;
3770           return false;
3771         }
3772
3773       if (hidden)
3774         h->elf_link_hash_flags |= ELF_LINK_HIDDEN;
3775     }
3776
3777   /* If we don't have a version for this symbol, see if we can find
3778      something.  */
3779   if (h->verinfo.vertree == NULL && sinfo->verdefs != NULL)
3780     {
3781       struct bfd_elf_version_tree *t;
3782       struct bfd_elf_version_tree *deflt;
3783       struct bfd_elf_version_expr *d;
3784
3785       /* See if can find what version this symbol is in.  If the
3786          symbol is supposed to be local, then don't actually register
3787          it.  */
3788       deflt = NULL;
3789       for (t = sinfo->verdefs; t != NULL; t = t->next)
3790         {
3791           if (t->globals != NULL)
3792             {
3793               for (d = t->globals; d != NULL; d = d->next)
3794                 {
3795                   if ((*d->match) (d, h->root.root.string))
3796                     {
3797                       h->verinfo.vertree = t;
3798                       break;
3799                     }
3800                 }
3801
3802               if (d != NULL)
3803                 break;
3804             }
3805
3806           if (t->locals != NULL)
3807             {
3808               for (d = t->locals; d != NULL; d = d->next)
3809                 {
3810                   if (d->pattern[0] == '*' && d->pattern[1] == '\0')
3811                     deflt = t;
3812                   else if ((*d->match) (d, h->root.root.string))
3813                     {
3814                       h->verinfo.vertree = t;
3815                       if (h->dynindx != -1
3816                           && info->shared
3817                           && ! sinfo->export_dynamic)
3818                         {
3819                           h->elf_link_hash_flags |= ELF_LINK_FORCED_LOCAL;
3820                           h->elf_link_hash_flags &=~ ELF_LINK_HASH_NEEDS_PLT;
3821                           h->dynindx = -1;
3822                           h->plt.offset = (bfd_vma) -1;
3823                           /* FIXME: The name of the symbol has already
3824                              been recorded in the dynamic string table
3825                              section.  */
3826                         }
3827                       break;
3828                     }
3829                 }
3830
3831               if (d != NULL)
3832                 break;
3833             }
3834         }
3835
3836       if (deflt != NULL && h->verinfo.vertree == NULL)
3837         {
3838           h->verinfo.vertree = deflt;
3839           if (h->dynindx != -1
3840               && info->shared
3841               && ! sinfo->export_dynamic)
3842             {
3843               h->elf_link_hash_flags |= ELF_LINK_FORCED_LOCAL;
3844               h->elf_link_hash_flags &=~ ELF_LINK_HASH_NEEDS_PLT;
3845               h->dynindx = -1;
3846               h->plt.offset = (bfd_vma) -1;
3847               /* FIXME: The name of the symbol has already been
3848                  recorded in the dynamic string table section.  */
3849             }
3850         }
3851     }
3852
3853   return true;
3854 }
3855 \f
3856 /* Final phase of ELF linker.  */
3857
3858 /* A structure we use to avoid passing large numbers of arguments.  */
3859
3860 struct elf_final_link_info
3861 {
3862   /* General link information.  */
3863   struct bfd_link_info *info;
3864   /* Output BFD.  */
3865   bfd *output_bfd;
3866   /* Symbol string table.  */
3867   struct bfd_strtab_hash *symstrtab;
3868   /* .dynsym section.  */
3869   asection *dynsym_sec;
3870   /* .hash section.  */
3871   asection *hash_sec;
3872   /* symbol version section (.gnu.version).  */
3873   asection *symver_sec;
3874   /* Buffer large enough to hold contents of any section.  */
3875   bfd_byte *contents;
3876   /* Buffer large enough to hold external relocs of any section.  */
3877   PTR external_relocs;
3878   /* Buffer large enough to hold internal relocs of any section.  */
3879   Elf_Internal_Rela *internal_relocs;
3880   /* Buffer large enough to hold external local symbols of any input
3881      BFD.  */
3882   Elf_External_Sym *external_syms;
3883   /* Buffer large enough to hold internal local symbols of any input
3884      BFD.  */
3885   Elf_Internal_Sym *internal_syms;
3886   /* Array large enough to hold a symbol index for each local symbol
3887      of any input BFD.  */
3888   long *indices;
3889   /* Array large enough to hold a section pointer for each local
3890      symbol of any input BFD.  */
3891   asection **sections;
3892   /* Buffer to hold swapped out symbols.  */
3893   Elf_External_Sym *symbuf;
3894   /* Number of swapped out symbols in buffer.  */
3895   size_t symbuf_count;
3896   /* Number of symbols which fit in symbuf.  */
3897   size_t symbuf_size;
3898 };
3899
3900 static boolean elf_link_output_sym
3901   PARAMS ((struct elf_final_link_info *, const char *,
3902            Elf_Internal_Sym *, asection *));
3903 static boolean elf_link_flush_output_syms
3904   PARAMS ((struct elf_final_link_info *));
3905 static boolean elf_link_output_extsym
3906   PARAMS ((struct elf_link_hash_entry *, PTR));
3907 static boolean elf_link_input_bfd
3908   PARAMS ((struct elf_final_link_info *, bfd *));
3909 static boolean elf_reloc_link_order
3910   PARAMS ((bfd *, struct bfd_link_info *, asection *,
3911            struct bfd_link_order *));
3912
3913 /* This struct is used to pass information to elf_link_output_extsym.  */
3914
3915 struct elf_outext_info
3916 {
3917   boolean failed;
3918   boolean localsyms;
3919   struct elf_final_link_info *finfo;
3920 };
3921
3922 /* Compute the size of, and allocate space for, REL_HDR which is the
3923    section header for a section containing relocations for O.  */
3924
3925 static boolean
3926 elf_link_size_reloc_section (abfd, rel_hdr, o)
3927      bfd *abfd;
3928      Elf_Internal_Shdr *rel_hdr;
3929      asection *o;
3930 {
3931   register struct elf_link_hash_entry **p, **pend;
3932   unsigned reloc_count;
3933
3934   /* Figure out how many relocations there will be.  */
3935   if (rel_hdr == &elf_section_data (o)->rel_hdr)
3936     reloc_count = elf_section_data (o)->rel_count;
3937   else
3938     reloc_count = elf_section_data (o)->rel_count2;
3939
3940   /* That allows us to calculate the size of the section.  */
3941   rel_hdr->sh_size = rel_hdr->sh_entsize * reloc_count;
3942
3943   /* The contents field must last into write_object_contents, so we
3944      allocate it with bfd_alloc rather than malloc.  */
3945   rel_hdr->contents = (PTR) bfd_alloc (abfd, rel_hdr->sh_size);
3946   if (rel_hdr->contents == NULL && rel_hdr->sh_size != 0)
3947     return false;
3948   
3949   /* We only allocate one set of hash entries, so we only do it the
3950      first time we are called.  */
3951   if (elf_section_data (o)->rel_hashes == NULL)
3952     {
3953       p = ((struct elf_link_hash_entry **)
3954            bfd_malloc (o->reloc_count
3955                        * sizeof (struct elf_link_hash_entry *)));
3956       if (p == NULL && o->reloc_count != 0)
3957         return false;
3958
3959       elf_section_data (o)->rel_hashes = p;
3960       pend = p + o->reloc_count;
3961       for (; p < pend; p++)
3962         *p = NULL;
3963     }
3964
3965   return true;
3966 }
3967
3968 /* When performing a relocateable link, the input relocations are
3969    preserved.  But, if they reference global symbols, the indices
3970    referenced must be updated.  Update all the relocations in
3971    REL_HDR (there are COUNT of them), using the data in REL_HASH.  */
3972
3973 static void
3974 elf_link_adjust_relocs (abfd, rel_hdr, count, rel_hash)
3975      bfd *abfd;
3976      Elf_Internal_Shdr *rel_hdr;
3977      unsigned int count;
3978      struct elf_link_hash_entry **rel_hash;
3979 {
3980   unsigned int i;
3981
3982   for (i = 0; i < count; i++, rel_hash++)
3983     {
3984       if (*rel_hash == NULL)
3985         continue;
3986
3987       BFD_ASSERT ((*rel_hash)->indx >= 0);
3988
3989       if (rel_hdr->sh_entsize == sizeof (Elf_External_Rel))
3990         {
3991           Elf_External_Rel *erel;
3992           Elf_Internal_Rel irel;
3993           
3994           erel = (Elf_External_Rel *) rel_hdr->contents + i;
3995           elf_swap_reloc_in (abfd, erel, &irel);
3996           irel.r_info = ELF_R_INFO ((*rel_hash)->indx,
3997                                     ELF_R_TYPE (irel.r_info));
3998           elf_swap_reloc_out (abfd, &irel, erel);
3999         }
4000       else
4001         {
4002           Elf_External_Rela *erela;
4003           Elf_Internal_Rela irela;
4004           
4005           BFD_ASSERT (rel_hdr->sh_entsize
4006                       == sizeof (Elf_External_Rela));
4007           
4008           erela = (Elf_External_Rela *) rel_hdr->contents + i;
4009           elf_swap_reloca_in (abfd, erela, &irela);
4010           irela.r_info = ELF_R_INFO ((*rel_hash)->indx,
4011                                      ELF_R_TYPE (irela.r_info));
4012           elf_swap_reloca_out (abfd, &irela, erela);
4013         }
4014     }
4015 }
4016
4017 /* Do the final step of an ELF link.  */
4018
4019 boolean
4020 elf_bfd_final_link (abfd, info)
4021      bfd *abfd;
4022      struct bfd_link_info *info;
4023 {
4024   boolean dynamic;
4025   bfd *dynobj;
4026   struct elf_final_link_info finfo;
4027   register asection *o;
4028   register struct bfd_link_order *p;
4029   register bfd *sub;
4030   size_t max_contents_size;
4031   size_t max_external_reloc_size;
4032   size_t max_internal_reloc_count;
4033   size_t max_sym_count;
4034   file_ptr off;
4035   Elf_Internal_Sym elfsym;
4036   unsigned int i;
4037   Elf_Internal_Shdr *symtab_hdr;
4038   Elf_Internal_Shdr *symstrtab_hdr;
4039   struct elf_backend_data *bed = get_elf_backend_data (abfd);
4040   struct elf_outext_info eoinfo;
4041
4042   if (info->shared)
4043     abfd->flags |= DYNAMIC;
4044
4045   dynamic = elf_hash_table (info)->dynamic_sections_created;
4046   dynobj = elf_hash_table (info)->dynobj;
4047
4048   finfo.info = info;
4049   finfo.output_bfd = abfd;
4050   finfo.symstrtab = elf_stringtab_init ();
4051   if (finfo.symstrtab == NULL)
4052     return false;
4053
4054   if (! dynamic)
4055     {
4056       finfo.dynsym_sec = NULL;
4057       finfo.hash_sec = NULL;
4058       finfo.symver_sec = NULL;
4059     }
4060   else
4061     {
4062       finfo.dynsym_sec = bfd_get_section_by_name (dynobj, ".dynsym");
4063       finfo.hash_sec = bfd_get_section_by_name (dynobj, ".hash");
4064       BFD_ASSERT (finfo.dynsym_sec != NULL && finfo.hash_sec != NULL);
4065       finfo.symver_sec = bfd_get_section_by_name (dynobj, ".gnu.version");
4066       /* Note that it is OK if symver_sec is NULL.  */
4067     }
4068
4069   finfo.contents = NULL;
4070   finfo.external_relocs = NULL;
4071   finfo.internal_relocs = NULL;
4072   finfo.external_syms = NULL;
4073   finfo.internal_syms = NULL;
4074   finfo.indices = NULL;
4075   finfo.sections = NULL;
4076   finfo.symbuf = NULL;
4077   finfo.symbuf_count = 0;
4078
4079   /* Count up the number of relocations we will output for each output
4080      section, so that we know the sizes of the reloc sections.  We
4081      also figure out some maximum sizes.  */
4082   max_contents_size = 0;
4083   max_external_reloc_size = 0;
4084   max_internal_reloc_count = 0;
4085   max_sym_count = 0;
4086   for (o = abfd->sections; o != (asection *) NULL; o = o->next)
4087     {
4088       o->reloc_count = 0;
4089
4090       for (p = o->link_order_head; p != NULL; p = p->next)
4091         {
4092           if (p->type == bfd_section_reloc_link_order
4093               || p->type == bfd_symbol_reloc_link_order)
4094             ++o->reloc_count;
4095           else if (p->type == bfd_indirect_link_order)
4096             {
4097               asection *sec;
4098
4099               sec = p->u.indirect.section;
4100
4101               /* Mark all sections which are to be included in the
4102                  link.  This will normally be every section.  We need
4103                  to do this so that we can identify any sections which
4104                  the linker has decided to not include.  */
4105               sec->linker_mark = true;
4106
4107               if (info->relocateable)
4108                 o->reloc_count += sec->reloc_count;
4109
4110               if (sec->_raw_size > max_contents_size)
4111                 max_contents_size = sec->_raw_size;
4112               if (sec->_cooked_size > max_contents_size)
4113                 max_contents_size = sec->_cooked_size;
4114
4115               /* We are interested in just local symbols, not all
4116                  symbols.  */
4117               if (bfd_get_flavour (sec->owner) == bfd_target_elf_flavour
4118                   && (sec->owner->flags & DYNAMIC) == 0)
4119                 {
4120                   size_t sym_count;
4121
4122                   if (elf_bad_symtab (sec->owner))
4123                     sym_count = (elf_tdata (sec->owner)->symtab_hdr.sh_size
4124                                  / sizeof (Elf_External_Sym));
4125                   else
4126                     sym_count = elf_tdata (sec->owner)->symtab_hdr.sh_info;
4127
4128                   if (sym_count > max_sym_count)
4129                     max_sym_count = sym_count;
4130
4131                   if ((sec->flags & SEC_RELOC) != 0)
4132                     {
4133                       size_t ext_size;
4134
4135                       ext_size = elf_section_data (sec)->rel_hdr.sh_size;
4136                       if (ext_size > max_external_reloc_size)
4137                         max_external_reloc_size = ext_size;
4138                       if (sec->reloc_count > max_internal_reloc_count)
4139                         max_internal_reloc_count = sec->reloc_count;
4140                     }
4141                 }
4142             }
4143         }
4144
4145       if (o->reloc_count > 0)
4146         o->flags |= SEC_RELOC;
4147       else
4148         {
4149           /* Explicitly clear the SEC_RELOC flag.  The linker tends to
4150              set it (this is probably a bug) and if it is set
4151              assign_section_numbers will create a reloc section.  */
4152           o->flags &=~ SEC_RELOC;
4153         }
4154
4155       /* If the SEC_ALLOC flag is not set, force the section VMA to
4156          zero.  This is done in elf_fake_sections as well, but forcing
4157          the VMA to 0 here will ensure that relocs against these
4158          sections are handled correctly.  */
4159       if ((o->flags & SEC_ALLOC) == 0
4160           && ! o->user_set_vma)
4161         o->vma = 0;
4162     }
4163
4164   /* Figure out the file positions for everything but the symbol table
4165      and the relocs.  We set symcount to force assign_section_numbers
4166      to create a symbol table.  */
4167   bfd_get_symcount (abfd) = info->strip == strip_all ? 0 : 1;
4168   BFD_ASSERT (! abfd->output_has_begun);
4169   if (! _bfd_elf_compute_section_file_positions (abfd, info))
4170     goto error_return;
4171
4172   /* Figure out how many relocations we will have in each section.
4173      Just using RELOC_COUNT isn't good enough since that doesn't
4174      maintain a separate value for REL vs. RELA relocations.  */
4175   if (info->relocateable)
4176     for (sub = info->input_bfds; sub != NULL; sub = sub->link_next)
4177       for (o = sub->sections; o != NULL; o = o->next)
4178         {
4179           asection *output_section;
4180
4181           if (! o->linker_mark)
4182             {
4183               /* This section was omitted from the link.  */
4184               continue;
4185             }
4186
4187           output_section = o->output_section;
4188
4189           if (output_section != NULL
4190               && (o->flags & SEC_RELOC) != 0)
4191             {
4192               struct bfd_elf_section_data *esdi 
4193                 = elf_section_data (o);
4194               struct bfd_elf_section_data *esdo 
4195                 = elf_section_data (output_section);
4196               unsigned int *rel_count;
4197               unsigned int *rel_count2;
4198
4199               /* We must be careful to add the relocation froms the
4200                  input section to the right output count.  */
4201               if (esdi->rel_hdr.sh_entsize == esdo->rel_hdr.sh_entsize)
4202                 {
4203                   rel_count = &esdo->rel_count;
4204                   rel_count2 = &esdo->rel_count2;
4205                 }
4206               else
4207                 {
4208                   rel_count = &esdo->rel_count2;
4209                   rel_count2 = &esdo->rel_count;
4210                 }
4211               
4212               *rel_count += (esdi->rel_hdr.sh_size 
4213                              / esdi->rel_hdr.sh_entsize);
4214               if (esdi->rel_hdr2)
4215                 *rel_count2 += (esdi->rel_hdr2->sh_size 
4216                                 / esdi->rel_hdr2->sh_entsize);
4217             }
4218         }
4219
4220   /* That created the reloc sections.  Set their sizes, and assign
4221      them file positions, and allocate some buffers.  */
4222   for (o = abfd->sections; o != NULL; o = o->next)
4223     {
4224       if ((o->flags & SEC_RELOC) != 0)
4225         {
4226           if (!elf_link_size_reloc_section (abfd,
4227                                             &elf_section_data (o)->rel_hdr,
4228                                             o))
4229             goto error_return;
4230
4231           if (elf_section_data (o)->rel_hdr2
4232               && !elf_link_size_reloc_section (abfd,
4233                                                elf_section_data (o)->rel_hdr2,
4234                                                o))
4235             goto error_return;
4236         }
4237
4238       /* Now, reset REL_COUNT and REL_COUNT2 so that we can use them
4239          to count upwards while actually outputting the relocations. */
4240       elf_section_data (o)->rel_count = 0;
4241       elf_section_data (o)->rel_count2 = 0;
4242     }
4243
4244   _bfd_elf_assign_file_positions_for_relocs (abfd);
4245
4246   /* We have now assigned file positions for all the sections except
4247      .symtab and .strtab.  We start the .symtab section at the current
4248      file position, and write directly to it.  We build the .strtab
4249      section in memory.  */
4250   bfd_get_symcount (abfd) = 0;
4251   symtab_hdr = &elf_tdata (abfd)->symtab_hdr;
4252   /* sh_name is set in prep_headers.  */
4253   symtab_hdr->sh_type = SHT_SYMTAB;
4254   symtab_hdr->sh_flags = 0;
4255   symtab_hdr->sh_addr = 0;
4256   symtab_hdr->sh_size = 0;
4257   symtab_hdr->sh_entsize = sizeof (Elf_External_Sym);
4258   /* sh_link is set in assign_section_numbers.  */
4259   /* sh_info is set below.  */
4260   /* sh_offset is set just below.  */
4261   symtab_hdr->sh_addralign = 4;  /* FIXME: system dependent?  */
4262
4263   off = elf_tdata (abfd)->next_file_pos;
4264   off = _bfd_elf_assign_file_position_for_section (symtab_hdr, off, true);
4265
4266   /* Note that at this point elf_tdata (abfd)->next_file_pos is
4267      incorrect.  We do not yet know the size of the .symtab section.
4268      We correct next_file_pos below, after we do know the size.  */
4269
4270   /* Allocate a buffer to hold swapped out symbols.  This is to avoid
4271      continuously seeking to the right position in the file.  */
4272   if (! info->keep_memory || max_sym_count < 20)
4273     finfo.symbuf_size = 20;
4274   else
4275     finfo.symbuf_size = max_sym_count;
4276   finfo.symbuf = ((Elf_External_Sym *)
4277                   bfd_malloc (finfo.symbuf_size * sizeof (Elf_External_Sym)));
4278   if (finfo.symbuf == NULL)
4279     goto error_return;
4280
4281   /* Start writing out the symbol table.  The first symbol is always a
4282      dummy symbol.  */
4283   if (info->strip != strip_all || info->relocateable)
4284     {
4285       elfsym.st_value = 0;
4286       elfsym.st_size = 0;
4287       elfsym.st_info = 0;
4288       elfsym.st_other = 0;
4289       elfsym.st_shndx = SHN_UNDEF;
4290       if (! elf_link_output_sym (&finfo, (const char *) NULL,
4291                                  &elfsym, bfd_und_section_ptr))
4292         goto error_return;
4293     }
4294
4295 #if 0
4296   /* Some standard ELF linkers do this, but we don't because it causes
4297      bootstrap comparison failures.  */
4298   /* Output a file symbol for the output file as the second symbol.
4299      We output this even if we are discarding local symbols, although
4300      I'm not sure if this is correct.  */
4301   elfsym.st_value = 0;
4302   elfsym.st_size = 0;
4303   elfsym.st_info = ELF_ST_INFO (STB_LOCAL, STT_FILE);
4304   elfsym.st_other = 0;
4305   elfsym.st_shndx = SHN_ABS;
4306   if (! elf_link_output_sym (&finfo, bfd_get_filename (abfd),
4307                              &elfsym, bfd_abs_section_ptr))
4308     goto error_return;
4309 #endif
4310
4311   /* Output a symbol for each section.  We output these even if we are
4312      discarding local symbols, since they are used for relocs.  These
4313      symbols have no names.  We store the index of each one in the
4314      index field of the section, so that we can find it again when
4315      outputting relocs.  */
4316   if (info->strip != strip_all || info->relocateable)
4317     {
4318       elfsym.st_size = 0;
4319       elfsym.st_info = ELF_ST_INFO (STB_LOCAL, STT_SECTION);
4320       elfsym.st_other = 0;
4321       for (i = 1; i < elf_elfheader (abfd)->e_shnum; i++)
4322         {
4323           o = section_from_elf_index (abfd, i);
4324           if (o != NULL)
4325             o->target_index = bfd_get_symcount (abfd);
4326           elfsym.st_shndx = i;
4327           if (info->relocateable || o == NULL)
4328             elfsym.st_value = 0;
4329           else
4330             elfsym.st_value = o->vma;
4331           if (! elf_link_output_sym (&finfo, (const char *) NULL,
4332                                      &elfsym, o))
4333             goto error_return;
4334         }
4335     }
4336
4337   /* Allocate some memory to hold information read in from the input
4338      files.  */
4339   finfo.contents = (bfd_byte *) bfd_malloc (max_contents_size);
4340   finfo.external_relocs = (PTR) bfd_malloc (max_external_reloc_size);
4341   finfo.internal_relocs = ((Elf_Internal_Rela *)
4342                            bfd_malloc (max_internal_reloc_count
4343                                        * sizeof (Elf_Internal_Rela)
4344                                        * bed->s->int_rels_per_ext_rel));
4345   finfo.external_syms = ((Elf_External_Sym *)
4346                          bfd_malloc (max_sym_count
4347                                      * sizeof (Elf_External_Sym)));
4348   finfo.internal_syms = ((Elf_Internal_Sym *)
4349                          bfd_malloc (max_sym_count
4350                                      * sizeof (Elf_Internal_Sym)));
4351   finfo.indices = (long *) bfd_malloc (max_sym_count * sizeof (long));
4352   finfo.sections = ((asection **)
4353                     bfd_malloc (max_sym_count * sizeof (asection *)));
4354   if ((finfo.contents == NULL && max_contents_size != 0)
4355       || (finfo.external_relocs == NULL && max_external_reloc_size != 0)
4356       || (finfo.internal_relocs == NULL && max_internal_reloc_count != 0)
4357       || (finfo.external_syms == NULL && max_sym_count != 0)
4358       || (finfo.internal_syms == NULL && max_sym_count != 0)
4359       || (finfo.indices == NULL && max_sym_count != 0)
4360       || (finfo.sections == NULL && max_sym_count != 0))
4361     goto error_return;
4362
4363   /* Since ELF permits relocations to be against local symbols, we
4364      must have the local symbols available when we do the relocations.
4365      Since we would rather only read the local symbols once, and we
4366      would rather not keep them in memory, we handle all the
4367      relocations for a single input file at the same time.
4368
4369      Unfortunately, there is no way to know the total number of local
4370      symbols until we have seen all of them, and the local symbol
4371      indices precede the global symbol indices.  This means that when
4372      we are generating relocateable output, and we see a reloc against
4373      a global symbol, we can not know the symbol index until we have
4374      finished examining all the local symbols to see which ones we are
4375      going to output.  To deal with this, we keep the relocations in
4376      memory, and don't output them until the end of the link.  This is
4377      an unfortunate waste of memory, but I don't see a good way around
4378      it.  Fortunately, it only happens when performing a relocateable
4379      link, which is not the common case.  FIXME: If keep_memory is set
4380      we could write the relocs out and then read them again; I don't
4381      know how bad the memory loss will be.  */
4382
4383   for (sub = info->input_bfds; sub != NULL; sub = sub->link_next)
4384     sub->output_has_begun = false;
4385   for (o = abfd->sections; o != NULL; o = o->next)
4386     {
4387       for (p = o->link_order_head; p != NULL; p = p->next)
4388         {
4389           if (p->type == bfd_indirect_link_order
4390               && (bfd_get_flavour (p->u.indirect.section->owner)
4391                   == bfd_target_elf_flavour))
4392             {
4393               sub = p->u.indirect.section->owner;
4394               if (! sub->output_has_begun)
4395                 {
4396                   if (! elf_link_input_bfd (&finfo, sub))
4397                     goto error_return;
4398                   sub->output_has_begun = true;
4399                 }
4400             }
4401           else if (p->type == bfd_section_reloc_link_order
4402                    || p->type == bfd_symbol_reloc_link_order)
4403             {
4404               if (! elf_reloc_link_order (abfd, info, o, p))
4405                 goto error_return;
4406             }
4407           else
4408             {
4409               if (! _bfd_default_link_order (abfd, info, o, p))
4410                 goto error_return;
4411             }
4412         }
4413     }
4414
4415   /* That wrote out all the local symbols.  Finish up the symbol table
4416      with the global symbols.  */
4417
4418   if (info->strip != strip_all && info->shared)
4419     {
4420       /* Output any global symbols that got converted to local in a
4421          version script.  We do this in a separate step since ELF
4422          requires all local symbols to appear prior to any global
4423          symbols.  FIXME: We should only do this if some global
4424          symbols were, in fact, converted to become local.  FIXME:
4425          Will this work correctly with the Irix 5 linker?  */
4426       eoinfo.failed = false;
4427       eoinfo.finfo = &finfo;
4428       eoinfo.localsyms = true;
4429       elf_link_hash_traverse (elf_hash_table (info), elf_link_output_extsym,
4430                               (PTR) &eoinfo);
4431       if (eoinfo.failed)
4432         return false;
4433     }
4434
4435   /* The sh_info field records the index of the first non local symbol.  */
4436   symtab_hdr->sh_info = bfd_get_symcount (abfd);
4437
4438   if (dynamic)
4439     {
4440       Elf_Internal_Sym sym;
4441       Elf_External_Sym *dynsym =
4442         (Elf_External_Sym *)finfo.dynsym_sec->contents;
4443       long last_local = 0;
4444
4445       /* Write out the section symbols for the output sections.  */
4446       if (info->shared)
4447         {
4448           asection *s;
4449
4450           sym.st_size = 0;
4451           sym.st_name = 0;
4452           sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_SECTION);
4453           sym.st_other = 0;
4454
4455           for (s = abfd->sections; s != NULL; s = s->next)
4456             {
4457               int indx;
4458               indx = elf_section_data (s)->this_idx;
4459               BFD_ASSERT (indx > 0);
4460               sym.st_shndx = indx;
4461               sym.st_value = s->vma;
4462
4463               elf_swap_symbol_out (abfd, &sym,
4464                                    dynsym + elf_section_data (s)->dynindx);
4465             }
4466
4467           last_local = bfd_count_sections (abfd);
4468         }
4469
4470       /* Write out the local dynsyms.  */
4471       if (elf_hash_table (info)->dynlocal)
4472         {
4473           struct elf_link_local_dynamic_entry *e;
4474           for (e = elf_hash_table (info)->dynlocal; e ; e = e->next)
4475             {
4476               asection *s;
4477
4478               sym.st_size = e->isym.st_size;
4479               sym.st_other = e->isym.st_other;
4480
4481               /* Copy the internal symbol as is.
4482                  Note that we saved a word of storage and overwrote
4483                  the original st_name with the dynstr_index.  */
4484               sym = e->isym;
4485
4486               if (e->isym.st_shndx > 0 && e->isym.st_shndx < SHN_LORESERVE)
4487                 {
4488                   s = bfd_section_from_elf_index (e->input_bfd,
4489                                                   e->isym.st_shndx);
4490
4491                   sym.st_shndx =
4492                     elf_section_data (s->output_section)->this_idx;
4493                   sym.st_value = (s->output_section->vma
4494                                   + s->output_offset
4495                                   + e->isym.st_value);
4496                 }
4497
4498               if (last_local < e->dynindx)
4499                 last_local = e->dynindx;
4500
4501               elf_swap_symbol_out (abfd, &sym, dynsym + e->dynindx);
4502             }
4503         }
4504
4505       elf_section_data (finfo.dynsym_sec->output_section)->this_hdr.sh_info =
4506         last_local + 1;
4507     }
4508
4509   /* We get the global symbols from the hash table.  */
4510   eoinfo.failed = false;
4511   eoinfo.localsyms = false;
4512   eoinfo.finfo = &finfo;
4513   elf_link_hash_traverse (elf_hash_table (info), elf_link_output_extsym,
4514                           (PTR) &eoinfo);
4515   if (eoinfo.failed)
4516     return false;
4517
4518   /* If backend needs to output some symbols not present in the hash
4519      table, do it now.  */
4520   if (bed->elf_backend_output_arch_syms)
4521     {
4522       if (! (*bed->elf_backend_output_arch_syms)
4523               (abfd, info, (PTR) &finfo,
4524                (boolean (*) PARAMS ((PTR, const char *,
4525                             Elf_Internal_Sym *, asection *)))
4526                elf_link_output_sym))
4527         return false;
4528     }      
4529
4530   /* Flush all symbols to the file.  */
4531   if (! elf_link_flush_output_syms (&finfo))
4532     return false;
4533
4534   /* Now we know the size of the symtab section.  */
4535   off += symtab_hdr->sh_size;
4536
4537   /* Finish up and write out the symbol string table (.strtab)
4538      section.  */
4539   symstrtab_hdr = &elf_tdata (abfd)->strtab_hdr;
4540   /* sh_name was set in prep_headers.  */
4541   symstrtab_hdr->sh_type = SHT_STRTAB;
4542   symstrtab_hdr->sh_flags = 0;
4543   symstrtab_hdr->sh_addr = 0;
4544   symstrtab_hdr->sh_size = _bfd_stringtab_size (finfo.symstrtab);
4545   symstrtab_hdr->sh_entsize = 0;
4546   symstrtab_hdr->sh_link = 0;
4547   symstrtab_hdr->sh_info = 0;
4548   /* sh_offset is set just below.  */
4549   symstrtab_hdr->sh_addralign = 1;
4550
4551   off = _bfd_elf_assign_file_position_for_section (symstrtab_hdr, off, true);
4552   elf_tdata (abfd)->next_file_pos = off;
4553
4554   if (bfd_get_symcount (abfd) > 0)
4555     {
4556       if (bfd_seek (abfd, symstrtab_hdr->sh_offset, SEEK_SET) != 0
4557           || ! _bfd_stringtab_emit (abfd, finfo.symstrtab))
4558         return false;
4559     }
4560
4561   /* Adjust the relocs to have the correct symbol indices.  */
4562   for (o = abfd->sections; o != NULL; o = o->next)
4563     {
4564       if ((o->flags & SEC_RELOC) == 0)
4565         continue;
4566
4567       elf_link_adjust_relocs (abfd, &elf_section_data (o)->rel_hdr, 
4568                               elf_section_data (o)->rel_count,
4569                               elf_section_data (o)->rel_hashes);
4570       if (elf_section_data (o)->rel_hdr2 != NULL)
4571         elf_link_adjust_relocs (abfd, elf_section_data (o)->rel_hdr2,
4572                                 elf_section_data (o)->rel_count2,
4573                                 (elf_section_data (o)->rel_hashes 
4574                                  + elf_section_data (o)->rel_count));
4575
4576       /* Set the reloc_count field to 0 to prevent write_relocs from
4577          trying to swap the relocs out itself.  */
4578       o->reloc_count = 0;
4579     }
4580
4581   /* If we are linking against a dynamic object, or generating a
4582      shared library, finish up the dynamic linking information.  */
4583   if (dynamic)
4584     {
4585       Elf_External_Dyn *dyncon, *dynconend;
4586
4587       /* Fix up .dynamic entries.  */
4588       o = bfd_get_section_by_name (dynobj, ".dynamic");
4589       BFD_ASSERT (o != NULL);
4590
4591       dyncon = (Elf_External_Dyn *) o->contents;
4592       dynconend = (Elf_External_Dyn *) (o->contents + o->_raw_size);
4593       for (; dyncon < dynconend; dyncon++)
4594         {
4595           Elf_Internal_Dyn dyn;
4596           const char *name;
4597           unsigned int type;
4598
4599           elf_swap_dyn_in (dynobj, dyncon, &dyn);
4600
4601           switch (dyn.d_tag)
4602             {
4603             default:
4604               break;
4605             case DT_INIT:
4606               name = info->init_function;
4607               goto get_sym;
4608             case DT_FINI:
4609               name = info->fini_function;
4610             get_sym:
4611               {
4612                 struct elf_link_hash_entry *h;
4613
4614                 h = elf_link_hash_lookup (elf_hash_table (info), name,
4615                                           false, false, true);
4616                 if (h != NULL
4617                     && (h->root.type == bfd_link_hash_defined
4618                         || h->root.type == bfd_link_hash_defweak))
4619                   {
4620                     dyn.d_un.d_val = h->root.u.def.value;
4621                     o = h->root.u.def.section;
4622                     if (o->output_section != NULL)
4623                       dyn.d_un.d_val += (o->output_section->vma
4624                                          + o->output_offset);
4625                     else
4626                       {
4627                         /* The symbol is imported from another shared
4628                            library and does not apply to this one.  */
4629                         dyn.d_un.d_val = 0;
4630                       }
4631
4632                     elf_swap_dyn_out (dynobj, &dyn, dyncon);
4633                   }
4634               }
4635               break;
4636
4637             case DT_HASH:
4638               name = ".hash";
4639               goto get_vma;
4640             case DT_STRTAB:
4641               name = ".dynstr";
4642               goto get_vma;
4643             case DT_SYMTAB:
4644               name = ".dynsym";
4645               goto get_vma;
4646             case DT_VERDEF:
4647               name = ".gnu.version_d";
4648               goto get_vma;
4649             case DT_VERNEED:
4650               name = ".gnu.version_r";
4651               goto get_vma;
4652             case DT_VERSYM:
4653               name = ".gnu.version";
4654             get_vma:
4655               o = bfd_get_section_by_name (abfd, name);
4656               BFD_ASSERT (o != NULL);
4657               dyn.d_un.d_ptr = o->vma;
4658               elf_swap_dyn_out (dynobj, &dyn, dyncon);
4659               break;
4660
4661             case DT_REL:
4662             case DT_RELA:
4663             case DT_RELSZ:
4664             case DT_RELASZ:
4665               if (dyn.d_tag == DT_REL || dyn.d_tag == DT_RELSZ)
4666                 type = SHT_REL;
4667               else
4668                 type = SHT_RELA;
4669               dyn.d_un.d_val = 0;
4670               for (i = 1; i < elf_elfheader (abfd)->e_shnum; i++)
4671                 {
4672                   Elf_Internal_Shdr *hdr;
4673
4674                   hdr = elf_elfsections (abfd)[i];
4675                   if (hdr->sh_type == type
4676                       && (hdr->sh_flags & SHF_ALLOC) != 0)
4677                     {
4678                       if (dyn.d_tag == DT_RELSZ || dyn.d_tag == DT_RELASZ)
4679                         dyn.d_un.d_val += hdr->sh_size;
4680                       else
4681                         {
4682                           if (dyn.d_un.d_val == 0
4683                               || hdr->sh_addr < dyn.d_un.d_val)
4684                             dyn.d_un.d_val = hdr->sh_addr;
4685                         }
4686                     }
4687                 }
4688               elf_swap_dyn_out (dynobj, &dyn, dyncon);
4689               break;
4690             }
4691         }
4692     }
4693
4694   /* If we have created any dynamic sections, then output them.  */
4695   if (dynobj != NULL)
4696     {
4697       if (! (*bed->elf_backend_finish_dynamic_sections) (abfd, info))
4698         goto error_return;
4699
4700       for (o = dynobj->sections; o != NULL; o = o->next)
4701         {
4702           if ((o->flags & SEC_HAS_CONTENTS) == 0
4703               || o->_raw_size == 0)
4704             continue;
4705           if ((o->flags & SEC_LINKER_CREATED) == 0)
4706             {
4707               /* At this point, we are only interested in sections
4708                  created by elf_link_create_dynamic_sections.  */
4709               continue;
4710             }
4711           if ((elf_section_data (o->output_section)->this_hdr.sh_type
4712                != SHT_STRTAB)
4713               || strcmp (bfd_get_section_name (abfd, o), ".dynstr") != 0)
4714             {
4715               if (! bfd_set_section_contents (abfd, o->output_section,
4716                                               o->contents, o->output_offset,
4717                                               o->_raw_size))
4718                 goto error_return;
4719             }
4720           else
4721             {
4722               file_ptr off;
4723
4724               /* The contents of the .dynstr section are actually in a
4725                  stringtab.  */
4726               off = elf_section_data (o->output_section)->this_hdr.sh_offset;
4727               if (bfd_seek (abfd, off, SEEK_SET) != 0
4728                   || ! _bfd_stringtab_emit (abfd,
4729                                             elf_hash_table (info)->dynstr))
4730                 goto error_return;
4731             }
4732         }
4733     }
4734
4735   /* If we have optimized stabs strings, output them.  */
4736   if (elf_hash_table (info)->stab_info != NULL)
4737     {
4738       if (! _bfd_write_stab_strings (abfd, &elf_hash_table (info)->stab_info))
4739         goto error_return;
4740     }
4741
4742   if (finfo.symstrtab != NULL)
4743     _bfd_stringtab_free (finfo.symstrtab);
4744   if (finfo.contents != NULL)
4745     free (finfo.contents);
4746   if (finfo.external_relocs != NULL)
4747     free (finfo.external_relocs);
4748   if (finfo.internal_relocs != NULL)
4749     free (finfo.internal_relocs);
4750   if (finfo.external_syms != NULL)
4751     free (finfo.external_syms);
4752   if (finfo.internal_syms != NULL)
4753     free (finfo.internal_syms);
4754   if (finfo.indices != NULL)
4755     free (finfo.indices);
4756   if (finfo.sections != NULL)
4757     free (finfo.sections);
4758   if (finfo.symbuf != NULL)
4759     free (finfo.symbuf);
4760   for (o = abfd->sections; o != NULL; o = o->next)
4761     {
4762       if ((o->flags & SEC_RELOC) != 0
4763           && elf_section_data (o)->rel_hashes != NULL)
4764         free (elf_section_data (o)->rel_hashes);
4765     }
4766
4767   elf_tdata (abfd)->linker = true;
4768
4769   return true;
4770
4771  error_return:
4772   if (finfo.symstrtab != NULL)
4773     _bfd_stringtab_free (finfo.symstrtab);
4774   if (finfo.contents != NULL)
4775     free (finfo.contents);
4776   if (finfo.external_relocs != NULL)
4777     free (finfo.external_relocs);
4778   if (finfo.internal_relocs != NULL)
4779     free (finfo.internal_relocs);
4780   if (finfo.external_syms != NULL)
4781     free (finfo.external_syms);
4782   if (finfo.internal_syms != NULL)
4783     free (finfo.internal_syms);
4784   if (finfo.indices != NULL)
4785     free (finfo.indices);
4786   if (finfo.sections != NULL)
4787     free (finfo.sections);
4788   if (finfo.symbuf != NULL)
4789     free (finfo.symbuf);
4790   for (o = abfd->sections; o != NULL; o = o->next)
4791     {
4792       if ((o->flags & SEC_RELOC) != 0
4793           && elf_section_data (o)->rel_hashes != NULL)
4794         free (elf_section_data (o)->rel_hashes);
4795     }
4796
4797   return false;
4798 }
4799
4800 /* Add a symbol to the output symbol table.  */
4801
4802 static boolean
4803 elf_link_output_sym (finfo, name, elfsym, input_sec)
4804      struct elf_final_link_info *finfo;
4805      const char *name;
4806      Elf_Internal_Sym *elfsym;
4807      asection *input_sec;
4808 {
4809   boolean (*output_symbol_hook) PARAMS ((bfd *,
4810                                          struct bfd_link_info *info,
4811                                          const char *,
4812                                          Elf_Internal_Sym *,
4813                                          asection *));
4814
4815   output_symbol_hook = get_elf_backend_data (finfo->output_bfd)->
4816     elf_backend_link_output_symbol_hook;
4817   if (output_symbol_hook != NULL)
4818     {
4819       if (! ((*output_symbol_hook)
4820              (finfo->output_bfd, finfo->info, name, elfsym, input_sec)))
4821         return false;
4822     }
4823
4824   if (name == (const char *) NULL || *name == '\0')
4825     elfsym->st_name = 0;
4826   else if (input_sec->flags & SEC_EXCLUDE)
4827     elfsym->st_name = 0;
4828   else
4829     {
4830       elfsym->st_name = (unsigned long) _bfd_stringtab_add (finfo->symstrtab,
4831                                                             name, true,
4832                                                             false);
4833       if (elfsym->st_name == (unsigned long) -1)
4834         return false;
4835     }
4836
4837   if (finfo->symbuf_count >= finfo->symbuf_size)
4838     {
4839       if (! elf_link_flush_output_syms (finfo))
4840         return false;
4841     }
4842
4843   elf_swap_symbol_out (finfo->output_bfd, elfsym,
4844                        (PTR) (finfo->symbuf + finfo->symbuf_count));
4845   ++finfo->symbuf_count;
4846
4847   ++ bfd_get_symcount (finfo->output_bfd);
4848
4849   return true;
4850 }
4851
4852 /* Flush the output symbols to the file.  */
4853
4854 static boolean
4855 elf_link_flush_output_syms (finfo)
4856      struct elf_final_link_info *finfo;
4857 {
4858   if (finfo->symbuf_count > 0)
4859     {
4860       Elf_Internal_Shdr *symtab;
4861
4862       symtab = &elf_tdata (finfo->output_bfd)->symtab_hdr;
4863
4864       if (bfd_seek (finfo->output_bfd, symtab->sh_offset + symtab->sh_size,
4865                     SEEK_SET) != 0
4866           || (bfd_write ((PTR) finfo->symbuf, finfo->symbuf_count,
4867                          sizeof (Elf_External_Sym), finfo->output_bfd)
4868               != finfo->symbuf_count * sizeof (Elf_External_Sym)))
4869         return false;
4870
4871       symtab->sh_size += finfo->symbuf_count * sizeof (Elf_External_Sym);
4872
4873       finfo->symbuf_count = 0;
4874     }
4875
4876   return true;
4877 }
4878
4879 /* Add an external symbol to the symbol table.  This is called from
4880    the hash table traversal routine.  When generating a shared object,
4881    we go through the symbol table twice.  The first time we output
4882    anything that might have been forced to local scope in a version
4883    script.  The second time we output the symbols that are still
4884    global symbols.  */
4885
4886 static boolean
4887 elf_link_output_extsym (h, data)
4888      struct elf_link_hash_entry *h;
4889      PTR data;
4890 {
4891   struct elf_outext_info *eoinfo = (struct elf_outext_info *) data;
4892   struct elf_final_link_info *finfo = eoinfo->finfo;
4893   boolean strip;
4894   Elf_Internal_Sym sym;
4895   asection *input_sec;
4896
4897   /* Decide whether to output this symbol in this pass.  */
4898   if (eoinfo->localsyms)
4899     {
4900       if ((h->elf_link_hash_flags & ELF_LINK_FORCED_LOCAL) == 0)
4901         return true;
4902     }
4903   else
4904     {
4905       if ((h->elf_link_hash_flags & ELF_LINK_FORCED_LOCAL) != 0)
4906         return true;
4907     }
4908
4909   /* If we are not creating a shared library, and this symbol is
4910      referenced by a shared library but is not defined anywhere, then
4911      warn that it is undefined.  If we do not do this, the runtime
4912      linker will complain that the symbol is undefined when the
4913      program is run.  We don't have to worry about symbols that are
4914      referenced by regular files, because we will already have issued
4915      warnings for them.  */
4916   if (! finfo->info->relocateable
4917       && ! (finfo->info->shared
4918             && !finfo->info->no_undefined)
4919       && h->root.type == bfd_link_hash_undefined
4920       && (h->elf_link_hash_flags & ELF_LINK_HASH_REF_DYNAMIC) != 0
4921       && (h->elf_link_hash_flags & ELF_LINK_HASH_REF_REGULAR) == 0)
4922     {
4923       if (! ((*finfo->info->callbacks->undefined_symbol)
4924              (finfo->info, h->root.root.string, h->root.u.undef.abfd,
4925               (asection *) NULL, 0)))
4926         {
4927           eoinfo->failed = true;
4928           return false;
4929         }
4930     }
4931
4932   /* We don't want to output symbols that have never been mentioned by
4933      a regular file, or that we have been told to strip.  However, if
4934      h->indx is set to -2, the symbol is used by a reloc and we must
4935      output it.  */
4936   if (h->indx == -2)
4937     strip = false;
4938   else if (((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_DYNAMIC) != 0
4939             || (h->elf_link_hash_flags & ELF_LINK_HASH_REF_DYNAMIC) != 0)
4940            && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0
4941            && (h->elf_link_hash_flags & ELF_LINK_HASH_REF_REGULAR) == 0)
4942     strip = true;
4943   else if (finfo->info->strip == strip_all
4944            || (finfo->info->strip == strip_some
4945                && bfd_hash_lookup (finfo->info->keep_hash,
4946                                    h->root.root.string,
4947                                    false, false) == NULL))
4948     strip = true;
4949   else
4950     strip = false;
4951
4952   /* If we're stripping it, and it's not a dynamic symbol, there's
4953      nothing else to do.  */
4954   if (strip && h->dynindx == -1)
4955     return true;
4956
4957   sym.st_value = 0;
4958   sym.st_size = h->size;
4959   sym.st_other = h->other;
4960   if ((h->elf_link_hash_flags & ELF_LINK_FORCED_LOCAL) != 0)
4961     sym.st_info = ELF_ST_INFO (STB_LOCAL, h->type);
4962   else if (h->root.type == bfd_link_hash_undefweak
4963            || h->root.type == bfd_link_hash_defweak)
4964     sym.st_info = ELF_ST_INFO (STB_WEAK, h->type);
4965   else
4966     sym.st_info = ELF_ST_INFO (STB_GLOBAL, h->type);
4967
4968   switch (h->root.type)
4969     {
4970     default:
4971     case bfd_link_hash_new:
4972       abort ();
4973       return false;
4974
4975     case bfd_link_hash_undefined:
4976       input_sec = bfd_und_section_ptr;
4977       sym.st_shndx = SHN_UNDEF;
4978       break;
4979
4980     case bfd_link_hash_undefweak:
4981       input_sec = bfd_und_section_ptr;
4982       sym.st_shndx = SHN_UNDEF;
4983       break;
4984
4985     case bfd_link_hash_defined:
4986     case bfd_link_hash_defweak:
4987       {
4988         input_sec = h->root.u.def.section;
4989         if (input_sec->output_section != NULL)
4990           {
4991             sym.st_shndx =
4992               _bfd_elf_section_from_bfd_section (finfo->output_bfd,
4993                                                  input_sec->output_section);
4994             if (sym.st_shndx == (unsigned short) -1)
4995               {
4996                 (*_bfd_error_handler)
4997                   (_("%s: could not find output section %s for input section %s"),
4998                    bfd_get_filename (finfo->output_bfd),
4999                    input_sec->output_section->name,
5000                    input_sec->name);
5001                 eoinfo->failed = true;
5002                 return false;
5003               }
5004
5005             /* ELF symbols in relocateable files are section relative,
5006                but in nonrelocateable files they are virtual
5007                addresses.  */
5008             sym.st_value = h->root.u.def.value + input_sec->output_offset;
5009             if (! finfo->info->relocateable)
5010               sym.st_value += input_sec->output_section->vma;
5011           }
5012         else
5013           {
5014             BFD_ASSERT (input_sec->owner == NULL
5015                         || (input_sec->owner->flags & DYNAMIC) != 0);
5016             sym.st_shndx = SHN_UNDEF;
5017             input_sec = bfd_und_section_ptr;
5018           }
5019       }
5020       break;
5021
5022     case bfd_link_hash_common:
5023       input_sec = h->root.u.c.p->section;
5024       sym.st_shndx = SHN_COMMON;
5025       sym.st_value = 1 << h->root.u.c.p->alignment_power;
5026       break;
5027
5028     case bfd_link_hash_indirect:
5029       /* These symbols are created by symbol versioning.  They point
5030          to the decorated version of the name.  For example, if the
5031          symbol foo@@GNU_1.2 is the default, which should be used when
5032          foo is used with no version, then we add an indirect symbol
5033          foo which points to foo@@GNU_1.2.  We ignore these symbols,
5034          since the indirected symbol is already in the hash table.  If
5035          the indirect symbol is non-ELF, fall through and output it.  */
5036       if ((h->elf_link_hash_flags & ELF_LINK_NON_ELF) == 0)
5037         return true;
5038
5039       /* Fall through.  */
5040     case bfd_link_hash_warning:
5041       /* We can't represent these symbols in ELF, although a warning
5042          symbol may have come from a .gnu.warning.SYMBOL section.  We
5043          just put the target symbol in the hash table.  If the target
5044          symbol does not really exist, don't do anything.  */
5045       if (h->root.u.i.link->type == bfd_link_hash_new)
5046         return true;
5047       return (elf_link_output_extsym
5048               ((struct elf_link_hash_entry *) h->root.u.i.link, data));
5049     }
5050
5051   /* Give the processor backend a chance to tweak the symbol value,
5052      and also to finish up anything that needs to be done for this
5053      symbol.  */
5054   if ((h->dynindx != -1
5055        || (h->elf_link_hash_flags & ELF_LINK_FORCED_LOCAL) != 0)
5056       && elf_hash_table (finfo->info)->dynamic_sections_created)
5057     {
5058       struct elf_backend_data *bed;
5059
5060       bed = get_elf_backend_data (finfo->output_bfd);
5061       if (! ((*bed->elf_backend_finish_dynamic_symbol)
5062              (finfo->output_bfd, finfo->info, h, &sym)))
5063         {
5064           eoinfo->failed = true;
5065           return false;
5066         }
5067     }
5068
5069   /* If we are marking the symbol as undefined, and there are no
5070      non-weak references to this symbol from a regular object, then
5071      mark the symbol as weak undefined; if there are non-weak
5072      references, mark the symbol as strong.  We can't do this earlier,
5073      because it might not be marked as undefined until the
5074      finish_dynamic_symbol routine gets through with it.  */
5075   if (sym.st_shndx == SHN_UNDEF
5076       && (h->elf_link_hash_flags & ELF_LINK_HASH_REF_REGULAR) != 0
5077       && (ELF_ST_BIND(sym.st_info) == STB_GLOBAL
5078           || ELF_ST_BIND(sym.st_info) == STB_WEAK))
5079     {
5080       int bindtype;
5081
5082       if ((h->elf_link_hash_flags & ELF_LINK_HASH_REF_REGULAR_NONWEAK) != 0)
5083         bindtype = STB_GLOBAL;
5084       else
5085         bindtype = STB_WEAK;
5086       sym.st_info = ELF_ST_INFO (bindtype, ELF_ST_TYPE (sym.st_info));
5087     }
5088
5089   /* If this symbol should be put in the .dynsym section, then put it
5090      there now.  We have already know the symbol index.  We also fill
5091      in the entry in the .hash section.  */
5092   if (h->dynindx != -1
5093       && elf_hash_table (finfo->info)->dynamic_sections_created)
5094     {
5095       size_t bucketcount;
5096       size_t bucket;
5097       size_t hash_entry_size;
5098       bfd_byte *bucketpos;
5099       bfd_vma chain;
5100
5101       sym.st_name = h->dynstr_index;
5102
5103       elf_swap_symbol_out (finfo->output_bfd, &sym,
5104                            (PTR) (((Elf_External_Sym *)
5105                                    finfo->dynsym_sec->contents)
5106                                   + h->dynindx));
5107
5108       bucketcount = elf_hash_table (finfo->info)->bucketcount;
5109       bucket = h->elf_hash_value % bucketcount;
5110       hash_entry_size 
5111         = elf_section_data (finfo->hash_sec)->this_hdr.sh_entsize;
5112       bucketpos = ((bfd_byte *) finfo->hash_sec->contents
5113                    + (bucket + 2) * hash_entry_size);
5114       chain = bfd_get (8 * hash_entry_size, finfo->output_bfd, bucketpos);
5115       bfd_put (8 * hash_entry_size, finfo->output_bfd, h->dynindx, bucketpos);
5116       bfd_put (8 * hash_entry_size, finfo->output_bfd, chain,
5117                ((bfd_byte *) finfo->hash_sec->contents
5118                 + (bucketcount + 2 + h->dynindx) * hash_entry_size));
5119
5120       if (finfo->symver_sec != NULL && finfo->symver_sec->contents != NULL)
5121         {
5122           Elf_Internal_Versym iversym;
5123
5124           if ((h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR) == 0)
5125             {
5126               if (h->verinfo.verdef == NULL)
5127                 iversym.vs_vers = 0;
5128               else
5129                 iversym.vs_vers = h->verinfo.verdef->vd_exp_refno + 1;
5130             }
5131           else
5132             {
5133               if (h->verinfo.vertree == NULL)
5134                 iversym.vs_vers = 1;
5135               else
5136                 iversym.vs_vers = h->verinfo.vertree->vernum + 1;
5137             }
5138
5139           if ((h->elf_link_hash_flags & ELF_LINK_HIDDEN) != 0)
5140             iversym.vs_vers |= VERSYM_HIDDEN;
5141
5142           _bfd_elf_swap_versym_out (finfo->output_bfd, &iversym,
5143                                     (((Elf_External_Versym *)
5144                                       finfo->symver_sec->contents)
5145                                      + h->dynindx));
5146         }
5147     }
5148
5149   /* If we're stripping it, then it was just a dynamic symbol, and
5150      there's nothing else to do.  */
5151   if (strip)
5152     return true;
5153
5154   h->indx = bfd_get_symcount (finfo->output_bfd);
5155
5156   if (! elf_link_output_sym (finfo, h->root.root.string, &sym, input_sec))
5157     {
5158       eoinfo->failed = true;
5159       return false;
5160     }
5161
5162   return true;
5163 }
5164
5165 /* Copy the relocations indicated by the INTERNAL_RELOCS (which
5166    originated from the section given by INPUT_REL_HDR) to the
5167    OUTPUT_BFD.  */
5168
5169 static void
5170 elf_link_output_relocs (output_bfd, input_section, input_rel_hdr, 
5171                         internal_relocs)
5172      bfd *output_bfd;
5173      asection *input_section;
5174      Elf_Internal_Shdr *input_rel_hdr;
5175      Elf_Internal_Rela *internal_relocs;
5176 {
5177   Elf_Internal_Rela *irela;
5178   Elf_Internal_Rela *irelaend;
5179   Elf_Internal_Shdr *output_rel_hdr;
5180   asection *output_section;
5181   unsigned int *rel_countp = NULL;
5182
5183   output_section = input_section->output_section;
5184   output_rel_hdr = NULL;
5185
5186   if (elf_section_data (output_section)->rel_hdr.sh_entsize 
5187       == input_rel_hdr->sh_entsize)
5188     {
5189       output_rel_hdr = &elf_section_data (output_section)->rel_hdr;
5190       rel_countp = &elf_section_data (output_section)->rel_count;
5191     }
5192   else if (elf_section_data (output_section)->rel_hdr2
5193            && (elf_section_data (output_section)->rel_hdr2->sh_entsize
5194                == input_rel_hdr->sh_entsize))
5195     {
5196       output_rel_hdr = elf_section_data (output_section)->rel_hdr2;
5197       rel_countp = &elf_section_data (output_section)->rel_count2;
5198     }
5199
5200   BFD_ASSERT (output_rel_hdr != NULL);
5201   
5202   irela = internal_relocs;
5203   irelaend = irela + input_rel_hdr->sh_size / input_rel_hdr->sh_entsize;
5204   if (input_rel_hdr->sh_entsize == sizeof (Elf_External_Rel))
5205     {
5206       Elf_External_Rel *erel;
5207
5208       erel = ((Elf_External_Rel *) output_rel_hdr->contents + *rel_countp);
5209       for (; irela < irelaend; irela++, erel++)
5210         {
5211           Elf_Internal_Rel irel;
5212
5213           irel.r_offset = irela->r_offset;
5214           irel.r_info = irela->r_info;
5215           BFD_ASSERT (irela->r_addend == 0);
5216           elf_swap_reloc_out (output_bfd, &irel, erel);
5217         }
5218     }
5219   else
5220     {
5221       Elf_External_Rela *erela;
5222
5223       BFD_ASSERT (input_rel_hdr->sh_entsize
5224                   == sizeof (Elf_External_Rela));
5225       erela = ((Elf_External_Rela *) output_rel_hdr->contents + *rel_countp);
5226       for (; irela < irelaend; irela++, erela++)
5227         elf_swap_reloca_out (output_bfd, irela, erela);
5228     }
5229
5230   /* Bump the counter, so that we know where to add the next set of
5231      relocations.  */
5232   *rel_countp += input_rel_hdr->sh_size / input_rel_hdr->sh_entsize;
5233 }
5234
5235 /* Link an input file into the linker output file.  This function
5236    handles all the sections and relocations of the input file at once.
5237    This is so that we only have to read the local symbols once, and
5238    don't have to keep them in memory.  */
5239
5240 static boolean
5241 elf_link_input_bfd (finfo, input_bfd)
5242      struct elf_final_link_info *finfo;
5243      bfd *input_bfd;
5244 {
5245   boolean (*relocate_section) PARAMS ((bfd *, struct bfd_link_info *,
5246                                        bfd *, asection *, bfd_byte *,
5247                                        Elf_Internal_Rela *,
5248                                        Elf_Internal_Sym *, asection **));
5249   bfd *output_bfd;
5250   Elf_Internal_Shdr *symtab_hdr;
5251   size_t locsymcount;
5252   size_t extsymoff;
5253   Elf_External_Sym *external_syms;
5254   Elf_External_Sym *esym;
5255   Elf_External_Sym *esymend;
5256   Elf_Internal_Sym *isym;
5257   long *pindex;
5258   asection **ppsection;
5259   asection *o;
5260   struct elf_backend_data *bed;
5261
5262   output_bfd = finfo->output_bfd;
5263   bed = get_elf_backend_data (output_bfd);
5264   relocate_section = bed->elf_backend_relocate_section;
5265
5266   /* If this is a dynamic object, we don't want to do anything here:
5267      we don't want the local symbols, and we don't want the section
5268      contents.  */
5269   if ((input_bfd->flags & DYNAMIC) != 0)
5270     return true;
5271
5272   symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
5273   if (elf_bad_symtab (input_bfd))
5274     {
5275       locsymcount = symtab_hdr->sh_size / sizeof (Elf_External_Sym);
5276       extsymoff = 0;
5277     }
5278   else
5279     {
5280       locsymcount = symtab_hdr->sh_info;
5281       extsymoff = symtab_hdr->sh_info;
5282     }
5283
5284   /* Read the local symbols.  */
5285   if (symtab_hdr->contents != NULL)
5286     external_syms = (Elf_External_Sym *) symtab_hdr->contents;
5287   else if (locsymcount == 0)
5288     external_syms = NULL;
5289   else
5290     {
5291       external_syms = finfo->external_syms;
5292       if (bfd_seek (input_bfd, symtab_hdr->sh_offset, SEEK_SET) != 0
5293           || (bfd_read (external_syms, sizeof (Elf_External_Sym),
5294                         locsymcount, input_bfd)
5295               != locsymcount * sizeof (Elf_External_Sym)))
5296         return false;
5297     }
5298
5299   /* Swap in the local symbols and write out the ones which we know
5300      are going into the output file.  */
5301   esym = external_syms;
5302   esymend = esym + locsymcount;
5303   isym = finfo->internal_syms;
5304   pindex = finfo->indices;
5305   ppsection = finfo->sections;
5306   for (; esym < esymend; esym++, isym++, pindex++, ppsection++)
5307     {
5308       asection *isec;
5309       const char *name;
5310       Elf_Internal_Sym osym;
5311
5312       elf_swap_symbol_in (input_bfd, esym, isym);
5313       *pindex = -1;
5314
5315       if (elf_bad_symtab (input_bfd))
5316         {
5317           if (ELF_ST_BIND (isym->st_info) != STB_LOCAL)
5318             {
5319               *ppsection = NULL;
5320               continue;
5321             }
5322         }
5323
5324       if (isym->st_shndx == SHN_UNDEF)
5325         isec = bfd_und_section_ptr;
5326       else if (isym->st_shndx > 0 && isym->st_shndx < SHN_LORESERVE)
5327         isec = section_from_elf_index (input_bfd, isym->st_shndx);
5328       else if (isym->st_shndx == SHN_ABS)
5329         isec = bfd_abs_section_ptr;
5330       else if (isym->st_shndx == SHN_COMMON)
5331         isec = bfd_com_section_ptr;
5332       else
5333         {
5334           /* Who knows?  */
5335           isec = NULL;
5336         }
5337
5338       *ppsection = isec;
5339
5340       /* Don't output the first, undefined, symbol.  */
5341       if (esym == external_syms)
5342         continue;
5343
5344       /* If we are stripping all symbols, we don't want to output this
5345          one.  */
5346       if (finfo->info->strip == strip_all)
5347         continue;
5348
5349       /* We never output section symbols.  Instead, we use the section
5350          symbol of the corresponding section in the output file.  */
5351       if (ELF_ST_TYPE (isym->st_info) == STT_SECTION)
5352         continue;
5353
5354       /* If we are discarding all local symbols, we don't want to
5355          output this one.  If we are generating a relocateable output
5356          file, then some of the local symbols may be required by
5357          relocs; we output them below as we discover that they are
5358          needed.  */
5359       if (finfo->info->discard == discard_all)
5360         continue;
5361
5362       /* If this symbol is defined in a section which we are
5363          discarding, we don't need to keep it, but note that
5364          linker_mark is only reliable for sections that have contents.
5365          For the benefit of the MIPS ELF linker, we check SEC_EXCLUDE
5366          as well as linker_mark.  */
5367       if (isym->st_shndx > 0
5368           && isym->st_shndx < SHN_LORESERVE
5369           && isec != NULL
5370           && ((! isec->linker_mark && (isec->flags & SEC_HAS_CONTENTS) != 0)
5371               || (! finfo->info->relocateable
5372                   && (isec->flags & SEC_EXCLUDE) != 0)))
5373         continue;
5374
5375       /* Get the name of the symbol.  */
5376       name = bfd_elf_string_from_elf_section (input_bfd, symtab_hdr->sh_link,
5377                                               isym->st_name);
5378       if (name == NULL)
5379         return false;
5380
5381       /* See if we are discarding symbols with this name.  */
5382       if ((finfo->info->strip == strip_some
5383            && (bfd_hash_lookup (finfo->info->keep_hash, name, false, false)
5384                == NULL))
5385           || (finfo->info->discard == discard_l
5386               && bfd_is_local_label_name (input_bfd, name)))
5387         continue;
5388
5389       /* If we get here, we are going to output this symbol.  */
5390
5391       osym = *isym;
5392
5393       /* Adjust the section index for the output file.  */
5394       osym.st_shndx = _bfd_elf_section_from_bfd_section (output_bfd,
5395                                                          isec->output_section);
5396       if (osym.st_shndx == (unsigned short) -1)
5397         return false;
5398
5399       *pindex = bfd_get_symcount (output_bfd);
5400
5401       /* ELF symbols in relocateable files are section relative, but
5402          in executable files they are virtual addresses.  Note that
5403          this code assumes that all ELF sections have an associated
5404          BFD section with a reasonable value for output_offset; below
5405          we assume that they also have a reasonable value for
5406          output_section.  Any special sections must be set up to meet
5407          these requirements.  */
5408       osym.st_value += isec->output_offset;
5409       if (! finfo->info->relocateable)
5410         osym.st_value += isec->output_section->vma;
5411
5412       if (! elf_link_output_sym (finfo, name, &osym, isec))
5413         return false;
5414     }
5415
5416   /* Relocate the contents of each section.  */
5417   for (o = input_bfd->sections; o != NULL; o = o->next)
5418     {
5419       bfd_byte *contents;
5420
5421       if (! o->linker_mark)
5422         {
5423           /* This section was omitted from the link.  */
5424           continue;
5425         }
5426
5427       if ((o->flags & SEC_HAS_CONTENTS) == 0
5428           || (o->_raw_size == 0 && (o->flags & SEC_RELOC) == 0))
5429         continue;
5430
5431       if ((o->flags & SEC_LINKER_CREATED) != 0)
5432         {
5433           /* Section was created by elf_link_create_dynamic_sections
5434              or somesuch.  */
5435           continue;
5436         }
5437
5438       /* Get the contents of the section.  They have been cached by a
5439          relaxation routine.  Note that o is a section in an input
5440          file, so the contents field will not have been set by any of
5441          the routines which work on output files.  */
5442       if (elf_section_data (o)->this_hdr.contents != NULL)
5443         contents = elf_section_data (o)->this_hdr.contents;
5444       else
5445         {
5446           contents = finfo->contents;
5447           if (! bfd_get_section_contents (input_bfd, o, contents,
5448                                           (file_ptr) 0, o->_raw_size))
5449             return false;
5450         }
5451
5452       if ((o->flags & SEC_RELOC) != 0)
5453         {
5454           Elf_Internal_Rela *internal_relocs;
5455
5456           /* Get the swapped relocs.  */
5457           internal_relocs = (NAME(_bfd_elf,link_read_relocs)
5458                              (input_bfd, o, finfo->external_relocs,
5459                               finfo->internal_relocs, false));
5460           if (internal_relocs == NULL
5461               && o->reloc_count > 0)
5462             return false;
5463
5464           /* Relocate the section by invoking a back end routine.
5465
5466              The back end routine is responsible for adjusting the
5467              section contents as necessary, and (if using Rela relocs
5468              and generating a relocateable output file) adjusting the
5469              reloc addend as necessary.
5470
5471              The back end routine does not have to worry about setting
5472              the reloc address or the reloc symbol index.
5473
5474              The back end routine is given a pointer to the swapped in
5475              internal symbols, and can access the hash table entries
5476              for the external symbols via elf_sym_hashes (input_bfd).
5477
5478              When generating relocateable output, the back end routine
5479              must handle STB_LOCAL/STT_SECTION symbols specially.  The
5480              output symbol is going to be a section symbol
5481              corresponding to the output section, which will require
5482              the addend to be adjusted.  */
5483
5484           if (! (*relocate_section) (output_bfd, finfo->info,
5485                                      input_bfd, o, contents,
5486                                      internal_relocs,
5487                                      finfo->internal_syms,
5488                                      finfo->sections))
5489             return false;
5490
5491           if (finfo->info->relocateable)
5492             {
5493               Elf_Internal_Rela *irela;
5494               Elf_Internal_Rela *irelaend;
5495               struct elf_link_hash_entry **rel_hash;
5496               Elf_Internal_Shdr *input_rel_hdr;
5497
5498               /* Adjust the reloc addresses and symbol indices.  */
5499
5500               irela = internal_relocs;
5501               irelaend = 
5502                 irela + o->reloc_count * bed->s->int_rels_per_ext_rel;
5503               rel_hash = (elf_section_data (o->output_section)->rel_hashes
5504                           + elf_section_data (o->output_section)->rel_count
5505                           + elf_section_data (o->output_section)->rel_count2);
5506               for (; irela < irelaend; irela++, rel_hash++)
5507                 {
5508                   unsigned long r_symndx;
5509                   Elf_Internal_Sym *isym;
5510                   asection *sec;
5511
5512                   irela->r_offset += o->output_offset;
5513
5514                   r_symndx = ELF_R_SYM (irela->r_info);
5515
5516                   if (r_symndx == 0)
5517                     continue;
5518
5519                   if (r_symndx >= locsymcount
5520                       || (elf_bad_symtab (input_bfd)
5521                           && finfo->sections[r_symndx] == NULL))
5522                     {
5523                       struct elf_link_hash_entry *rh;
5524                       long indx;
5525
5526                       /* This is a reloc against a global symbol.  We
5527                          have not yet output all the local symbols, so
5528                          we do not know the symbol index of any global
5529                          symbol.  We set the rel_hash entry for this
5530                          reloc to point to the global hash table entry
5531                          for this symbol.  The symbol index is then
5532                          set at the end of elf_bfd_final_link.  */
5533                       indx = r_symndx - extsymoff;
5534                       rh = elf_sym_hashes (input_bfd)[indx];
5535                       while (rh->root.type == bfd_link_hash_indirect
5536                              || rh->root.type == bfd_link_hash_warning)
5537                         rh = (struct elf_link_hash_entry *) rh->root.u.i.link;
5538
5539                       /* Setting the index to -2 tells
5540                          elf_link_output_extsym that this symbol is
5541                          used by a reloc.  */
5542                       BFD_ASSERT (rh->indx < 0);
5543                       rh->indx = -2;
5544
5545                       *rel_hash = rh;
5546
5547                       continue;
5548                     }
5549
5550                   /* This is a reloc against a local symbol. */
5551
5552                   *rel_hash = NULL;
5553                   isym = finfo->internal_syms + r_symndx;
5554                   sec = finfo->sections[r_symndx];
5555                   if (ELF_ST_TYPE (isym->st_info) == STT_SECTION)
5556                     {
5557                       /* I suppose the backend ought to fill in the
5558                          section of any STT_SECTION symbol against a
5559                          processor specific section.  If we have
5560                          discarded a section, the output_section will
5561                          be the absolute section.  */
5562                       if (sec != NULL
5563                           && (bfd_is_abs_section (sec)
5564                               || (sec->output_section != NULL
5565                                   && bfd_is_abs_section (sec->output_section))))
5566                         r_symndx = 0;
5567                       else if (sec == NULL || sec->owner == NULL)
5568                         {
5569                           bfd_set_error (bfd_error_bad_value);
5570                           return false;
5571                         }
5572                       else
5573                         {
5574                           r_symndx = sec->output_section->target_index;
5575                           BFD_ASSERT (r_symndx != 0);
5576                         }
5577                     }
5578                   else
5579                     {
5580                       if (finfo->indices[r_symndx] == -1)
5581                         {
5582                           unsigned long link;
5583                           const char *name;
5584                           asection *osec;
5585
5586                           if (finfo->info->strip == strip_all)
5587                             {
5588                               /* You can't do ld -r -s.  */
5589                               bfd_set_error (bfd_error_invalid_operation);
5590                               return false;
5591                             }
5592
5593                           /* This symbol was skipped earlier, but
5594                              since it is needed by a reloc, we
5595                              must output it now.  */
5596                           link = symtab_hdr->sh_link;
5597                           name = bfd_elf_string_from_elf_section (input_bfd,
5598                                                                   link,
5599                                                                   isym->st_name);
5600                           if (name == NULL)
5601                             return false;
5602
5603                           osec = sec->output_section;
5604                           isym->st_shndx =
5605                             _bfd_elf_section_from_bfd_section (output_bfd,
5606                                                                osec);
5607                           if (isym->st_shndx == (unsigned short) -1)
5608                             return false;
5609
5610                           isym->st_value += sec->output_offset;
5611                           if (! finfo->info->relocateable)
5612                             isym->st_value += osec->vma;
5613
5614                           finfo->indices[r_symndx] = bfd_get_symcount (output_bfd);
5615
5616                           if (! elf_link_output_sym (finfo, name, isym, sec))
5617                             return false;
5618                         }
5619
5620                       r_symndx = finfo->indices[r_symndx];
5621                     }
5622
5623                   irela->r_info = ELF_R_INFO (r_symndx,
5624                                               ELF_R_TYPE (irela->r_info));
5625                 }
5626
5627               /* Swap out the relocs.  */
5628               input_rel_hdr = &elf_section_data (o)->rel_hdr;
5629               elf_link_output_relocs (output_bfd, o, 
5630                                       input_rel_hdr,
5631                                       internal_relocs);
5632               internal_relocs 
5633                 += input_rel_hdr->sh_size / input_rel_hdr->sh_entsize;
5634               input_rel_hdr = elf_section_data (o)->rel_hdr2;
5635               if (input_rel_hdr)
5636                 elf_link_output_relocs (output_bfd, o, 
5637                                         input_rel_hdr,
5638                                         internal_relocs);
5639             }
5640         }
5641
5642       /* Write out the modified section contents.  */
5643       if (elf_section_data (o)->stab_info == NULL)
5644         {
5645           if (! (o->flags & SEC_EXCLUDE) &&
5646               ! bfd_set_section_contents (output_bfd, o->output_section,
5647                                           contents, o->output_offset,
5648                                           (o->_cooked_size != 0
5649                                            ? o->_cooked_size
5650                                            : o->_raw_size)))
5651             return false;
5652         }
5653       else
5654         {
5655           if (! (_bfd_write_section_stabs
5656                  (output_bfd, &elf_hash_table (finfo->info)->stab_info,
5657                   o, &elf_section_data (o)->stab_info, contents)))
5658             return false;
5659         }
5660     }
5661
5662   return true;
5663 }
5664
5665 /* Generate a reloc when linking an ELF file.  This is a reloc
5666    requested by the linker, and does come from any input file.  This
5667    is used to build constructor and destructor tables when linking
5668    with -Ur.  */
5669
5670 static boolean
5671 elf_reloc_link_order (output_bfd, info, output_section, link_order)
5672      bfd *output_bfd;
5673      struct bfd_link_info *info;
5674      asection *output_section;
5675      struct bfd_link_order *link_order;
5676 {
5677   reloc_howto_type *howto;
5678   long indx;
5679   bfd_vma offset;
5680   bfd_vma addend;
5681   struct elf_link_hash_entry **rel_hash_ptr;
5682   Elf_Internal_Shdr *rel_hdr;
5683
5684   howto = bfd_reloc_type_lookup (output_bfd, link_order->u.reloc.p->reloc);
5685   if (howto == NULL)
5686     {
5687       bfd_set_error (bfd_error_bad_value);
5688       return false;
5689     }
5690
5691   addend = link_order->u.reloc.p->addend;
5692
5693   /* Figure out the symbol index.  */
5694   rel_hash_ptr = (elf_section_data (output_section)->rel_hashes
5695                   + elf_section_data (output_section)->rel_count
5696                   + elf_section_data (output_section)->rel_count2);
5697   if (link_order->type == bfd_section_reloc_link_order)
5698     {
5699       indx = link_order->u.reloc.p->u.section->target_index;
5700       BFD_ASSERT (indx != 0);
5701       *rel_hash_ptr = NULL;
5702     }
5703   else
5704     {
5705       struct elf_link_hash_entry *h;
5706
5707       /* Treat a reloc against a defined symbol as though it were
5708          actually against the section.  */
5709       h = ((struct elf_link_hash_entry *)
5710            bfd_wrapped_link_hash_lookup (output_bfd, info,
5711                                          link_order->u.reloc.p->u.name,
5712                                          false, false, true));
5713       if (h != NULL
5714           && (h->root.type == bfd_link_hash_defined
5715               || h->root.type == bfd_link_hash_defweak))
5716         {
5717           asection *section;
5718
5719           section = h->root.u.def.section;
5720           indx = section->output_section->target_index;
5721           *rel_hash_ptr = NULL;
5722           /* It seems that we ought to add the symbol value to the
5723              addend here, but in practice it has already been added
5724              because it was passed to constructor_callback.  */
5725           addend += section->output_section->vma + section->output_offset;
5726         }
5727       else if (h != NULL)
5728         {
5729           /* Setting the index to -2 tells elf_link_output_extsym that
5730              this symbol is used by a reloc.  */
5731           h->indx = -2;
5732           *rel_hash_ptr = h;
5733           indx = 0;
5734         }
5735       else
5736         {
5737           if (! ((*info->callbacks->unattached_reloc)
5738                  (info, link_order->u.reloc.p->u.name, (bfd *) NULL,
5739                   (asection *) NULL, (bfd_vma) 0)))
5740             return false;
5741           indx = 0;
5742         }
5743     }
5744
5745   /* If this is an inplace reloc, we must write the addend into the
5746      object file.  */
5747   if (howto->partial_inplace && addend != 0)
5748     {
5749       bfd_size_type size;
5750       bfd_reloc_status_type rstat;
5751       bfd_byte *buf;
5752       boolean ok;
5753
5754       size = bfd_get_reloc_size (howto);
5755       buf = (bfd_byte *) bfd_zmalloc (size);
5756       if (buf == (bfd_byte *) NULL)
5757         return false;
5758       rstat = _bfd_relocate_contents (howto, output_bfd, addend, buf);
5759       switch (rstat)
5760         {
5761         case bfd_reloc_ok:
5762           break;
5763         default:
5764         case bfd_reloc_outofrange:
5765           abort ();
5766         case bfd_reloc_overflow:
5767           if (! ((*info->callbacks->reloc_overflow)
5768                  (info,
5769                   (link_order->type == bfd_section_reloc_link_order
5770                    ? bfd_section_name (output_bfd,
5771                                        link_order->u.reloc.p->u.section)
5772                    : link_order->u.reloc.p->u.name),
5773                   howto->name, addend, (bfd *) NULL, (asection *) NULL,
5774                   (bfd_vma) 0)))
5775             {
5776               free (buf);
5777               return false;
5778             }
5779           break;
5780         }
5781       ok = bfd_set_section_contents (output_bfd, output_section, (PTR) buf,
5782                                      (file_ptr) link_order->offset, size);
5783       free (buf);
5784       if (! ok)
5785         return false;
5786     }
5787
5788   /* The address of a reloc is relative to the section in a
5789      relocateable file, and is a virtual address in an executable
5790      file.  */
5791   offset = link_order->offset;
5792   if (! info->relocateable)
5793     offset += output_section->vma;
5794
5795   rel_hdr = &elf_section_data (output_section)->rel_hdr;
5796
5797   if (rel_hdr->sh_type == SHT_REL)
5798     {
5799       Elf_Internal_Rel irel;
5800       Elf_External_Rel *erel;
5801
5802       irel.r_offset = offset;
5803       irel.r_info = ELF_R_INFO (indx, howto->type);
5804       erel = ((Elf_External_Rel *) rel_hdr->contents
5805               + elf_section_data (output_section)->rel_count);
5806       elf_swap_reloc_out (output_bfd, &irel, erel);
5807     }
5808   else
5809     {
5810       Elf_Internal_Rela irela;
5811       Elf_External_Rela *erela;
5812
5813       irela.r_offset = offset;
5814       irela.r_info = ELF_R_INFO (indx, howto->type);
5815       irela.r_addend = addend;
5816       erela = ((Elf_External_Rela *) rel_hdr->contents
5817                + elf_section_data (output_section)->rel_count);
5818       elf_swap_reloca_out (output_bfd, &irela, erela);
5819     }
5820
5821   ++elf_section_data (output_section)->rel_count;
5822
5823   return true;
5824 }
5825
5826 \f
5827 /* Allocate a pointer to live in a linker created section.  */
5828
5829 boolean
5830 elf_create_pointer_linker_section (abfd, info, lsect, h, rel)
5831      bfd *abfd;
5832      struct bfd_link_info *info;
5833      elf_linker_section_t *lsect;
5834      struct elf_link_hash_entry *h;
5835      const Elf_Internal_Rela *rel;
5836 {
5837   elf_linker_section_pointers_t **ptr_linker_section_ptr = NULL;
5838   elf_linker_section_pointers_t *linker_section_ptr;
5839   unsigned long r_symndx = ELF_R_SYM (rel->r_info);;
5840
5841   BFD_ASSERT (lsect != NULL);
5842
5843   /* Is this a global symbol? */
5844   if (h != NULL)
5845     {
5846       /* Has this symbol already been allocated, if so, our work is done */
5847       if (_bfd_elf_find_pointer_linker_section (h->linker_section_pointer,
5848                                                 rel->r_addend,
5849                                                 lsect->which))
5850         return true;
5851
5852       ptr_linker_section_ptr = &h->linker_section_pointer;
5853       /* Make sure this symbol is output as a dynamic symbol.  */
5854       if (h->dynindx == -1)
5855         {
5856           if (! elf_link_record_dynamic_symbol (info, h))
5857             return false;
5858         }
5859
5860       if (lsect->rel_section)
5861         lsect->rel_section->_raw_size += sizeof (Elf_External_Rela);
5862     }
5863
5864   else  /* Allocation of a pointer to a local symbol */
5865     {
5866       elf_linker_section_pointers_t **ptr = elf_local_ptr_offsets (abfd);
5867
5868       /* Allocate a table to hold the local symbols if first time */
5869       if (!ptr)
5870         {
5871           unsigned int num_symbols = elf_tdata (abfd)->symtab_hdr.sh_info;
5872           register unsigned int i;
5873
5874           ptr = (elf_linker_section_pointers_t **)
5875             bfd_alloc (abfd, num_symbols * sizeof (elf_linker_section_pointers_t *));
5876
5877           if (!ptr)
5878             return false;
5879
5880           elf_local_ptr_offsets (abfd) = ptr;
5881           for (i = 0; i < num_symbols; i++)
5882             ptr[i] = (elf_linker_section_pointers_t *)0;
5883         }
5884
5885       /* Has this symbol already been allocated, if so, our work is done */
5886       if (_bfd_elf_find_pointer_linker_section (ptr[r_symndx],
5887                                                 rel->r_addend,
5888                                                 lsect->which))
5889         return true;
5890
5891       ptr_linker_section_ptr = &ptr[r_symndx];
5892
5893       if (info->shared)
5894         {
5895           /* If we are generating a shared object, we need to
5896              output a R_<xxx>_RELATIVE reloc so that the
5897              dynamic linker can adjust this GOT entry.  */
5898           BFD_ASSERT (lsect->rel_section != NULL);
5899           lsect->rel_section->_raw_size += sizeof (Elf_External_Rela);
5900         }
5901     }
5902
5903   /* Allocate space for a pointer in the linker section, and allocate a new pointer record
5904      from internal memory.  */
5905   BFD_ASSERT (ptr_linker_section_ptr != NULL);
5906   linker_section_ptr = (elf_linker_section_pointers_t *)
5907     bfd_alloc (abfd, sizeof (elf_linker_section_pointers_t));
5908
5909   if (!linker_section_ptr)
5910     return false;
5911
5912   linker_section_ptr->next = *ptr_linker_section_ptr;
5913   linker_section_ptr->addend = rel->r_addend;
5914   linker_section_ptr->which = lsect->which;
5915   linker_section_ptr->written_address_p = false;
5916   *ptr_linker_section_ptr = linker_section_ptr;
5917
5918 #if 0
5919   if (lsect->hole_size && lsect->hole_offset < lsect->max_hole_offset)
5920     {
5921       linker_section_ptr->offset = lsect->section->_raw_size - lsect->hole_size + (ARCH_SIZE / 8);
5922       lsect->hole_offset += ARCH_SIZE / 8;
5923       lsect->sym_offset  += ARCH_SIZE / 8;
5924       if (lsect->sym_hash)      /* Bump up symbol value if needed */
5925         {
5926           lsect->sym_hash->root.u.def.value += ARCH_SIZE / 8;
5927 #ifdef DEBUG
5928           fprintf (stderr, "Bump up %s by %ld, current value = %ld\n",
5929                    lsect->sym_hash->root.root.string,
5930                    (long)ARCH_SIZE / 8,
5931                    (long)lsect->sym_hash->root.u.def.value);
5932 #endif
5933         }
5934     }
5935   else
5936 #endif
5937     linker_section_ptr->offset = lsect->section->_raw_size;
5938
5939   lsect->section->_raw_size += ARCH_SIZE / 8;
5940
5941 #ifdef DEBUG
5942   fprintf (stderr, "Create pointer in linker section %s, offset = %ld, section size = %ld\n",
5943            lsect->name, (long)linker_section_ptr->offset, (long)lsect->section->_raw_size);
5944 #endif
5945
5946   return true;
5947 }
5948
5949 \f
5950 #if ARCH_SIZE==64
5951 #define bfd_put_ptr(BFD,VAL,ADDR) bfd_put_64 (BFD, VAL, ADDR)
5952 #endif
5953 #if ARCH_SIZE==32
5954 #define bfd_put_ptr(BFD,VAL,ADDR) bfd_put_32 (BFD, VAL, ADDR)
5955 #endif
5956
5957 /* Fill in the address for a pointer generated in alinker section.  */
5958
5959 bfd_vma
5960 elf_finish_pointer_linker_section (output_bfd, input_bfd, info, lsect, h, relocation, rel, relative_reloc)
5961      bfd *output_bfd;
5962      bfd *input_bfd;
5963      struct bfd_link_info *info;
5964      elf_linker_section_t *lsect;
5965      struct elf_link_hash_entry *h;
5966      bfd_vma relocation;
5967      const Elf_Internal_Rela *rel;
5968      int relative_reloc;
5969 {
5970   elf_linker_section_pointers_t *linker_section_ptr;
5971
5972   BFD_ASSERT (lsect != NULL);
5973
5974   if (h != NULL)                /* global symbol */
5975     {
5976       linker_section_ptr = _bfd_elf_find_pointer_linker_section (h->linker_section_pointer,
5977                                                                  rel->r_addend,
5978                                                                  lsect->which);
5979
5980       BFD_ASSERT (linker_section_ptr != NULL);
5981
5982       if (! elf_hash_table (info)->dynamic_sections_created
5983           || (info->shared
5984               && info->symbolic
5985               && (h->elf_link_hash_flags & ELF_LINK_HASH_DEF_REGULAR)))
5986         {
5987           /* This is actually a static link, or it is a
5988              -Bsymbolic link and the symbol is defined
5989              locally.  We must initialize this entry in the
5990              global section.
5991
5992              When doing a dynamic link, we create a .rela.<xxx>
5993              relocation entry to initialize the value.  This
5994              is done in the finish_dynamic_symbol routine.  */
5995           if (!linker_section_ptr->written_address_p)
5996             {
5997               linker_section_ptr->written_address_p = true;
5998               bfd_put_ptr (output_bfd, relocation + linker_section_ptr->addend,
5999                           lsect->section->contents + linker_section_ptr->offset);
6000             }
6001         }
6002     }
6003   else                          /* local symbol */
6004     {
6005       unsigned long r_symndx = ELF_R_SYM (rel->r_info);
6006       BFD_ASSERT (elf_local_ptr_offsets (input_bfd) != NULL);
6007       BFD_ASSERT (elf_local_ptr_offsets (input_bfd)[r_symndx] != NULL);
6008       linker_section_ptr = _bfd_elf_find_pointer_linker_section (elf_local_ptr_offsets (input_bfd)[r_symndx],
6009                                                                  rel->r_addend,
6010                                                                  lsect->which);
6011
6012       BFD_ASSERT (linker_section_ptr != NULL);
6013
6014       /* Write out pointer if it hasn't been rewritten out before */
6015       if (!linker_section_ptr->written_address_p)
6016         {
6017           linker_section_ptr->written_address_p = true;
6018           bfd_put_ptr (output_bfd, relocation + linker_section_ptr->addend,
6019                        lsect->section->contents + linker_section_ptr->offset);
6020
6021           if (info->shared)
6022             {
6023               asection *srel = lsect->rel_section;
6024               Elf_Internal_Rela outrel;
6025
6026               /* We need to generate a relative reloc for the dynamic linker.  */
6027               if (!srel)
6028                 lsect->rel_section = srel = bfd_get_section_by_name (elf_hash_table (info)->dynobj,
6029                                                                      lsect->rel_name);
6030
6031               BFD_ASSERT (srel != NULL);
6032
6033               outrel.r_offset = (lsect->section->output_section->vma
6034                                  + lsect->section->output_offset
6035                                  + linker_section_ptr->offset);
6036               outrel.r_info = ELF_R_INFO (0, relative_reloc);
6037               outrel.r_addend = 0;
6038               elf_swap_reloca_out (output_bfd, &outrel,
6039                                    (((Elf_External_Rela *)
6040                                      lsect->section->contents)
6041                                     + elf_section_data (lsect->section)->rel_count));
6042               ++elf_section_data (lsect->section)->rel_count;
6043             }
6044         }
6045     }
6046
6047   relocation = (lsect->section->output_offset
6048                 + linker_section_ptr->offset
6049                 - lsect->hole_offset
6050                 - lsect->sym_offset);
6051
6052 #ifdef DEBUG
6053   fprintf (stderr, "Finish pointer in linker section %s, offset = %ld (0x%lx)\n",
6054            lsect->name, (long)relocation, (long)relocation);
6055 #endif
6056
6057   /* Subtract out the addend, because it will get added back in by the normal
6058      processing.  */
6059   return relocation - linker_section_ptr->addend;
6060 }
6061 \f
6062 /* Garbage collect unused sections.  */
6063
6064 static boolean elf_gc_mark
6065   PARAMS ((struct bfd_link_info *info, asection *sec,
6066            asection * (*gc_mark_hook)
6067              PARAMS ((bfd *, struct bfd_link_info *, Elf_Internal_Rela *,
6068                       struct elf_link_hash_entry *, Elf_Internal_Sym *))));
6069
6070 static boolean elf_gc_sweep
6071   PARAMS ((struct bfd_link_info *info,
6072            boolean (*gc_sweep_hook)
6073              PARAMS ((bfd *abfd, struct bfd_link_info *info, asection *o,
6074                       const Elf_Internal_Rela *relocs))));
6075
6076 static boolean elf_gc_sweep_symbol
6077   PARAMS ((struct elf_link_hash_entry *h, PTR idxptr));
6078
6079 static boolean elf_gc_allocate_got_offsets
6080   PARAMS ((struct elf_link_hash_entry *h, PTR offarg));
6081
6082 static boolean elf_gc_propagate_vtable_entries_used
6083   PARAMS ((struct elf_link_hash_entry *h, PTR dummy));
6084
6085 static boolean elf_gc_smash_unused_vtentry_relocs
6086   PARAMS ((struct elf_link_hash_entry *h, PTR dummy));
6087
6088 /* The mark phase of garbage collection.  For a given section, mark
6089    it, and all the sections which define symbols to which it refers.  */
6090
6091 static boolean
6092 elf_gc_mark (info, sec, gc_mark_hook)
6093      struct bfd_link_info *info;
6094      asection *sec;
6095      asection * (*gc_mark_hook)
6096        PARAMS ((bfd *, struct bfd_link_info *, Elf_Internal_Rela *,
6097                 struct elf_link_hash_entry *, Elf_Internal_Sym *));
6098 {
6099   boolean ret = true;
6100
6101   sec->gc_mark = 1;
6102
6103   /* Look through the section relocs.  */
6104
6105   if ((sec->flags & SEC_RELOC) != 0 && sec->reloc_count > 0)
6106     {
6107       Elf_Internal_Rela *relstart, *rel, *relend;
6108       Elf_Internal_Shdr *symtab_hdr;
6109       struct elf_link_hash_entry **sym_hashes;
6110       size_t nlocsyms;
6111       size_t extsymoff;
6112       Elf_External_Sym *locsyms, *freesyms = NULL;
6113       bfd *input_bfd = sec->owner;
6114       struct elf_backend_data *bed = get_elf_backend_data (input_bfd);
6115
6116       /* GCFIXME: how to arrange so that relocs and symbols are not
6117          reread continually?  */
6118
6119       symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
6120       sym_hashes = elf_sym_hashes (input_bfd);
6121
6122       /* Read the local symbols.  */
6123       if (elf_bad_symtab (input_bfd))
6124         {
6125           nlocsyms = symtab_hdr->sh_size / sizeof (Elf_External_Sym);
6126           extsymoff = 0;
6127         }
6128       else
6129         extsymoff = nlocsyms = symtab_hdr->sh_info;
6130       if (symtab_hdr->contents)
6131         locsyms = (Elf_External_Sym *) symtab_hdr->contents;
6132       else if (nlocsyms == 0)
6133         locsyms = NULL;
6134       else
6135         {
6136           locsyms = freesyms =
6137             bfd_malloc (nlocsyms * sizeof (Elf_External_Sym));
6138           if (freesyms == NULL
6139               || bfd_seek (input_bfd, symtab_hdr->sh_offset, SEEK_SET) != 0
6140               || (bfd_read (locsyms, sizeof (Elf_External_Sym),
6141                             nlocsyms, input_bfd)
6142                   != nlocsyms * sizeof (Elf_External_Sym)))
6143             {
6144               ret = false;
6145               goto out1;
6146             }
6147         }
6148
6149       /* Read the relocations.  */
6150       relstart = (NAME(_bfd_elf,link_read_relocs)
6151                   (sec->owner, sec, NULL, (Elf_Internal_Rela *) NULL,
6152                    info->keep_memory));
6153       if (relstart == NULL)
6154         {
6155           ret = false;
6156           goto out1;
6157         }
6158       relend = relstart + sec->reloc_count * bed->s->int_rels_per_ext_rel;
6159
6160       for (rel = relstart; rel < relend; rel++)
6161         {
6162           unsigned long r_symndx;
6163           asection *rsec;
6164           struct elf_link_hash_entry *h;
6165           Elf_Internal_Sym s;
6166
6167           r_symndx = ELF_R_SYM (rel->r_info);
6168           if (r_symndx == 0)
6169             continue;
6170
6171           if (elf_bad_symtab (sec->owner))
6172             {
6173               elf_swap_symbol_in (input_bfd, &locsyms[r_symndx], &s);
6174               if (ELF_ST_BIND (s.st_info) == STB_LOCAL)
6175                 rsec = (*gc_mark_hook)(sec->owner, info, rel, NULL, &s);
6176               else
6177                 {
6178                   h = sym_hashes[r_symndx - extsymoff];
6179                   rsec = (*gc_mark_hook)(sec->owner, info, rel, h, NULL);
6180                 }
6181             }
6182           else if (r_symndx >= nlocsyms)
6183             {
6184               h = sym_hashes[r_symndx - extsymoff];
6185               rsec = (*gc_mark_hook)(sec->owner, info, rel, h, NULL);
6186             }
6187           else
6188             {
6189               elf_swap_symbol_in (input_bfd, &locsyms[r_symndx], &s);
6190               rsec = (*gc_mark_hook)(sec->owner, info, rel, NULL, &s);
6191             }
6192
6193           if (rsec && !rsec->gc_mark)
6194             if (!elf_gc_mark (info, rsec, gc_mark_hook))
6195               {
6196                 ret = false;
6197                 goto out2;
6198               }
6199         }
6200
6201     out2:
6202       if (!info->keep_memory)
6203         free (relstart);
6204     out1:
6205       if (freesyms)
6206         free (freesyms);
6207     }
6208
6209   return ret;
6210 }
6211
6212 /* The sweep phase of garbage collection.  Remove all garbage sections.  */
6213
6214 static boolean
6215 elf_gc_sweep (info, gc_sweep_hook)
6216      struct bfd_link_info *info;
6217      boolean (*gc_sweep_hook)
6218        PARAMS ((bfd *abfd, struct bfd_link_info *info, asection *o,
6219                 const Elf_Internal_Rela *relocs));
6220 {
6221   bfd *sub;
6222
6223   for (sub = info->input_bfds; sub != NULL; sub = sub->link_next)
6224     {
6225       asection *o;
6226
6227       for (o = sub->sections; o != NULL; o = o->next)
6228         {
6229           /* Keep special sections.  Keep .debug sections.  */
6230           if ((o->flags & SEC_LINKER_CREATED)
6231               || (o->flags & SEC_DEBUGGING))
6232             o->gc_mark = 1;
6233
6234           if (o->gc_mark)
6235             continue;
6236
6237           /* Skip sweeping sections already excluded.  */
6238           if (o->flags & SEC_EXCLUDE)
6239             continue;
6240
6241           /* Since this is early in the link process, it is simple
6242              to remove a section from the output.  */
6243           o->flags |= SEC_EXCLUDE;
6244
6245           /* But we also have to update some of the relocation
6246              info we collected before.  */
6247           if (gc_sweep_hook
6248               && (o->flags & SEC_RELOC) && o->reloc_count > 0)
6249             {
6250               Elf_Internal_Rela *internal_relocs;
6251               boolean r;
6252
6253               internal_relocs = (NAME(_bfd_elf,link_read_relocs)
6254                                  (o->owner, o, NULL, NULL, info->keep_memory));
6255               if (internal_relocs == NULL)
6256                 return false;
6257
6258               r = (*gc_sweep_hook)(o->owner, info, o, internal_relocs);
6259
6260               if (!info->keep_memory)
6261                 free (internal_relocs);
6262
6263               if (!r)
6264                 return false;
6265             }
6266         }
6267     }
6268
6269   /* Remove the symbols that were in the swept sections from the dynamic
6270      symbol table.  GCFIXME: Anyone know how to get them out of the
6271      static symbol table as well?  */
6272   {
6273     int i = 0;
6274
6275     elf_link_hash_traverse (elf_hash_table (info),
6276                             elf_gc_sweep_symbol,
6277                             (PTR) &i);
6278
6279     elf_hash_table (info)->dynsymcount = i;
6280   }
6281
6282   return true;
6283 }
6284
6285 /* Sweep symbols in swept sections.  Called via elf_link_hash_traverse.  */
6286
6287 static boolean
6288 elf_gc_sweep_symbol (h, idxptr)
6289      struct elf_link_hash_entry *h;
6290      PTR idxptr;
6291 {
6292   int *idx = (int *) idxptr;
6293
6294   if (h->dynindx != -1
6295       && ((h->root.type != bfd_link_hash_defined
6296            && h->root.type != bfd_link_hash_defweak)
6297           || h->root.u.def.section->gc_mark))
6298     h->dynindx = (*idx)++;
6299
6300   return true;
6301 }
6302
6303 /* Propogate collected vtable information.  This is called through
6304    elf_link_hash_traverse.  */
6305
6306 static boolean
6307 elf_gc_propagate_vtable_entries_used (h, okp)
6308      struct elf_link_hash_entry *h;
6309      PTR okp;
6310 {
6311   /* Those that are not vtables. */
6312   if (h->vtable_parent == NULL)
6313     return true;
6314
6315   /* Those vtables that do not have parents, we cannot merge.  */
6316   if (h->vtable_parent == (struct elf_link_hash_entry *) -1)
6317     return true;
6318
6319   /* If we've already been done, exit.  */
6320   if (h->vtable_entries_used && h->vtable_entries_used[-1])
6321     return true;
6322
6323   /* Make sure the parent's table is up to date.  */
6324   elf_gc_propagate_vtable_entries_used (h->vtable_parent, okp);
6325
6326   if (h->vtable_entries_used == NULL)
6327     {
6328       /* None of this table's entries were referenced.  Re-use the
6329          parent's table.  */
6330       h->vtable_entries_used = h->vtable_parent->vtable_entries_used;
6331       h->vtable_entries_size = h->vtable_parent->vtable_entries_size;
6332     }
6333   else
6334     {
6335       size_t n;
6336       boolean *cu, *pu;
6337
6338       /* Or the parent's entries into ours.  */
6339       cu = h->vtable_entries_used;
6340       cu[-1] = true;
6341       pu = h->vtable_parent->vtable_entries_used;
6342       if (pu != NULL)
6343         {
6344           n = h->vtable_parent->vtable_entries_size / FILE_ALIGN;
6345           while (--n != 0)
6346             {
6347               if (*pu) *cu = true;
6348               pu++, cu++;
6349             }
6350         }
6351     }
6352
6353   return true;
6354 }
6355
6356 static boolean
6357 elf_gc_smash_unused_vtentry_relocs (h, okp)
6358      struct elf_link_hash_entry *h;
6359      PTR okp;
6360 {
6361   asection *sec;
6362   bfd_vma hstart, hend;
6363   Elf_Internal_Rela *relstart, *relend, *rel;
6364   struct elf_backend_data *bed;
6365
6366   /* Take care of both those symbols that do not describe vtables as
6367      well as those that are not loaded.  */
6368   if (h->vtable_parent == NULL)
6369     return true;
6370
6371   BFD_ASSERT (h->root.type == bfd_link_hash_defined
6372               || h->root.type == bfd_link_hash_defweak);
6373
6374   sec = h->root.u.def.section;
6375   hstart = h->root.u.def.value;
6376   hend = hstart + h->size;
6377
6378   relstart = (NAME(_bfd_elf,link_read_relocs)
6379               (sec->owner, sec, NULL, (Elf_Internal_Rela *) NULL, true));
6380   if (!relstart)
6381     return *(boolean *)okp = false;
6382   bed = get_elf_backend_data (sec->owner);
6383   relend = relstart + sec->reloc_count * bed->s->int_rels_per_ext_rel;
6384
6385   for (rel = relstart; rel < relend; ++rel)
6386     if (rel->r_offset >= hstart && rel->r_offset < hend)
6387       {
6388         /* If the entry is in use, do nothing.  */
6389         if (h->vtable_entries_used
6390             && (rel->r_offset - hstart) < h->vtable_entries_size)
6391           {
6392             bfd_vma entry = (rel->r_offset - hstart) / FILE_ALIGN;
6393             if (h->vtable_entries_used[entry])
6394               continue;
6395           }
6396         /* Otherwise, kill it.  */
6397         rel->r_offset = rel->r_info = rel->r_addend = 0;
6398       }
6399
6400   return true;
6401 }
6402
6403 /* Do mark and sweep of unused sections.  */
6404
6405 boolean
6406 elf_gc_sections (abfd, info)
6407      bfd *abfd;
6408      struct bfd_link_info *info;
6409 {
6410   boolean ok = true;
6411   bfd *sub;
6412   asection * (*gc_mark_hook)
6413     PARAMS ((bfd *abfd, struct bfd_link_info *, Elf_Internal_Rela *,
6414              struct elf_link_hash_entry *h, Elf_Internal_Sym *));
6415
6416   if (!get_elf_backend_data (abfd)->can_gc_sections
6417       || info->relocateable
6418       || elf_hash_table (info)->dynamic_sections_created)
6419     return true;
6420
6421   /* Apply transitive closure to the vtable entry usage info.  */
6422   elf_link_hash_traverse (elf_hash_table (info),
6423                           elf_gc_propagate_vtable_entries_used,
6424                           (PTR) &ok);
6425   if (!ok)
6426     return false;
6427
6428   /* Kill the vtable relocations that were not used.  */
6429   elf_link_hash_traverse (elf_hash_table (info),
6430                           elf_gc_smash_unused_vtentry_relocs,
6431                           (PTR) &ok);
6432   if (!ok)
6433     return false;
6434
6435   /* Grovel through relocs to find out who stays ...  */
6436
6437   gc_mark_hook = get_elf_backend_data (abfd)->gc_mark_hook;
6438   for (sub = info->input_bfds; sub != NULL; sub = sub->link_next)
6439     {
6440       asection *o;
6441       for (o = sub->sections; o != NULL; o = o->next)
6442         {
6443           if (o->flags & SEC_KEEP)
6444             if (!elf_gc_mark (info, o, gc_mark_hook))
6445               return false;
6446         }
6447     }
6448
6449   /* ... and mark SEC_EXCLUDE for those that go.  */
6450   if (!elf_gc_sweep(info, get_elf_backend_data (abfd)->gc_sweep_hook))
6451     return false;
6452
6453   return true;
6454 }
6455 \f
6456 /* Called from check_relocs to record the existance of a VTINHERIT reloc.  */
6457
6458 boolean
6459 elf_gc_record_vtinherit (abfd, sec, h, offset)
6460      bfd *abfd;
6461      asection *sec;
6462      struct elf_link_hash_entry *h;
6463      bfd_vma offset;
6464 {
6465   struct elf_link_hash_entry **sym_hashes, **sym_hashes_end;
6466   struct elf_link_hash_entry **search, *child;
6467   bfd_size_type extsymcount;
6468
6469   /* The sh_info field of the symtab header tells us where the
6470      external symbols start.  We don't care about the local symbols at
6471      this point.  */
6472   extsymcount = elf_tdata (abfd)->symtab_hdr.sh_size/sizeof (Elf_External_Sym);
6473   if (!elf_bad_symtab (abfd))
6474     extsymcount -= elf_tdata (abfd)->symtab_hdr.sh_info;
6475
6476   sym_hashes = elf_sym_hashes (abfd);
6477   sym_hashes_end = sym_hashes + extsymcount;
6478
6479   /* Hunt down the child symbol, which is in this section at the same
6480      offset as the relocation.  */
6481   for (search = sym_hashes; search != sym_hashes_end; ++search)
6482     {
6483       if ((child = *search) != NULL
6484           && (child->root.type == bfd_link_hash_defined
6485               || child->root.type == bfd_link_hash_defweak)
6486           && child->root.u.def.section == sec
6487           && child->root.u.def.value == offset)
6488         goto win;
6489     }
6490
6491   (*_bfd_error_handler) ("%s: %s+%lu: No symbol found for INHERIT",
6492                          bfd_get_filename (abfd), sec->name,
6493                          (unsigned long)offset);
6494   bfd_set_error (bfd_error_invalid_operation);
6495   return false;
6496
6497 win:
6498   if (!h)
6499     {
6500       /* This *should* only be the absolute section.  It could potentially
6501          be that someone has defined a non-global vtable though, which
6502          would be bad.  It isn't worth paging in the local symbols to be
6503          sure though; that case should simply be handled by the assembler.  */
6504
6505       child->vtable_parent = (struct elf_link_hash_entry *) -1;
6506     }
6507   else
6508     child->vtable_parent = h;
6509
6510   return true;
6511 }
6512
6513 /* Called from check_relocs to record the existance of a VTENTRY reloc.  */
6514
6515 boolean
6516 elf_gc_record_vtentry (abfd, sec, h, addend)
6517      bfd *abfd ATTRIBUTE_UNUSED;
6518      asection *sec ATTRIBUTE_UNUSED;
6519      struct elf_link_hash_entry *h;
6520      bfd_vma addend;
6521 {
6522   if (addend >= h->vtable_entries_size)
6523     {
6524       size_t size, bytes;
6525       boolean *ptr = h->vtable_entries_used;
6526
6527       /* While the symbol is undefined, we have to be prepared to handle
6528          a zero size.  */
6529       if (h->root.type == bfd_link_hash_undefined)
6530         size = addend;
6531       else
6532         {
6533           size = h->size;
6534           if (size < addend)
6535             {
6536               /* Oops!  We've got a reference past the defined end of
6537                  the table.  This is probably a bug -- shall we warn?  */
6538               size = addend;
6539             }
6540         }
6541
6542       /* Allocate one extra entry for use as a "done" flag for the
6543          consolidation pass.  */
6544       bytes = (size / FILE_ALIGN + 1) * sizeof (boolean);
6545
6546       if (ptr)
6547         {
6548           ptr = bfd_realloc (ptr - 1, bytes);
6549           
6550           if (ptr != NULL)
6551             {
6552               size_t oldbytes;
6553
6554               oldbytes = (h->vtable_entries_size/FILE_ALIGN + 1) * sizeof (boolean);
6555               memset (((char *)ptr) + oldbytes, 0, bytes - oldbytes);
6556             }
6557         }
6558       else
6559         ptr = bfd_zmalloc (bytes);
6560
6561       if (ptr == NULL)
6562         return false;
6563       
6564       /* And arrange for that done flag to be at index -1.  */
6565       h->vtable_entries_used = ptr + 1;
6566       h->vtable_entries_size = size;
6567     }
6568   
6569   h->vtable_entries_used[addend / FILE_ALIGN] = true;
6570
6571   return true;
6572 }
6573
6574 /* And an accompanying bit to work out final got entry offsets once
6575    we're done.  Should be called from final_link.  */
6576
6577 boolean
6578 elf_gc_common_finalize_got_offsets (abfd, info)
6579      bfd *abfd;
6580      struct bfd_link_info *info;
6581 {
6582   bfd *i;
6583   struct elf_backend_data *bed = get_elf_backend_data (abfd);
6584   bfd_vma gotoff;
6585
6586   /* The GOT offset is relative to the .got section, but the GOT header is
6587      put into the .got.plt section, if the backend uses it.  */
6588   if (bed->want_got_plt)
6589     gotoff = 0;
6590   else
6591     gotoff = bed->got_header_size;
6592
6593   /* Do the local .got entries first.  */
6594   for (i = info->input_bfds; i; i = i->link_next)
6595     {
6596       bfd_signed_vma *local_got = elf_local_got_refcounts (i);
6597       bfd_size_type j, locsymcount;
6598       Elf_Internal_Shdr *symtab_hdr;
6599
6600       if (!local_got)
6601         continue;
6602
6603       symtab_hdr = &elf_tdata (i)->symtab_hdr;
6604       if (elf_bad_symtab (i))
6605         locsymcount = symtab_hdr->sh_size / sizeof (Elf_External_Sym);
6606       else
6607         locsymcount = symtab_hdr->sh_info;
6608
6609       for (j = 0; j < locsymcount; ++j)
6610         {
6611           if (local_got[j] > 0)
6612             {
6613               local_got[j] = gotoff;
6614               gotoff += ARCH_SIZE / 8;
6615             }
6616           else
6617             local_got[j] = (bfd_vma) -1;
6618         }
6619     }
6620
6621   /* Then the global .got and .plt entries.  */
6622   elf_link_hash_traverse (elf_hash_table (info),
6623                           elf_gc_allocate_got_offsets,
6624                           (PTR) &gotoff);
6625   return true;
6626 }
6627
6628 /* We need a special top-level link routine to convert got reference counts
6629    to real got offsets.  */
6630
6631 static boolean
6632 elf_gc_allocate_got_offsets (h, offarg)
6633      struct elf_link_hash_entry *h;
6634      PTR offarg;
6635 {
6636   bfd_vma *off = (bfd_vma *) offarg;
6637
6638   if (h->got.refcount > 0)
6639     {
6640       h->got.offset = off[0];
6641       off[0] += ARCH_SIZE / 8;
6642     }
6643   else
6644     h->got.offset = (bfd_vma) -1;
6645
6646   return true;
6647 }
6648
6649 /* Many folk need no more in the way of final link than this, once
6650    got entry reference counting is enabled.  */
6651
6652 boolean
6653 elf_gc_common_final_link (abfd, info)
6654      bfd *abfd;
6655      struct bfd_link_info *info;
6656 {
6657   if (!elf_gc_common_finalize_got_offsets (abfd, info))
6658     return false;
6659
6660   /* Invoke the regular ELF backend linker to do all the work.  */
6661   return elf_bfd_final_link (abfd, info);
6662 }
6663
6664 /* This function will be called though elf_link_hash_traverse to store
6665    all hash value of the exported symbols in an array.  */
6666
6667 static boolean
6668 elf_collect_hash_codes (h, data)
6669      struct elf_link_hash_entry *h;
6670      PTR data;
6671 {
6672   unsigned long **valuep = (unsigned long **) data;
6673   const char *name;
6674   char *p;
6675   unsigned long ha;
6676   char *alc = NULL;
6677
6678   /* Ignore indirect symbols.  These are added by the versioning code.  */
6679   if (h->dynindx == -1)
6680     return true;
6681
6682   name = h->root.root.string;
6683   p = strchr (name, ELF_VER_CHR);
6684   if (p != NULL)
6685     {
6686       alc = bfd_malloc (p - name + 1);
6687       memcpy (alc, name, p - name);
6688       alc[p - name] = '\0';
6689       name = alc;
6690     }
6691
6692   /* Compute the hash value.  */
6693   ha = bfd_elf_hash (name);
6694
6695   /* Store the found hash value in the array given as the argument.  */
6696   *(*valuep)++ = ha;
6697
6698   /* And store it in the struct so that we can put it in the hash table
6699      later.  */
6700   h->elf_hash_value = ha;
6701
6702   if (alc != NULL)
6703     free (alc);
6704
6705   return true;
6706 }
This page took 0.427326 seconds and 4 git commands to generate.