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