Home | History | Annotate | Download | only in bfd
      1 /* Matsushita 10200 specific support for 32-bit ELF
      2    Copyright (C) 1996-2016 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 3 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., 51 Franklin Street - Fifth Floor, Boston,
     19    MA 02110-1301, USA.  */
     20 
     21 #include "sysdep.h"
     22 #include "bfd.h"
     23 #include "libbfd.h"
     24 #include "elf-bfd.h"
     25 
     26 static bfd_boolean
     27 mn10200_elf_relax_delete_bytes (bfd *, asection *, bfd_vma, int);
     28 static bfd_boolean
     29 mn10200_elf_symbol_address_p (bfd *, asection *, Elf_Internal_Sym *, bfd_vma);
     30 
     31 enum reloc_type
     32 {
     33   R_MN10200_NONE = 0,
     34   R_MN10200_32,
     35   R_MN10200_16,
     36   R_MN10200_8,
     37   R_MN10200_24,
     38   R_MN10200_PCREL8,
     39   R_MN10200_PCREL16,
     40   R_MN10200_PCREL24,
     41   R_MN10200_MAX
     42 };
     43 
     44 static reloc_howto_type elf_mn10200_howto_table[] =
     45 {
     46   /* Dummy relocation.  Does nothing.  */
     47   HOWTO (R_MN10200_NONE,
     48 	 0,
     49 	 3,
     50 	 0,
     51 	 FALSE,
     52 	 0,
     53 	 complain_overflow_dont,
     54 	 bfd_elf_generic_reloc,
     55 	 "R_MN10200_NONE",
     56 	 FALSE,
     57 	 0,
     58 	 0,
     59 	 FALSE),
     60   /* Standard 32 bit reloc.  */
     61   HOWTO (R_MN10200_32,
     62 	 0,
     63 	 2,
     64 	 32,
     65 	 FALSE,
     66 	 0,
     67 	 complain_overflow_bitfield,
     68 	 bfd_elf_generic_reloc,
     69 	 "R_MN10200_32",
     70 	 FALSE,
     71 	 0xffffffff,
     72 	 0xffffffff,
     73 	 FALSE),
     74   /* Standard 16 bit reloc.  */
     75   HOWTO (R_MN10200_16,
     76 	 0,
     77 	 1,
     78 	 16,
     79 	 FALSE,
     80 	 0,
     81 	 complain_overflow_bitfield,
     82 	 bfd_elf_generic_reloc,
     83 	 "R_MN10200_16",
     84 	 FALSE,
     85 	 0xffff,
     86 	 0xffff,
     87 	 FALSE),
     88   /* Standard 8 bit reloc.  */
     89   HOWTO (R_MN10200_8,
     90 	 0,
     91 	 0,
     92 	 8,
     93 	 FALSE,
     94 	 0,
     95 	 complain_overflow_bitfield,
     96 	 bfd_elf_generic_reloc,
     97 	 "R_MN10200_8",
     98 	 FALSE,
     99 	 0xff,
    100 	 0xff,
    101 	 FALSE),
    102   /* Standard 24 bit reloc.  */
    103   HOWTO (R_MN10200_24,
    104 	 0,
    105 	 2,
    106 	 24,
    107 	 FALSE,
    108 	 0,
    109 	 complain_overflow_bitfield,
    110 	 bfd_elf_generic_reloc,
    111 	 "R_MN10200_24",
    112 	 FALSE,
    113 	 0xffffff,
    114 	 0xffffff,
    115 	 FALSE),
    116   /* Simple 8 pc-relative reloc.  */
    117   HOWTO (R_MN10200_PCREL8,
    118 	 0,
    119 	 0,
    120 	 8,
    121 	 TRUE,
    122 	 0,
    123 	 complain_overflow_bitfield,
    124 	 bfd_elf_generic_reloc,
    125 	 "R_MN10200_PCREL8",
    126 	 FALSE,
    127 	 0xff,
    128 	 0xff,
    129 	 TRUE),
    130   /* Simple 16 pc-relative reloc.  */
    131   HOWTO (R_MN10200_PCREL16,
    132 	 0,
    133 	 1,
    134 	 16,
    135 	 TRUE,
    136 	 0,
    137 	 complain_overflow_bitfield,
    138 	 bfd_elf_generic_reloc,
    139 	 "R_MN10200_PCREL16",
    140 	 FALSE,
    141 	 0xffff,
    142 	 0xffff,
    143 	 TRUE),
    144   /* Simple 32bit pc-relative reloc with a 1 byte adjustment
    145      to get the pc-relative offset correct.  */
    146   HOWTO (R_MN10200_PCREL24,
    147 	 0,
    148 	 2,
    149 	 24,
    150 	 TRUE,
    151 	 0,
    152 	 complain_overflow_bitfield,
    153 	 bfd_elf_generic_reloc,
    154 	 "R_MN10200_PCREL24",
    155 	 FALSE,
    156 	 0xffffff,
    157 	 0xffffff,
    158 	 TRUE),
    159 };
    160 
    161 struct mn10200_reloc_map
    162 {
    163   bfd_reloc_code_real_type bfd_reloc_val;
    164   unsigned char elf_reloc_val;
    165 };
    166 
    167 static const struct mn10200_reloc_map mn10200_reloc_map[] =
    168 {
    169   { BFD_RELOC_NONE    , R_MN10200_NONE   , },
    170   { BFD_RELOC_32      , R_MN10200_32     , },
    171   { BFD_RELOC_16      , R_MN10200_16     , },
    172   { BFD_RELOC_8       , R_MN10200_8      , },
    173   { BFD_RELOC_24      , R_MN10200_24     , },
    174   { BFD_RELOC_8_PCREL , R_MN10200_PCREL8 , },
    175   { BFD_RELOC_16_PCREL, R_MN10200_PCREL16, },
    176   { BFD_RELOC_24_PCREL, R_MN10200_PCREL24, },
    177 };
    178 
    179 static reloc_howto_type *
    180 bfd_elf32_bfd_reloc_type_lookup (bfd *abfd ATTRIBUTE_UNUSED,
    181 				 bfd_reloc_code_real_type code)
    182 {
    183   unsigned int i;
    184 
    185   for (i = 0;
    186        i < sizeof (mn10200_reloc_map) / sizeof (struct mn10200_reloc_map);
    187        i++)
    188     {
    189       if (mn10200_reloc_map[i].bfd_reloc_val == code)
    190 	return &elf_mn10200_howto_table[mn10200_reloc_map[i].elf_reloc_val];
    191     }
    192 
    193   return NULL;
    194 }
    195 
    196 static reloc_howto_type *
    197 bfd_elf32_bfd_reloc_name_lookup (bfd *abfd ATTRIBUTE_UNUSED,
    198 				 const char *r_name)
    199 {
    200   unsigned int i;
    201 
    202   for (i = 0;
    203        i < (sizeof (elf_mn10200_howto_table)
    204 	    / sizeof (elf_mn10200_howto_table[0]));
    205        i++)
    206     if (elf_mn10200_howto_table[i].name != NULL
    207 	&& strcasecmp (elf_mn10200_howto_table[i].name, r_name) == 0)
    208       return &elf_mn10200_howto_table[i];
    209 
    210   return NULL;
    211 }
    212 
    213 /* Set the howto pointer for an MN10200 ELF reloc.  */
    214 
    215 static void
    216 mn10200_info_to_howto (bfd *abfd ATTRIBUTE_UNUSED,
    217 		       arelent *cache_ptr,
    218 		       Elf_Internal_Rela *dst)
    219 {
    220   unsigned int r_type;
    221 
    222   r_type = ELF32_R_TYPE (dst->r_info);
    223   BFD_ASSERT (r_type < (unsigned int) R_MN10200_MAX);
    224   cache_ptr->howto = &elf_mn10200_howto_table[r_type];
    225 }
    226 
    227 /* Perform a relocation as part of a final link.  */
    228 
    229 static bfd_reloc_status_type
    230 mn10200_elf_final_link_relocate (reloc_howto_type *howto,
    231 				 bfd *input_bfd,
    232 				 bfd *output_bfd ATTRIBUTE_UNUSED,
    233 				 asection *input_section,
    234 				 bfd_byte *contents,
    235 				 bfd_vma offset,
    236 				 bfd_vma value,
    237 				 bfd_vma addend,
    238 				 struct bfd_link_info *info ATTRIBUTE_UNUSED,
    239 				 asection *sym_sec ATTRIBUTE_UNUSED,
    240 				 int is_local ATTRIBUTE_UNUSED)
    241 {
    242   unsigned long r_type = howto->type;
    243   bfd_byte *hit_data = contents + offset;
    244 
    245   switch (r_type)
    246     {
    247 
    248     case R_MN10200_NONE:
    249       return bfd_reloc_ok;
    250 
    251     case R_MN10200_32:
    252       value += addend;
    253       bfd_put_32 (input_bfd, value, hit_data);
    254       return bfd_reloc_ok;
    255 
    256     case R_MN10200_16:
    257       value += addend;
    258 
    259       if ((long) value > 0x7fff || (long) value < -0x8000)
    260 	return bfd_reloc_overflow;
    261 
    262       bfd_put_16 (input_bfd, value, hit_data);
    263       return bfd_reloc_ok;
    264 
    265     case R_MN10200_8:
    266       value += addend;
    267 
    268       if ((long) value > 0x7f || (long) value < -0x80)
    269 	return bfd_reloc_overflow;
    270 
    271       bfd_put_8 (input_bfd, value, hit_data);
    272       return bfd_reloc_ok;
    273 
    274     case R_MN10200_24:
    275       value += addend;
    276 
    277       if ((long) value > 0x7fffff || (long) value < -0x800000)
    278 	return bfd_reloc_overflow;
    279 
    280       value &= 0xffffff;
    281       value |= (bfd_get_32 (input_bfd, hit_data) & 0xff000000);
    282       bfd_put_32 (input_bfd, value, hit_data);
    283       return bfd_reloc_ok;
    284 
    285     case R_MN10200_PCREL8:
    286       value -= (input_section->output_section->vma
    287 		+ input_section->output_offset);
    288       value -= (offset + 1);
    289       value += addend;
    290 
    291       if ((long) value > 0xff || (long) value < -0x100)
    292 	return bfd_reloc_overflow;
    293 
    294       bfd_put_8 (input_bfd, value, hit_data);
    295       return bfd_reloc_ok;
    296 
    297     case R_MN10200_PCREL16:
    298       value -= (input_section->output_section->vma
    299 		+ input_section->output_offset);
    300       value -= (offset + 2);
    301       value += addend;
    302 
    303       if ((long) value > 0xffff || (long) value < -0x10000)
    304 	return bfd_reloc_overflow;
    305 
    306       bfd_put_16 (input_bfd, value, hit_data);
    307       return bfd_reloc_ok;
    308 
    309     case R_MN10200_PCREL24:
    310       value -= (input_section->output_section->vma
    311 		+ input_section->output_offset);
    312       value -= (offset + 3);
    313       value += addend;
    314 
    315       if ((long) value > 0xffffff || (long) value < -0x1000000)
    316 	return bfd_reloc_overflow;
    317 
    318       value &= 0xffffff;
    319       value |= (bfd_get_32 (input_bfd, hit_data) & 0xff000000);
    320       bfd_put_32 (input_bfd, value, hit_data);
    321       return bfd_reloc_ok;
    322 
    323     default:
    324       return bfd_reloc_notsupported;
    325     }
    326 }
    327 
    328 /* Relocate an MN10200 ELF section.  */
    330 static bfd_boolean
    331 mn10200_elf_relocate_section (bfd *output_bfd,
    332 			      struct bfd_link_info *info,
    333 			      bfd *input_bfd,
    334 			      asection *input_section,
    335 			      bfd_byte *contents,
    336 			      Elf_Internal_Rela *relocs,
    337 			      Elf_Internal_Sym *local_syms,
    338 			      asection **local_sections)
    339 {
    340   Elf_Internal_Shdr *symtab_hdr;
    341   struct elf_link_hash_entry **sym_hashes;
    342   Elf_Internal_Rela *rel, *relend;
    343 
    344   symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
    345   sym_hashes = elf_sym_hashes (input_bfd);
    346 
    347   rel = relocs;
    348   relend = relocs + input_section->reloc_count;
    349   for (; rel < relend; rel++)
    350     {
    351       int r_type;
    352       reloc_howto_type *howto;
    353       unsigned long r_symndx;
    354       Elf_Internal_Sym *sym;
    355       asection *sec;
    356       struct elf_link_hash_entry *h;
    357       bfd_vma relocation;
    358       bfd_reloc_status_type r;
    359 
    360       r_symndx = ELF32_R_SYM (rel->r_info);
    361       r_type = ELF32_R_TYPE (rel->r_info);
    362       howto = elf_mn10200_howto_table + r_type;
    363 
    364       h = NULL;
    365       sym = NULL;
    366       sec = NULL;
    367       if (r_symndx < symtab_hdr->sh_info)
    368 	{
    369 	  sym = local_syms + r_symndx;
    370 	  sec = local_sections[r_symndx];
    371 	  relocation = _bfd_elf_rela_local_sym (output_bfd, sym, &sec, rel);
    372 	}
    373       else
    374 	{
    375 	  bfd_boolean unresolved_reloc, warned, ignored;
    376 
    377 	  RELOC_FOR_GLOBAL_SYMBOL (info, input_bfd, input_section, rel,
    378 				   r_symndx, symtab_hdr, sym_hashes,
    379 				   h, sec, relocation,
    380 				   unresolved_reloc, warned, ignored);
    381 	}
    382 
    383       if (sec != NULL && discarded_section (sec))
    384 	RELOC_AGAINST_DISCARDED_SECTION (info, input_bfd, input_section,
    385 					 rel, 1, relend, howto, 0, contents);
    386 
    387       if (bfd_link_relocatable (info))
    388 	continue;
    389 
    390       r = mn10200_elf_final_link_relocate (howto, input_bfd, output_bfd,
    391 					   input_section,
    392 					   contents, rel->r_offset,
    393 					   relocation, rel->r_addend,
    394 					   info, sec, h == NULL);
    395 
    396       if (r != bfd_reloc_ok)
    397 	{
    398 	  const char *name;
    399 	  const char *msg = (const char *) 0;
    400 
    401 	  if (h != NULL)
    402 	    name = h->root.root.string;
    403 	  else
    404 	    {
    405 	      name = (bfd_elf_string_from_elf_section
    406 		      (input_bfd, symtab_hdr->sh_link, sym->st_name));
    407 	      if (name == NULL || *name == '\0')
    408 		name = bfd_section_name (input_bfd, sec);
    409 	    }
    410 
    411 	  switch (r)
    412 	    {
    413 	    case bfd_reloc_overflow:
    414 	      (*info->callbacks->reloc_overflow)
    415 		(info, (h ? &h->root : NULL), name, howto->name,
    416 		 (bfd_vma) 0, input_bfd, input_section, rel->r_offset);
    417 	      break;
    418 
    419 	    case bfd_reloc_undefined:
    420 	      (*info->callbacks->undefined_symbol) (info, name, input_bfd,
    421 						    input_section,
    422 						    rel->r_offset, TRUE);
    423 	      break;
    424 
    425 	    case bfd_reloc_outofrange:
    426 	      msg = _("internal error: out of range error");
    427 	      goto common_error;
    428 
    429 	    case bfd_reloc_notsupported:
    430 	      msg = _("internal error: unsupported relocation error");
    431 	      goto common_error;
    432 
    433 	    case bfd_reloc_dangerous:
    434 	      msg = _("internal error: dangerous error");
    435 	      goto common_error;
    436 
    437 	    default:
    438 	      msg = _("internal error: unknown error");
    439 	      /* fall through */
    440 
    441 	    common_error:
    442 	      (*info->callbacks->warning) (info, msg, name, input_bfd,
    443 					   input_section, rel->r_offset);
    444 	      break;
    445 	    }
    446 	}
    447     }
    448 
    449   return TRUE;
    450 }
    451 
    452 /* Delete some bytes from a section while relaxing.  */
    453 
    454 static bfd_boolean
    455 mn10200_elf_relax_delete_bytes (bfd *abfd, asection *sec,
    456 				bfd_vma addr, int count)
    457 {
    458   Elf_Internal_Shdr *symtab_hdr;
    459   unsigned int sec_shndx;
    460   bfd_byte *contents;
    461   Elf_Internal_Rela *irel, *irelend;
    462   bfd_vma toaddr;
    463   Elf_Internal_Sym *isym;
    464   Elf_Internal_Sym *isymend;
    465   struct elf_link_hash_entry **sym_hashes;
    466   struct elf_link_hash_entry **end_hashes;
    467   unsigned int symcount;
    468 
    469   sec_shndx = _bfd_elf_section_from_bfd_section (abfd, sec);
    470 
    471   contents = elf_section_data (sec)->this_hdr.contents;
    472 
    473   toaddr = sec->size;
    474 
    475   irel = elf_section_data (sec)->relocs;
    476   irelend = irel + sec->reloc_count;
    477 
    478   /* Actually delete the bytes.  */
    479   memmove (contents + addr, contents + addr + count,
    480 	   (size_t) (toaddr - addr - count));
    481   sec->size -= count;
    482 
    483   /* Adjust all the relocs.  */
    484   for (irel = elf_section_data (sec)->relocs; irel < irelend; irel++)
    485     {
    486       /* Get the new reloc address.  */
    487       if ((irel->r_offset > addr
    488 	   && irel->r_offset < toaddr))
    489 	irel->r_offset -= count;
    490     }
    491 
    492   /* Adjust the local symbols defined in this section.  */
    493   symtab_hdr = &elf_tdata (abfd)->symtab_hdr;
    494   isym = (Elf_Internal_Sym *) symtab_hdr->contents;
    495   for (isymend = isym + symtab_hdr->sh_info; isym < isymend; isym++)
    496     {
    497       if (isym->st_shndx == sec_shndx
    498 	  && isym->st_value > addr
    499 	  && isym->st_value < toaddr)
    500 	isym->st_value -= count;
    501     }
    502 
    503   /* Now adjust the global symbols defined in this section.  */
    504   symcount = (symtab_hdr->sh_size / sizeof (Elf32_External_Sym)
    505 	      - symtab_hdr->sh_info);
    506   sym_hashes = elf_sym_hashes (abfd);
    507   end_hashes = sym_hashes + symcount;
    508   for (; sym_hashes < end_hashes; sym_hashes++)
    509     {
    510       struct elf_link_hash_entry *sym_hash = *sym_hashes;
    511       if ((sym_hash->root.type == bfd_link_hash_defined
    512 	   || sym_hash->root.type == bfd_link_hash_defweak)
    513 	  && sym_hash->root.u.def.section == sec
    514 	  && sym_hash->root.u.def.value > addr
    515 	  && sym_hash->root.u.def.value < toaddr)
    516 	{
    517 	  sym_hash->root.u.def.value -= count;
    518 	}
    519     }
    520 
    521   return TRUE;
    522 }
    523 
    524 /* This function handles relaxing for the mn10200.
    525 
    526    There are quite a few relaxing opportunities available on the mn10200:
    527 
    528 	* jsr:24 -> jsr:16 					   2 bytes
    529 
    530 	* jmp:24 -> jmp:16					   2 bytes
    531 	* jmp:16 -> bra:8					   1 byte
    532 
    533 		* If the previous instruction is a conditional branch
    534 		around the jump/bra, we may be able to reverse its condition
    535 		and change its target to the jump's target.  The jump/bra
    536 		can then be deleted.				   2 bytes
    537 
    538 	* mov abs24 -> mov abs16	2 byte savings
    539 
    540 	* Most instructions which accept imm24 can relax to imm16  2 bytes
    541 	- Most instructions which accept imm16 can relax to imm8   1 byte
    542 
    543 	* Most instructions which accept d24 can relax to d16	   2 bytes
    544 	- Most instructions which accept d16 can relax to d8	   1 byte
    545 
    546 	abs24, imm24, d24 all look the same at the reloc level.  It
    547 	might make the code simpler if we had different relocs for
    548 	the various relaxable operand types.
    549 
    550 	We don't handle imm16->imm8 or d16->d8 as they're very rare
    551 	and somewhat more difficult to support.  */
    552 
    553 static bfd_boolean
    554 mn10200_elf_relax_section (bfd *abfd,
    555 			   asection *sec,
    556 			   struct bfd_link_info *link_info,
    557 			   bfd_boolean *again)
    558 {
    559   Elf_Internal_Shdr *symtab_hdr;
    560   Elf_Internal_Rela *internal_relocs;
    561   Elf_Internal_Rela *irel, *irelend;
    562   bfd_byte *contents = NULL;
    563   Elf_Internal_Sym *isymbuf = NULL;
    564 
    565   /* Assume nothing changes.  */
    566   *again = FALSE;
    567 
    568   /* We don't have to do anything for a relocatable link, if
    569      this section does not have relocs, or if this is not a
    570      code section.  */
    571   if (bfd_link_relocatable (link_info)
    572       || (sec->flags & SEC_RELOC) == 0
    573       || sec->reloc_count == 0
    574       || (sec->flags & SEC_CODE) == 0)
    575     return TRUE;
    576 
    577   symtab_hdr = &elf_tdata (abfd)->symtab_hdr;
    578 
    579   /* Get a copy of the native relocations.  */
    580   internal_relocs = (_bfd_elf_link_read_relocs
    581 		     (abfd, sec, NULL, (Elf_Internal_Rela *) NULL,
    582 		      link_info->keep_memory));
    583   if (internal_relocs == NULL)
    584     goto error_return;
    585 
    586   /* Walk through them looking for relaxing opportunities.  */
    587   irelend = internal_relocs + sec->reloc_count;
    588   for (irel = internal_relocs; irel < irelend; irel++)
    589     {
    590       bfd_vma symval;
    591 
    592       /* If this isn't something that can be relaxed, then ignore
    593 	 this reloc.  */
    594       if (ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_NONE
    595 	  || ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_8
    596 	  || ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_MAX)
    597 	continue;
    598 
    599       /* Get the section contents if we haven't done so already.  */
    600       if (contents == NULL)
    601 	{
    602 	  /* Get cached copy if it exists.  */
    603 	  if (elf_section_data (sec)->this_hdr.contents != NULL)
    604 	    contents = elf_section_data (sec)->this_hdr.contents;
    605 	  else
    606 	    {
    607 	      /* Go get them off disk.  */
    608 	      if (!bfd_malloc_and_get_section (abfd, sec, &contents))
    609 		goto error_return;
    610 	    }
    611 	}
    612 
    613       /* Read this BFD's local symbols if we haven't done so already.  */
    614       if (isymbuf == NULL && symtab_hdr->sh_info != 0)
    615 	{
    616 	  isymbuf = (Elf_Internal_Sym *) symtab_hdr->contents;
    617 	  if (isymbuf == NULL)
    618 	    isymbuf = bfd_elf_get_elf_syms (abfd, symtab_hdr,
    619 					    symtab_hdr->sh_info, 0,
    620 					    NULL, NULL, NULL);
    621 	  if (isymbuf == NULL)
    622 	    goto error_return;
    623 	}
    624 
    625       /* Get the value of the symbol referred to by the reloc.  */
    626       if (ELF32_R_SYM (irel->r_info) < symtab_hdr->sh_info)
    627 	{
    628 	  /* A local symbol.  */
    629 	  Elf_Internal_Sym *isym;
    630 	  asection *sym_sec;
    631 
    632 	  isym = isymbuf + ELF32_R_SYM (irel->r_info);
    633 	  if (isym->st_shndx == SHN_UNDEF)
    634 	    sym_sec = bfd_und_section_ptr;
    635 	  else if (isym->st_shndx == SHN_ABS)
    636 	    sym_sec = bfd_abs_section_ptr;
    637 	  else if (isym->st_shndx == SHN_COMMON)
    638 	    sym_sec = bfd_com_section_ptr;
    639 	  else
    640 	    sym_sec = bfd_section_from_elf_index (abfd, isym->st_shndx);
    641 	  symval = (isym->st_value
    642 		    + sym_sec->output_section->vma
    643 		    + sym_sec->output_offset);
    644 	}
    645       else
    646 	{
    647 	  unsigned long indx;
    648 	  struct elf_link_hash_entry *h;
    649 
    650 	  /* An external symbol.  */
    651 	  indx = ELF32_R_SYM (irel->r_info) - symtab_hdr->sh_info;
    652 	  h = elf_sym_hashes (abfd)[indx];
    653 	  BFD_ASSERT (h != NULL);
    654 	  if (h->root.type != bfd_link_hash_defined
    655 	      && h->root.type != bfd_link_hash_defweak)
    656 	    {
    657 	      /* This appears to be a reference to an undefined
    658                  symbol.  Just ignore it--it will be caught by the
    659                  regular reloc processing.  */
    660 	      continue;
    661 	    }
    662 
    663 	  symval = (h->root.u.def.value
    664 		    + h->root.u.def.section->output_section->vma
    665 		    + h->root.u.def.section->output_offset);
    666 	}
    667 
    668       /* For simplicity of coding, we are going to modify the section
    669 	 contents, the section relocs, and the BFD symbol table.  We
    670 	 must tell the rest of the code not to free up this
    671 	 information.  It would be possible to instead create a table
    672 	 of changes which have to be made, as is done in coff-mips.c;
    673 	 that would be more work, but would require less memory when
    674 	 the linker is run.  */
    675 
    676       /* Try to turn a 24bit pc-relative branch/call into a 16bit pc-relative
    677 	 branch/call.  */
    678       if (ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_PCREL24)
    679 	{
    680 	  bfd_vma value = symval;
    681 
    682 	  /* Deal with pc-relative gunk.  */
    683 	  value -= (sec->output_section->vma + sec->output_offset);
    684 	  value -= (irel->r_offset + 3);
    685 	  value += irel->r_addend;
    686 
    687 	  /* See if the value will fit in 16 bits, note the high value is
    688 	     0x7fff + 2 as the target will be two bytes closer if we are
    689 	     able to relax.  */
    690 	  if ((long) value < 0x8001 && (long) value > -0x8000)
    691 	    {
    692 	      unsigned char code;
    693 
    694 	      /* Get the opcode.  */
    695 	      code = bfd_get_8 (abfd, contents + irel->r_offset - 1);
    696 
    697 	      if (code != 0xe0 && code != 0xe1)
    698 		continue;
    699 
    700 	      /* Note that we've changed the relocs, section contents, etc.  */
    701 	      elf_section_data (sec)->relocs = internal_relocs;
    702 	      elf_section_data (sec)->this_hdr.contents = contents;
    703 	      symtab_hdr->contents = (unsigned char *) isymbuf;
    704 
    705 	      /* Fix the opcode.  */
    706 	      if (code == 0xe0)
    707 		bfd_put_8 (abfd, 0xfc, contents + irel->r_offset - 2);
    708 	      else if (code == 0xe1)
    709 		bfd_put_8 (abfd, 0xfd, contents + irel->r_offset - 2);
    710 
    711 	      /* Fix the relocation's type.  */
    712 	      irel->r_info = ELF32_R_INFO (ELF32_R_SYM (irel->r_info),
    713 					   R_MN10200_PCREL16);
    714 
    715 	      /* The opcode got shorter too, so we have to fix the offset.  */
    716 	      irel->r_offset -= 1;
    717 
    718 	      /* Delete two bytes of data.  */
    719 	      if (!mn10200_elf_relax_delete_bytes (abfd, sec,
    720 						   irel->r_offset + 1, 2))
    721 		goto error_return;
    722 
    723 	      /* That will change things, so, we should relax again.
    724 		 Note that this is not required, and it may be slow.  */
    725 	      *again = TRUE;
    726 	    }
    727 	}
    728 
    729       /* Try to turn a 16bit pc-relative branch into a 8bit pc-relative
    730 	 branch.  */
    731       if (ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_PCREL16)
    732 	{
    733 	  bfd_vma value = symval;
    734 
    735 	  /* Deal with pc-relative gunk.  */
    736 	  value -= (sec->output_section->vma + sec->output_offset);
    737 	  value -= (irel->r_offset + 2);
    738 	  value += irel->r_addend;
    739 
    740 	  /* See if the value will fit in 8 bits, note the high value is
    741 	     0x7f + 1 as the target will be one bytes closer if we are
    742 	     able to relax.  */
    743 	  if ((long) value < 0x80 && (long) value > -0x80)
    744 	    {
    745 	      unsigned char code;
    746 
    747 	      /* Get the opcode.  */
    748 	      code = bfd_get_8 (abfd, contents + irel->r_offset - 1);
    749 
    750 	      if (code != 0xfc)
    751 		continue;
    752 
    753 	      /* Note that we've changed the relocs, section contents, etc.  */
    754 	      elf_section_data (sec)->relocs = internal_relocs;
    755 	      elf_section_data (sec)->this_hdr.contents = contents;
    756 	      symtab_hdr->contents = (unsigned char *) isymbuf;
    757 
    758 	      /* Fix the opcode.  */
    759 	      bfd_put_8 (abfd, 0xea, contents + irel->r_offset - 1);
    760 
    761 	      /* Fix the relocation's type.  */
    762 	      irel->r_info = ELF32_R_INFO (ELF32_R_SYM (irel->r_info),
    763 					   R_MN10200_PCREL8);
    764 
    765 	      /* Delete one byte of data.  */
    766 	      if (!mn10200_elf_relax_delete_bytes (abfd, sec,
    767 						   irel->r_offset + 1, 1))
    768 		goto error_return;
    769 
    770 	      /* That will change things, so, we should relax again.
    771 		 Note that this is not required, and it may be slow.  */
    772 	      *again = TRUE;
    773 	    }
    774 	}
    775 
    776       /* Try to eliminate an unconditional 8 bit pc-relative branch
    777 	 which immediately follows a conditional 8 bit pc-relative
    778 	 branch around the unconditional branch.
    779 
    780 	    original:		new:
    781 	    bCC lab1		bCC' lab2
    782 	    bra lab2
    783 	   lab1:	       lab1:
    784 
    785 	 This happens when the bCC can't reach lab2 at assembly time,
    786 	 but due to other relaxations it can reach at link time.  */
    787       if (ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_PCREL8)
    788 	{
    789 	  Elf_Internal_Rela *nrel;
    790 	  bfd_vma value = symval;
    791 	  unsigned char code;
    792 
    793 	  /* Deal with pc-relative gunk.  */
    794 	  value -= (sec->output_section->vma + sec->output_offset);
    795 	  value -= (irel->r_offset + 1);
    796 	  value += irel->r_addend;
    797 
    798 	  /* Do nothing if this reloc is the last byte in the section.  */
    799 	  if (irel->r_offset == sec->size)
    800 	    continue;
    801 
    802 	  /* See if the next instruction is an unconditional pc-relative
    803 	     branch, more often than not this test will fail, so we
    804 	     test it first to speed things up.  */
    805 	  code = bfd_get_8 (abfd, contents + irel->r_offset + 1);
    806 	  if (code != 0xea)
    807 	    continue;
    808 
    809 	  /* Also make sure the next relocation applies to the next
    810 	     instruction and that it's a pc-relative 8 bit branch.  */
    811 	  nrel = irel + 1;
    812 	  if (nrel == irelend
    813 	      || irel->r_offset + 2 != nrel->r_offset
    814 	      || ELF32_R_TYPE (nrel->r_info) != (int) R_MN10200_PCREL8)
    815 	    continue;
    816 
    817 	  /* Make sure our destination immediately follows the
    818 	     unconditional branch.  */
    819 	  if (symval != (sec->output_section->vma + sec->output_offset
    820 			 + irel->r_offset + 3))
    821 	    continue;
    822 
    823 	  /* Now make sure we are a conditional branch.  This may not
    824 	     be necessary, but why take the chance.
    825 
    826 	     Note these checks assume that R_MN10200_PCREL8 relocs
    827 	     only occur on bCC and bCCx insns.  If they occured
    828 	     elsewhere, we'd need to know the start of this insn
    829 	     for this check to be accurate.  */
    830 	  code = bfd_get_8 (abfd, contents + irel->r_offset - 1);
    831 	  if (code != 0xe0 && code != 0xe1 && code != 0xe2
    832 	      && code != 0xe3 && code != 0xe4 && code != 0xe5
    833 	      && code != 0xe6 && code != 0xe7 && code != 0xe8
    834 	      && code != 0xe9 && code != 0xec && code != 0xed
    835 	      && code != 0xee && code != 0xef && code != 0xfc
    836 	      && code != 0xfd && code != 0xfe && code != 0xff)
    837 	    continue;
    838 
    839 	  /* We also have to be sure there is no symbol/label
    840 	     at the unconditional branch.  */
    841 	  if (mn10200_elf_symbol_address_p (abfd, sec, isymbuf,
    842 					    irel->r_offset + 1))
    843 	    continue;
    844 
    845 	  /* Note that we've changed the relocs, section contents, etc.  */
    846 	  elf_section_data (sec)->relocs = internal_relocs;
    847 	  elf_section_data (sec)->this_hdr.contents = contents;
    848 	  symtab_hdr->contents = (unsigned char *) isymbuf;
    849 
    850 	  /* Reverse the condition of the first branch.  */
    851 	  switch (code)
    852 	    {
    853 	    case 0xfc:
    854 	      code = 0xfd;
    855 	      break;
    856 	    case 0xfd:
    857 	      code = 0xfc;
    858 	      break;
    859 	    case 0xfe:
    860 	      code = 0xff;
    861 	      break;
    862 	    case 0xff:
    863 	      code = 0xfe;
    864 	      break;
    865 	    case 0xe8:
    866 	      code = 0xe9;
    867 	      break;
    868 	    case 0xe9:
    869 	      code = 0xe8;
    870 	      break;
    871 	    case 0xe0:
    872 	      code = 0xe2;
    873 	      break;
    874 	    case 0xe2:
    875 	      code = 0xe0;
    876 	      break;
    877 	    case 0xe3:
    878 	      code = 0xe1;
    879 	      break;
    880 	    case 0xe1:
    881 	      code = 0xe3;
    882 	      break;
    883 	    case 0xe4:
    884 	      code = 0xe6;
    885 	      break;
    886 	    case 0xe6:
    887 	      code = 0xe4;
    888 	      break;
    889 	    case 0xe7:
    890 	      code = 0xe5;
    891 	      break;
    892 	    case 0xe5:
    893 	      code = 0xe7;
    894 	      break;
    895 	    case 0xec:
    896 	      code = 0xed;
    897 	      break;
    898 	    case 0xed:
    899 	      code = 0xec;
    900 	      break;
    901 	    case 0xee:
    902 	      code = 0xef;
    903 	      break;
    904 	    case 0xef:
    905 	      code = 0xee;
    906 	      break;
    907 	    }
    908 	  bfd_put_8 (abfd, code, contents + irel->r_offset - 1);
    909 
    910 	  /* Set the reloc type and symbol for the first branch
    911 	     from the second branch.  */
    912 	  irel->r_info = nrel->r_info;
    913 
    914 	  /* Make the reloc for the second branch a null reloc.  */
    915 	  nrel->r_info = ELF32_R_INFO (ELF32_R_SYM (nrel->r_info),
    916 				       R_MN10200_NONE);
    917 
    918 	  /* Delete two bytes of data.  */
    919 	  if (!mn10200_elf_relax_delete_bytes (abfd, sec,
    920 					       irel->r_offset + 1, 2))
    921 	    goto error_return;
    922 
    923 	  /* That will change things, so, we should relax again.
    924 	     Note that this is not required, and it may be slow.  */
    925 	  *again = TRUE;
    926 	}
    927 
    928       /* Try to turn a 24bit immediate, displacement or absolute address
    929 	 into a 16bit immediate, displacement or absolute address.  */
    930       if (ELF32_R_TYPE (irel->r_info) == (int) R_MN10200_24)
    931 	{
    932 	  bfd_vma value = symval;
    933 
    934 	  /* See if the value will fit in 16 bits.
    935 	     We allow any 16bit match here.  We prune those we can't
    936 	     handle below.  */
    937 	  if ((long) value < 0x7fff && (long) value > -0x8000)
    938 	    {
    939 	      unsigned char code;
    940 
    941 	      /* All insns which have 24bit operands are 5 bytes long,
    942 		 the first byte will always be 0xf4, but we double check
    943 		 it just in case.  */
    944 
    945 	      /* Get the first opcode.  */
    946 	      code = bfd_get_8 (abfd, contents + irel->r_offset - 2);
    947 
    948 	      if (code != 0xf4)
    949 		continue;
    950 
    951 	      /* Get the second opcode.  */
    952 	      code = bfd_get_8 (abfd, contents + irel->r_offset - 1);
    953 
    954 	      switch (code & 0xfc)
    955 		{
    956 		/* mov imm24,dn -> mov imm16,dn */
    957 		case 0x70:
    958 		  /* Not safe if the high bit is on as relaxing may
    959 		     move the value out of high mem and thus not fit
    960 		     in a signed 16bit value.  */
    961 		  if (value & 0x8000)
    962 		    continue;
    963 
    964 		  /* Note that we've changed the relocation contents, etc.  */
    965 		  elf_section_data (sec)->relocs = internal_relocs;
    966 		  elf_section_data (sec)->this_hdr.contents = contents;
    967 		  symtab_hdr->contents = (unsigned char *) isymbuf;
    968 
    969 		  /* Fix the opcode.  */
    970 		  bfd_put_8 (abfd, 0xf8 + (code & 0x03),
    971 			     contents + irel->r_offset - 2);
    972 
    973 		  /* Fix the relocation's type.  */
    974 		  irel->r_info = ELF32_R_INFO (ELF32_R_SYM (irel->r_info),
    975 					       R_MN10200_16);
    976 
    977 		  /* The opcode got shorter too, so we have to fix the
    978 		     offset.  */
    979 		  irel->r_offset -= 1;
    980 
    981 		  /* Delete two bytes of data.  */
    982 		  if (!mn10200_elf_relax_delete_bytes (abfd, sec,
    983 						       irel->r_offset + 1, 2))
    984 		    goto error_return;
    985 
    986 		  /* That will change things, so, we should relax again.
    987 		     Note that this is not required, and it may be slow.  */
    988 		  *again = TRUE;
    989 		  break;
    990 
    991 		/* mov imm24,an -> mov imm16,an
    992 		   cmp imm24,an -> cmp imm16,an
    993 		   mov (abs24),dn -> mov (abs16),dn
    994 		   mov dn,(abs24) -> mov dn,(abs16)
    995 		   movb dn,(abs24) -> movb dn,(abs16)
    996 		   movbu (abs24),dn -> movbu (abs16),dn */
    997 		case 0x74:
    998 		case 0x7c:
    999 		case 0xc0:
   1000 		case 0x40:
   1001 		case 0x44:
   1002 		case 0xc8:
   1003 		  /* Note that we've changed the relocation contents, etc.  */
   1004 		  elf_section_data (sec)->relocs = internal_relocs;
   1005 		  elf_section_data (sec)->this_hdr.contents = contents;
   1006 		  symtab_hdr->contents = (unsigned char *) isymbuf;
   1007 
   1008 		  if ((code & 0xfc) == 0x74)
   1009 		    code = 0xdc + (code & 0x03);
   1010 		  else if ((code & 0xfc) == 0x7c)
   1011 		    code = 0xec + (code & 0x03);
   1012 		  else if ((code & 0xfc) == 0xc0)
   1013 		    code = 0xc8 + (code & 0x03);
   1014 		  else if ((code & 0xfc) == 0x40)
   1015 		    code = 0xc0 + (code & 0x03);
   1016 		  else if ((code & 0xfc) == 0x44)
   1017 		    code = 0xc4 + (code & 0x03);
   1018 		  else if ((code & 0xfc) == 0xc8)
   1019 		    code = 0xcc + (code & 0x03);
   1020 
   1021 		  /* Fix the opcode.  */
   1022 		  bfd_put_8 (abfd, code, contents + irel->r_offset - 2);
   1023 
   1024 		  /* Fix the relocation's type.  */
   1025 		  irel->r_info = ELF32_R_INFO (ELF32_R_SYM (irel->r_info),
   1026 					       R_MN10200_16);
   1027 
   1028 		  /* The opcode got shorter too, so we have to fix the
   1029 		     offset.  */
   1030 		  irel->r_offset -= 1;
   1031 
   1032 		  /* Delete two bytes of data.  */
   1033 		  if (!mn10200_elf_relax_delete_bytes (abfd, sec,
   1034 						       irel->r_offset + 1, 2))
   1035 		    goto error_return;
   1036 
   1037 		  /* That will change things, so, we should relax again.
   1038 		     Note that this is not required, and it may be slow.  */
   1039 		  *again = TRUE;
   1040 		  break;
   1041 
   1042 		/* cmp imm24,dn -> cmp imm16,dn
   1043 		   mov (abs24),an -> mov (abs16),an
   1044 		   mov an,(abs24) -> mov an,(abs16)
   1045 		   add imm24,dn -> add imm16,dn
   1046 		   add imm24,an -> add imm16,an
   1047 		   sub imm24,dn -> sub imm16,dn
   1048 		   sub imm24,an -> sub imm16,an
   1049 		   And all d24->d16 in memory ops.  */
   1050 		case 0x78:
   1051 		case 0xd0:
   1052 		case 0x50:
   1053 		case 0x60:
   1054 		case 0x64:
   1055 		case 0x68:
   1056 		case 0x6c:
   1057 		case 0x80:
   1058 		case 0xf0:
   1059 		case 0x00:
   1060 		case 0x10:
   1061 		case 0xb0:
   1062 		case 0x30:
   1063 		case 0xa0:
   1064 		case 0x20:
   1065 		case 0x90:
   1066 		  /* Not safe if the high bit is on as relaxing may
   1067 		     move the value out of high mem and thus not fit
   1068 		     in a signed 16bit value.  */
   1069 		  if (((code & 0xfc) == 0x78
   1070 		       || (code & 0xfc) == 0x60
   1071 		       || (code & 0xfc) == 0x64
   1072 		       || (code & 0xfc) == 0x68
   1073 		       || (code & 0xfc) == 0x6c
   1074 		       || (code & 0xfc) == 0x80
   1075 		       || (code & 0xfc) == 0xf0
   1076 		       || (code & 0xfc) == 0x00
   1077 		       || (code & 0xfc) == 0x10
   1078 		       || (code & 0xfc) == 0xb0
   1079 		       || (code & 0xfc) == 0x30
   1080 		       || (code & 0xfc) == 0xa0
   1081 		       || (code & 0xfc) == 0x20
   1082 		       || (code & 0xfc) == 0x90)
   1083 		      && (value & 0x8000) != 0)
   1084 		    continue;
   1085 
   1086 		  /* Note that we've changed the relocation contents, etc.  */
   1087 		  elf_section_data (sec)->relocs = internal_relocs;
   1088 		  elf_section_data (sec)->this_hdr.contents = contents;
   1089 		  symtab_hdr->contents = (unsigned char *) isymbuf;
   1090 
   1091 		  /* Fix the opcode.  */
   1092 		  bfd_put_8 (abfd, 0xf7, contents + irel->r_offset - 2);
   1093 
   1094 		  if ((code & 0xfc) == 0x78)
   1095 		    code = 0x48 + (code & 0x03);
   1096 		  else if ((code & 0xfc) == 0xd0)
   1097 		    code = 0x30 + (code & 0x03);
   1098 		  else if ((code & 0xfc) == 0x50)
   1099 		    code = 0x20 + (code & 0x03);
   1100 		  else if ((code & 0xfc) == 0x60)
   1101 		    code = 0x18 + (code & 0x03);
   1102 		  else if ((code & 0xfc) == 0x64)
   1103 		    code = 0x08 + (code & 0x03);
   1104 		  else if ((code & 0xfc) == 0x68)
   1105 		    code = 0x1c + (code & 0x03);
   1106 		  else if ((code & 0xfc) == 0x6c)
   1107 		    code = 0x0c + (code & 0x03);
   1108 		  else if ((code & 0xfc) == 0x80)
   1109 		    code = 0xc0 + (code & 0x07);
   1110 		  else if ((code & 0xfc) == 0xf0)
   1111 		    code = 0xb0 + (code & 0x07);
   1112 		  else if ((code & 0xfc) == 0x00)
   1113 		    code = 0x80 + (code & 0x07);
   1114 		  else if ((code & 0xfc) == 0x10)
   1115 		    code = 0xa0 + (code & 0x07);
   1116 		  else if ((code & 0xfc) == 0xb0)
   1117 		    code = 0x70 + (code & 0x07);
   1118 		  else if ((code & 0xfc) == 0x30)
   1119 		    code = 0x60 + (code & 0x07);
   1120 		  else if ((code & 0xfc) == 0xa0)
   1121 		    code = 0xd0 + (code & 0x07);
   1122 		  else if ((code & 0xfc) == 0x20)
   1123 		    code = 0x90 + (code & 0x07);
   1124 		  else if ((code & 0xfc) == 0x90)
   1125 		    code = 0x50 + (code & 0x07);
   1126 
   1127 		  bfd_put_8 (abfd, code, contents + irel->r_offset - 1);
   1128 
   1129 		  /* Fix the relocation's type.  */
   1130 		  irel->r_info = ELF32_R_INFO (ELF32_R_SYM (irel->r_info),
   1131 					       R_MN10200_16);
   1132 
   1133 		  /* Delete one bytes of data.  */
   1134 		  if (!mn10200_elf_relax_delete_bytes (abfd, sec,
   1135 						       irel->r_offset + 2, 1))
   1136 		    goto error_return;
   1137 
   1138 		  /* That will change things, so, we should relax again.
   1139 		     Note that this is not required, and it may be slow.  */
   1140 		  *again = TRUE;
   1141 		  break;
   1142 
   1143 		/* movb (abs24),dn ->movbu (abs16),dn extxb bn */
   1144 		case 0xc4:
   1145 		  /* Note that we've changed the reldection contents, etc.  */
   1146 		  elf_section_data (sec)->relocs = internal_relocs;
   1147 		  elf_section_data (sec)->this_hdr.contents = contents;
   1148 		  symtab_hdr->contents = (unsigned char *) isymbuf;
   1149 
   1150 		  bfd_put_8 (abfd, 0xcc + (code & 0x03),
   1151 			     contents + irel->r_offset - 2);
   1152 
   1153 		  bfd_put_8 (abfd, 0xb8 + (code & 0x03),
   1154 			     contents + irel->r_offset - 1);
   1155 
   1156 		  /* Fix the relocation's type.  */
   1157 		  irel->r_info = ELF32_R_INFO (ELF32_R_SYM (irel->r_info),
   1158 					       R_MN10200_16);
   1159 
   1160 		  /* The reloc will be applied one byte in front of its
   1161 		     current location.  */
   1162 		  irel->r_offset -= 1;
   1163 
   1164 		  /* Delete one bytes of data.  */
   1165 		  if (!mn10200_elf_relax_delete_bytes (abfd, sec,
   1166 						       irel->r_offset + 2, 1))
   1167 		    goto error_return;
   1168 
   1169 		  /* That will change things, so, we should relax again.
   1170 		     Note that this is not required, and it may be slow.  */
   1171 		  *again = TRUE;
   1172 		  break;
   1173 		}
   1174 	    }
   1175 	}
   1176     }
   1177 
   1178   if (isymbuf != NULL
   1179       && symtab_hdr->contents != (unsigned char *) isymbuf)
   1180     {
   1181       if (! link_info->keep_memory)
   1182 	free (isymbuf);
   1183       else
   1184 	{
   1185 	  /* Cache the symbols for elf_link_input_bfd.  */
   1186 	  symtab_hdr->contents = (unsigned char *) isymbuf;
   1187 	}
   1188     }
   1189 
   1190   if (contents != NULL
   1191       && elf_section_data (sec)->this_hdr.contents != contents)
   1192     {
   1193       if (! link_info->keep_memory)
   1194 	free (contents);
   1195       else
   1196 	{
   1197 	  /* Cache the section contents for elf_link_input_bfd.  */
   1198 	  elf_section_data (sec)->this_hdr.contents = contents;
   1199 	}
   1200     }
   1201 
   1202   if (internal_relocs != NULL
   1203       && elf_section_data (sec)->relocs != internal_relocs)
   1204     free (internal_relocs);
   1205 
   1206   return TRUE;
   1207 
   1208  error_return:
   1209   if (isymbuf != NULL
   1210       && symtab_hdr->contents != (unsigned char *) isymbuf)
   1211     free (isymbuf);
   1212   if (contents != NULL
   1213       && elf_section_data (sec)->this_hdr.contents != contents)
   1214     free (contents);
   1215   if (internal_relocs != NULL
   1216       && elf_section_data (sec)->relocs != internal_relocs)
   1217     free (internal_relocs);
   1218 
   1219   return FALSE;
   1220 }
   1221 
   1222 /* Return TRUE if a symbol exists at the given address, else return
   1223    FALSE.  */
   1224 static bfd_boolean
   1225 mn10200_elf_symbol_address_p (bfd *abfd,
   1226 			      asection *sec,
   1227 			      Elf_Internal_Sym *isym,
   1228 			      bfd_vma addr)
   1229 {
   1230   Elf_Internal_Shdr *symtab_hdr;
   1231   unsigned int sec_shndx;
   1232   Elf_Internal_Sym *isymend;
   1233   struct elf_link_hash_entry **sym_hashes;
   1234   struct elf_link_hash_entry **end_hashes;
   1235   unsigned int symcount;
   1236 
   1237   sec_shndx = _bfd_elf_section_from_bfd_section (abfd, sec);
   1238 
   1239   /* Examine all the local symbols.  */
   1240   symtab_hdr = &elf_tdata (abfd)->symtab_hdr;
   1241   for (isymend = isym + symtab_hdr->sh_info; isym < isymend; isym++)
   1242     {
   1243       if (isym->st_shndx == sec_shndx
   1244 	  && isym->st_value == addr)
   1245 	return TRUE;
   1246     }
   1247 
   1248   symcount = (symtab_hdr->sh_size / sizeof (Elf32_External_Sym)
   1249 	      - symtab_hdr->sh_info);
   1250   sym_hashes = elf_sym_hashes (abfd);
   1251   end_hashes = sym_hashes + symcount;
   1252   for (; sym_hashes < end_hashes; sym_hashes++)
   1253     {
   1254       struct elf_link_hash_entry *sym_hash = *sym_hashes;
   1255       if ((sym_hash->root.type == bfd_link_hash_defined
   1256 	   || sym_hash->root.type == bfd_link_hash_defweak)
   1257 	  && sym_hash->root.u.def.section == sec
   1258 	  && sym_hash->root.u.def.value == addr)
   1259 	return TRUE;
   1260     }
   1261 
   1262   return FALSE;
   1263 }
   1264 
   1265 /* This is a version of bfd_generic_get_relocated_section_contents
   1266    which uses mn10200_elf_relocate_section.  */
   1267 
   1268 static bfd_byte *
   1269 mn10200_elf_get_relocated_section_contents (bfd *output_bfd,
   1270 					    struct bfd_link_info *link_info,
   1271 					    struct bfd_link_order *link_order,
   1272 					    bfd_byte *data,
   1273 					    bfd_boolean relocatable,
   1274 					    asymbol **symbols)
   1275 {
   1276   Elf_Internal_Shdr *symtab_hdr;
   1277   asection *input_section = link_order->u.indirect.section;
   1278   bfd *input_bfd = input_section->owner;
   1279   asection **sections = NULL;
   1280   Elf_Internal_Rela *internal_relocs = NULL;
   1281   Elf_Internal_Sym *isymbuf = NULL;
   1282 
   1283   /* We only need to handle the case of relaxing, or of having a
   1284      particular set of section contents, specially.  */
   1285   if (relocatable
   1286       || elf_section_data (input_section)->this_hdr.contents == NULL)
   1287     return bfd_generic_get_relocated_section_contents (output_bfd, link_info,
   1288 						       link_order, data,
   1289 						       relocatable,
   1290 						       symbols);
   1291 
   1292   symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
   1293 
   1294   memcpy (data, elf_section_data (input_section)->this_hdr.contents,
   1295 	  (size_t) input_section->size);
   1296 
   1297   if ((input_section->flags & SEC_RELOC) != 0
   1298       && input_section->reloc_count > 0)
   1299     {
   1300       Elf_Internal_Sym *isym;
   1301       Elf_Internal_Sym *isymend;
   1302       asection **secpp;
   1303       bfd_size_type amt;
   1304 
   1305       internal_relocs = (_bfd_elf_link_read_relocs
   1306 			 (input_bfd, input_section, NULL,
   1307 			  (Elf_Internal_Rela *) NULL, FALSE));
   1308       if (internal_relocs == NULL)
   1309 	goto error_return;
   1310 
   1311       if (symtab_hdr->sh_info != 0)
   1312 	{
   1313 	  isymbuf = (Elf_Internal_Sym *) symtab_hdr->contents;
   1314 	  if (isymbuf == NULL)
   1315 	    isymbuf = bfd_elf_get_elf_syms (input_bfd, symtab_hdr,
   1316 					    symtab_hdr->sh_info, 0,
   1317 					    NULL, NULL, NULL);
   1318 	  if (isymbuf == NULL)
   1319 	    goto error_return;
   1320 	}
   1321 
   1322       amt = symtab_hdr->sh_info;
   1323       amt *= sizeof (asection *);
   1324       sections = (asection **) bfd_malloc (amt);
   1325       if (sections == NULL && amt != 0)
   1326 	goto error_return;
   1327 
   1328       isymend = isymbuf + symtab_hdr->sh_info;
   1329       for (isym = isymbuf, secpp = sections; isym < isymend; ++isym, ++secpp)
   1330 	{
   1331 	  asection *isec;
   1332 
   1333 	  if (isym->st_shndx == SHN_UNDEF)
   1334 	    isec = bfd_und_section_ptr;
   1335 	  else if (isym->st_shndx == SHN_ABS)
   1336 	    isec = bfd_abs_section_ptr;
   1337 	  else if (isym->st_shndx == SHN_COMMON)
   1338 	    isec = bfd_com_section_ptr;
   1339 	  else
   1340 	    isec = bfd_section_from_elf_index (input_bfd, isym->st_shndx);
   1341 
   1342 	  *secpp = isec;
   1343 	}
   1344 
   1345       if (! mn10200_elf_relocate_section (output_bfd, link_info, input_bfd,
   1346 				     input_section, data, internal_relocs,
   1347 				     isymbuf, sections))
   1348 	goto error_return;
   1349 
   1350       if (sections != NULL)
   1351 	free (sections);
   1352       if (isymbuf != NULL
   1353 	  && symtab_hdr->contents != (unsigned char *) isymbuf)
   1354 	free (isymbuf);
   1355       if (elf_section_data (input_section)->relocs != internal_relocs)
   1356 	free (internal_relocs);
   1357     }
   1358 
   1359   return data;
   1360 
   1361  error_return:
   1362   if (sections != NULL)
   1363     free (sections);
   1364   if (isymbuf != NULL
   1365       && symtab_hdr->contents != (unsigned char *) isymbuf)
   1366     free (isymbuf);
   1367   if (internal_relocs != NULL
   1368       && elf_section_data (input_section)->relocs != internal_relocs)
   1369     free (internal_relocs);
   1370   return NULL;
   1371 }
   1372 
   1373 #define TARGET_LITTLE_SYM	mn10200_elf32_vec
   1374 #define TARGET_LITTLE_NAME	"elf32-mn10200"
   1375 #define ELF_ARCH		bfd_arch_mn10200
   1376 #define ELF_MACHINE_CODE	EM_MN10200
   1377 #define ELF_MACHINE_ALT1	EM_CYGNUS_MN10200
   1378 #define ELF_MAXPAGESIZE		0x1000
   1379 
   1380 #define elf_backend_rela_normal 1
   1381 #define elf_info_to_howto	mn10200_info_to_howto
   1382 #define elf_info_to_howto_rel	0
   1383 #define elf_backend_relocate_section mn10200_elf_relocate_section
   1384 #define bfd_elf32_bfd_relax_section	mn10200_elf_relax_section
   1385 #define bfd_elf32_bfd_get_relocated_section_contents \
   1386 				mn10200_elf_get_relocated_section_contents
   1387 
   1388 #define elf_symbol_leading_char '_'
   1389 
   1390 #include "elf32-target.h"
   1391