bfd/elfnn-aarch64.c: Fix miscalculation of GOTPLT offset for ifunc syms.
[platform/upstream/binutils.git] / bfd / elfnn-aarch64.c
1 /* AArch64-specific support for NN-bit ELF.
2    Copyright 2009-2013  Free Software Foundation, Inc.
3    Contributed by ARM Ltd.
4
5    This file is part of BFD, the Binary File Descriptor library.
6
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with this program; see the file COPYING3. If not,
19    see <http://www.gnu.org/licenses/>.  */
20
21 /* Notes on implementation:
22
23   Thread Local Store (TLS)
24
25   Overview:
26
27   The implementation currently supports both traditional TLS and TLS
28   descriptors, but only general dynamic (GD).
29
30   For traditional TLS the assembler will present us with code
31   fragments of the form:
32
33   adrp x0, :tlsgd:foo
34                            R_AARCH64_TLSGD_ADR_PAGE21(foo)
35   add  x0, :tlsgd_lo12:foo
36                            R_AARCH64_TLSGD_ADD_LO12_NC(foo)
37   bl   __tls_get_addr
38   nop
39
40   For TLS descriptors the assembler will present us with code
41   fragments of the form:
42
43   adrp  x0, :tlsdesc:foo                      R_AARCH64_TLSDESC_ADR_PAGE21(foo)
44   ldr   x1, [x0, #:tlsdesc_lo12:foo]          R_AARCH64_TLSDESC_LD64_LO12(foo)
45   add   x0, x0, #:tlsdesc_lo12:foo            R_AARCH64_TLSDESC_ADD_LO12(foo)
46   .tlsdesccall foo
47   blr   x1                                    R_AARCH64_TLSDESC_CALL(foo)
48
49   The relocations R_AARCH64_TLSGD_{ADR_PREL21,ADD_LO12_NC} against foo
50   indicate that foo is thread local and should be accessed via the
51   traditional TLS mechanims.
52
53   The relocations R_AARCH64_TLSDESC_{ADR_PAGE21,LD64_LO12_NC,ADD_LO12_NC}
54   against foo indicate that 'foo' is thread local and should be accessed
55   via a TLS descriptor mechanism.
56
57   The precise instruction sequence is only relevant from the
58   perspective of linker relaxation which is currently not implemented.
59
60   The static linker must detect that 'foo' is a TLS object and
61   allocate a double GOT entry. The GOT entry must be created for both
62   global and local TLS symbols. Note that this is different to none
63   TLS local objects which do not need a GOT entry.
64
65   In the traditional TLS mechanism, the double GOT entry is used to
66   provide the tls_index structure, containing module and offset
67   entries. The static linker places the relocation R_AARCH64_TLS_DTPMOD
68   on the module entry. The loader will subsequently fixup this
69   relocation with the module identity.
70
71   For global traditional TLS symbols the static linker places an
72   R_AARCH64_TLS_DTPREL relocation on the offset entry. The loader
73   will subsequently fixup the offset. For local TLS symbols the static
74   linker fixes up offset.
75
76   In the TLS descriptor mechanism the double GOT entry is used to
77   provide the descriptor. The static linker places the relocation
78   R_AARCH64_TLSDESC on the first GOT slot. The loader will
79   subsequently fix this up.
80
81   Implementation:
82
83   The handling of TLS symbols is implemented across a number of
84   different backend functions. The following is a top level view of
85   what processing is performed where.
86
87   The TLS implementation maintains state information for each TLS
88   symbol. The state information for local and global symbols is kept
89   in different places. Global symbols use generic BFD structures while
90   local symbols use backend specific structures that are allocated and
91   maintained entirely by the backend.
92
93   The flow:
94
95   elfNN_aarch64_check_relocs()
96
97   This function is invoked for each relocation.
98
99   The TLS relocations R_AARCH64_TLSGD_{ADR_PREL21,ADD_LO12_NC} and
100   R_AARCH64_TLSDESC_{ADR_PAGE21,LD64_LO12_NC,ADD_LO12_NC} are
101   spotted. One time creation of local symbol data structures are
102   created when the first local symbol is seen.
103
104   The reference count for a symbol is incremented.  The GOT type for
105   each symbol is marked as general dynamic.
106
107   elfNN_aarch64_allocate_dynrelocs ()
108
109   For each global with positive reference count we allocate a double
110   GOT slot. For a traditional TLS symbol we allocate space for two
111   relocation entries on the GOT, for a TLS descriptor symbol we
112   allocate space for one relocation on the slot. Record the GOT offset
113   for this symbol.
114
115   elfNN_aarch64_size_dynamic_sections ()
116
117   Iterate all input BFDS, look for in the local symbol data structure
118   constructed earlier for local TLS symbols and allocate them double
119   GOT slots along with space for a single GOT relocation. Update the
120   local symbol structure to record the GOT offset allocated.
121
122   elfNN_aarch64_relocate_section ()
123
124   Calls elfNN_aarch64_final_link_relocate ()
125
126   Emit the relevant TLS relocations against the GOT for each TLS
127   symbol. For local TLS symbols emit the GOT offset directly. The GOT
128   relocations are emitted once the first time a TLS symbol is
129   encountered. The implementation uses the LSB of the GOT offset to
130   flag that the relevant GOT relocations for a symbol have been
131   emitted. All of the TLS code that uses the GOT offset needs to take
132   care to mask out this flag bit before using the offset.
133
134   elfNN_aarch64_final_link_relocate ()
135
136   Fixup the R_AARCH64_TLSGD_{ADR_PREL21, ADD_LO12_NC} relocations.  */
137
138 #include "sysdep.h"
139 #include "bfd.h"
140 #include "libiberty.h"
141 #include "libbfd.h"
142 #include "bfd_stdint.h"
143 #include "elf-bfd.h"
144 #include "bfdlink.h"
145 #include "objalloc.h"
146 #include "elf/aarch64.h"
147 #include "elfxx-aarch64.h"
148
149 #define ARCH_SIZE       NN
150
151 #if ARCH_SIZE == 64
152 #define AARCH64_R(NAME)         R_AARCH64_ ## NAME
153 #define AARCH64_R_STR(NAME)     "R_AARCH64_" #NAME
154 #define HOWTO64(...)            HOWTO (__VA_ARGS__)
155 #define HOWTO32(...)            EMPTY_HOWTO (0)
156 #define LOG_FILE_ALIGN  3
157 #endif
158
159 #if ARCH_SIZE == 32
160 #define AARCH64_R(NAME)         R_AARCH64_P32_ ## NAME
161 #define AARCH64_R_STR(NAME)     "R_AARCH64_P32_" #NAME
162 #define HOWTO64(...)            EMPTY_HOWTO (0)
163 #define HOWTO32(...)            HOWTO (__VA_ARGS__)
164 #define LOG_FILE_ALIGN  2
165 #endif
166
167 #define IS_AARCH64_TLS_RELOC(R_TYPE)                            \
168   ((R_TYPE) == BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21               \
169    || (R_TYPE) == BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC           \
170    || (R_TYPE) == BFD_RELOC_AARCH64_TLSIE_MOVW_GOTTPREL_G1      \
171    || (R_TYPE) == BFD_RELOC_AARCH64_TLSIE_MOVW_GOTTPREL_G0_NC   \
172    || (R_TYPE) == BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21   \
173    || (R_TYPE) == BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC \
174    || (R_TYPE) == BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC \
175    || (R_TYPE) == BFD_RELOC_AARCH64_TLSIE_LD_GOTTPREL_PREL19    \
176    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12        \
177    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12        \
178    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC     \
179    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2         \
180    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1         \
181    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC      \
182    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0         \
183    || (R_TYPE) == BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC      \
184    || (R_TYPE) == BFD_RELOC_AARCH64_TLS_DTPMOD                  \
185    || (R_TYPE) == BFD_RELOC_AARCH64_TLS_DTPREL                  \
186    || (R_TYPE) == BFD_RELOC_AARCH64_TLS_TPREL                   \
187    || IS_AARCH64_TLSDESC_RELOC ((R_TYPE)))
188
189 #define IS_AARCH64_TLSDESC_RELOC(R_TYPE)                        \
190   ((R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_LD_PREL19              \
191    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_ADR_PREL21          \
192    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21          \
193    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC         \
194    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC        \
195    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC        \
196    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_OFF_G1              \
197    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_OFF_G0_NC           \
198    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_LDR                 \
199    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_ADD                 \
200    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC_CALL                \
201    || (R_TYPE) == BFD_RELOC_AARCH64_TLSDESC)
202
203 #define ELIMINATE_COPY_RELOCS 0
204
205 /* Return size of a relocation entry.  HTAB is the bfd's
206    elf_aarch64_link_hash_entry.  */
207 #define RELOC_SIZE(HTAB) (sizeof (ElfNN_External_Rela))
208
209 /* GOT Entry size - 8 bytes in ELF64 and 4 bytes in ELF32.  */
210 #define GOT_ENTRY_SIZE                  (ARCH_SIZE / 8)
211 #define PLT_ENTRY_SIZE                  (32)
212 #define PLT_SMALL_ENTRY_SIZE            (16)
213 #define PLT_TLSDESC_ENTRY_SIZE          (32)
214
215 /* Encoding of the nop instruction */
216 #define INSN_NOP 0xd503201f
217
218 #define aarch64_compute_jump_table_size(htab)           \
219   (((htab)->root.srelplt == NULL) ? 0                   \
220    : (htab)->root.srelplt->reloc_count * GOT_ENTRY_SIZE)
221
222 /* The first entry in a procedure linkage table looks like this
223    if the distance between the PLTGOT and the PLT is < 4GB use
224    these PLT entries. Note that the dynamic linker gets &PLTGOT[2]
225    in x16 and needs to work out PLTGOT[1] by using an address of
226    [x16,#-GOT_ENTRY_SIZE].  */
227 static const bfd_byte elfNN_aarch64_small_plt0_entry[PLT_ENTRY_SIZE] =
228 {
229   0xf0, 0x7b, 0xbf, 0xa9,       /* stp x16, x30, [sp, #-16]!  */
230   0x10, 0x00, 0x00, 0x90,       /* adrp x16, (GOT+16)  */
231 #if ARCH_SIZE == 64
232   0x11, 0x0A, 0x40, 0xf9,       /* ldr x17, [x16, #PLT_GOT+0x10]  */
233   0x10, 0x42, 0x00, 0x91,       /* add x16, x16,#PLT_GOT+0x10   */
234 #else
235   0x11, 0x0A, 0x40, 0xb9,       /* ldr w17, [x16, #PLT_GOT+0x8]  */
236   0x10, 0x22, 0x00, 0x11,       /* add w16, w16,#PLT_GOT+0x8   */
237 #endif
238   0x20, 0x02, 0x1f, 0xd6,       /* br x17  */
239   0x1f, 0x20, 0x03, 0xd5,       /* nop */
240   0x1f, 0x20, 0x03, 0xd5,       /* nop */
241   0x1f, 0x20, 0x03, 0xd5,       /* nop */
242 };
243
244 /* Per function entry in a procedure linkage table looks like this
245    if the distance between the PLTGOT and the PLT is < 4GB use
246    these PLT entries.  */
247 static const bfd_byte elfNN_aarch64_small_plt_entry[PLT_SMALL_ENTRY_SIZE] =
248 {
249   0x10, 0x00, 0x00, 0x90,       /* adrp x16, PLTGOT + n * 8  */
250 #if ARCH_SIZE == 64
251   0x11, 0x02, 0x40, 0xf9,       /* ldr x17, [x16, PLTGOT + n * 8] */
252   0x10, 0x02, 0x00, 0x91,       /* add x16, x16, :lo12:PLTGOT + n * 8  */
253 #else
254   0x11, 0x02, 0x40, 0xb9,       /* ldr w17, [x16, PLTGOT + n * 4] */
255   0x10, 0x02, 0x00, 0x11,       /* add w16, w16, :lo12:PLTGOT + n * 4  */
256 #endif
257   0x20, 0x02, 0x1f, 0xd6,       /* br x17.  */
258 };
259
260 static const bfd_byte
261 elfNN_aarch64_tlsdesc_small_plt_entry[PLT_TLSDESC_ENTRY_SIZE] =
262 {
263   0xe2, 0x0f, 0xbf, 0xa9,       /* stp x2, x3, [sp, #-16]! */
264   0x02, 0x00, 0x00, 0x90,       /* adrp x2, 0 */
265   0x03, 0x00, 0x00, 0x90,       /* adrp x3, 0 */
266 #if ARCH_SIZE == 64
267   0x42, 0x00, 0x40, 0xf9,       /* ldr x2, [x2, #0] */
268   0x63, 0x00, 0x00, 0x91,       /* add x3, x3, 0 */
269 #else
270   0x42, 0x00, 0x40, 0xb9,       /* ldr w2, [x2, #0] */
271   0x63, 0x00, 0x00, 0x11,       /* add w3, w3, 0 */
272 #endif
273   0x40, 0x00, 0x1f, 0xd6,       /* br x2 */
274   0x1f, 0x20, 0x03, 0xd5,       /* nop */
275   0x1f, 0x20, 0x03, 0xd5,       /* nop */
276 };
277
278 #define elf_info_to_howto               elfNN_aarch64_info_to_howto
279 #define elf_info_to_howto_rel           elfNN_aarch64_info_to_howto
280
281 #define AARCH64_ELF_ABI_VERSION         0
282
283 /* In case we're on a 32-bit machine, construct a 64-bit "-1" value.  */
284 #define ALL_ONES (~ (bfd_vma) 0)
285
286 /* Indexed by the bfd interal reloc enumerators.
287    Therefore, the table needs to be synced with BFD_RELOC_AARCH64_*
288    in reloc.c.   */
289
290 static reloc_howto_type elfNN_aarch64_howto_table[] =
291 {
292   EMPTY_HOWTO (0),
293
294   /* Basic data relocations.  */
295
296 #if ARCH_SIZE == 64
297   HOWTO (R_AARCH64_NULL,        /* type */
298          0,                     /* rightshift */
299          0,                     /* size (0 = byte, 1 = short, 2 = long) */
300          0,                     /* bitsize */
301          FALSE,                 /* pc_relative */
302          0,                     /* bitpos */
303          complain_overflow_dont,        /* complain_on_overflow */
304          bfd_elf_generic_reloc, /* special_function */
305          "R_AARCH64_NULL",      /* name */
306          FALSE,                 /* partial_inplace */
307          0,                     /* src_mask */
308          0,                     /* dst_mask */
309          FALSE),                /* pcrel_offset */
310 #else
311   HOWTO (R_AARCH64_NONE,        /* type */
312          0,                     /* rightshift */
313          0,                     /* size (0 = byte, 1 = short, 2 = long) */
314          0,                     /* bitsize */
315          FALSE,                 /* pc_relative */
316          0,                     /* bitpos */
317          complain_overflow_dont,        /* complain_on_overflow */
318          bfd_elf_generic_reloc, /* special_function */
319          "R_AARCH64_NONE",      /* name */
320          FALSE,                 /* partial_inplace */
321          0,                     /* src_mask */
322          0,                     /* dst_mask */
323          FALSE),                /* pcrel_offset */
324 #endif
325
326   /* .xword: (S+A) */
327   HOWTO64 (AARCH64_R (ABS64),   /* type */
328          0,                     /* rightshift */
329          4,                     /* size (4 = long long) */
330          64,                    /* bitsize */
331          FALSE,                 /* pc_relative */
332          0,                     /* bitpos */
333          complain_overflow_unsigned,    /* complain_on_overflow */
334          bfd_elf_generic_reloc, /* special_function */
335          AARCH64_R_STR (ABS64), /* name */
336          FALSE,                 /* partial_inplace */
337          ALL_ONES,              /* src_mask */
338          ALL_ONES,              /* dst_mask */
339          FALSE),                /* pcrel_offset */
340
341   /* .word: (S+A) */
342   HOWTO (AARCH64_R (ABS32),     /* type */
343          0,                     /* rightshift */
344          2,                     /* size (0 = byte, 1 = short, 2 = long) */
345          32,                    /* bitsize */
346          FALSE,                 /* pc_relative */
347          0,                     /* bitpos */
348          complain_overflow_unsigned,    /* complain_on_overflow */
349          bfd_elf_generic_reloc, /* special_function */
350          AARCH64_R_STR (ABS32), /* name */
351          FALSE,                 /* partial_inplace */
352          0xffffffff,            /* src_mask */
353          0xffffffff,            /* dst_mask */
354          FALSE),                /* pcrel_offset */
355
356   /* .half:  (S+A) */
357   HOWTO (AARCH64_R (ABS16),     /* type */
358          0,                     /* rightshift */
359          1,                     /* size (0 = byte, 1 = short, 2 = long) */
360          16,                    /* bitsize */
361          FALSE,                 /* pc_relative */
362          0,                     /* bitpos */
363          complain_overflow_unsigned,    /* complain_on_overflow */
364          bfd_elf_generic_reloc, /* special_function */
365          AARCH64_R_STR (ABS16), /* name */
366          FALSE,                 /* partial_inplace */
367          0xffff,                /* src_mask */
368          0xffff,                /* dst_mask */
369          FALSE),                /* pcrel_offset */
370
371   /* .xword: (S+A-P) */
372   HOWTO64 (AARCH64_R (PREL64),  /* type */
373          0,                     /* rightshift */
374          4,                     /* size (4 = long long) */
375          64,                    /* bitsize */
376          TRUE,                  /* pc_relative */
377          0,                     /* bitpos */
378          complain_overflow_signed,      /* complain_on_overflow */
379          bfd_elf_generic_reloc, /* special_function */
380          AARCH64_R_STR (PREL64),        /* name */
381          FALSE,                 /* partial_inplace */
382          ALL_ONES,              /* src_mask */
383          ALL_ONES,              /* dst_mask */
384          TRUE),                 /* pcrel_offset */
385
386   /* .word: (S+A-P) */
387   HOWTO (AARCH64_R (PREL32),    /* type */
388          0,                     /* rightshift */
389          2,                     /* size (0 = byte, 1 = short, 2 = long) */
390          32,                    /* bitsize */
391          TRUE,                  /* pc_relative */
392          0,                     /* bitpos */
393          complain_overflow_signed,      /* complain_on_overflow */
394          bfd_elf_generic_reloc, /* special_function */
395          AARCH64_R_STR (PREL32),        /* name */
396          FALSE,                 /* partial_inplace */
397          0xffffffff,            /* src_mask */
398          0xffffffff,            /* dst_mask */
399          TRUE),                 /* pcrel_offset */
400
401   /* .half: (S+A-P) */
402   HOWTO (AARCH64_R (PREL16),    /* type */
403          0,                     /* rightshift */
404          1,                     /* size (0 = byte, 1 = short, 2 = long) */
405          16,                    /* bitsize */
406          TRUE,                  /* pc_relative */
407          0,                     /* bitpos */
408          complain_overflow_signed,      /* complain_on_overflow */
409          bfd_elf_generic_reloc, /* special_function */
410          AARCH64_R_STR (PREL16),        /* name */
411          FALSE,                 /* partial_inplace */
412          0xffff,                /* src_mask */
413          0xffff,                /* dst_mask */
414          TRUE),                 /* pcrel_offset */
415
416   /* Group relocations to create a 16, 32, 48 or 64 bit
417      unsigned data or abs address inline.  */
418
419   /* MOVZ:   ((S+A) >>  0) & 0xffff */
420   HOWTO (AARCH64_R (MOVW_UABS_G0),      /* type */
421          0,                     /* rightshift */
422          2,                     /* size (0 = byte, 1 = short, 2 = long) */
423          16,                    /* bitsize */
424          FALSE,                 /* pc_relative */
425          0,                     /* bitpos */
426          complain_overflow_unsigned,    /* complain_on_overflow */
427          bfd_elf_generic_reloc, /* special_function */
428          AARCH64_R_STR (MOVW_UABS_G0),  /* name */
429          FALSE,                 /* partial_inplace */
430          0xffff,                /* src_mask */
431          0xffff,                /* dst_mask */
432          FALSE),                /* pcrel_offset */
433
434   /* MOVK:   ((S+A) >>  0) & 0xffff [no overflow check] */
435   HOWTO (AARCH64_R (MOVW_UABS_G0_NC),   /* type */
436          0,                     /* rightshift */
437          2,                     /* size (0 = byte, 1 = short, 2 = long) */
438          16,                    /* bitsize */
439          FALSE,                 /* pc_relative */
440          0,                     /* bitpos */
441          complain_overflow_dont,        /* complain_on_overflow */
442          bfd_elf_generic_reloc, /* special_function */
443          AARCH64_R_STR (MOVW_UABS_G0_NC),       /* name */
444          FALSE,                 /* partial_inplace */
445          0xffff,                /* src_mask */
446          0xffff,                /* dst_mask */
447          FALSE),                /* pcrel_offset */
448
449   /* MOVZ:   ((S+A) >> 16) & 0xffff */
450   HOWTO (AARCH64_R (MOVW_UABS_G1),      /* type */
451          16,                    /* rightshift */
452          2,                     /* size (0 = byte, 1 = short, 2 = long) */
453          16,                    /* bitsize */
454          FALSE,                 /* pc_relative */
455          0,                     /* bitpos */
456          complain_overflow_unsigned,    /* complain_on_overflow */
457          bfd_elf_generic_reloc, /* special_function */
458          AARCH64_R_STR (MOVW_UABS_G1),  /* name */
459          FALSE,                 /* partial_inplace */
460          0xffff,                /* src_mask */
461          0xffff,                /* dst_mask */
462          FALSE),                /* pcrel_offset */
463
464   /* MOVK:   ((S+A) >> 16) & 0xffff [no overflow check] */
465   HOWTO64 (AARCH64_R (MOVW_UABS_G1_NC), /* type */
466          16,                    /* rightshift */
467          2,                     /* size (0 = byte, 1 = short, 2 = long) */
468          16,                    /* bitsize */
469          FALSE,                 /* pc_relative */
470          0,                     /* bitpos */
471          complain_overflow_dont,        /* complain_on_overflow */
472          bfd_elf_generic_reloc, /* special_function */
473          AARCH64_R_STR (MOVW_UABS_G1_NC),       /* name */
474          FALSE,                 /* partial_inplace */
475          0xffff,                /* src_mask */
476          0xffff,                /* dst_mask */
477          FALSE),                /* pcrel_offset */
478
479   /* MOVZ:   ((S+A) >> 32) & 0xffff */
480   HOWTO64 (AARCH64_R (MOVW_UABS_G2),    /* type */
481          32,                    /* rightshift */
482          2,                     /* size (0 = byte, 1 = short, 2 = long) */
483          16,                    /* bitsize */
484          FALSE,                 /* pc_relative */
485          0,                     /* bitpos */
486          complain_overflow_unsigned,    /* complain_on_overflow */
487          bfd_elf_generic_reloc, /* special_function */
488          AARCH64_R_STR (MOVW_UABS_G2),  /* name */
489          FALSE,                 /* partial_inplace */
490          0xffff,                /* src_mask */
491          0xffff,                /* dst_mask */
492          FALSE),                /* pcrel_offset */
493
494   /* MOVK:   ((S+A) >> 32) & 0xffff [no overflow check] */
495   HOWTO64 (AARCH64_R (MOVW_UABS_G2_NC), /* type */
496          32,                    /* rightshift */
497          2,                     /* size (0 = byte, 1 = short, 2 = long) */
498          16,                    /* bitsize */
499          FALSE,                 /* pc_relative */
500          0,                     /* bitpos */
501          complain_overflow_dont,        /* complain_on_overflow */
502          bfd_elf_generic_reloc, /* special_function */
503          AARCH64_R_STR (MOVW_UABS_G2_NC),       /* name */
504          FALSE,                 /* partial_inplace */
505          0xffff,                /* src_mask */
506          0xffff,                /* dst_mask */
507          FALSE),                /* pcrel_offset */
508
509   /* MOVZ:   ((S+A) >> 48) & 0xffff */
510   HOWTO64 (AARCH64_R (MOVW_UABS_G3),    /* type */
511          48,                    /* rightshift */
512          2,                     /* size (0 = byte, 1 = short, 2 = long) */
513          16,                    /* bitsize */
514          FALSE,                 /* pc_relative */
515          0,                     /* bitpos */
516          complain_overflow_unsigned,    /* complain_on_overflow */
517          bfd_elf_generic_reloc, /* special_function */
518          AARCH64_R_STR (MOVW_UABS_G3),  /* name */
519          FALSE,                 /* partial_inplace */
520          0xffff,                /* src_mask */
521          0xffff,                /* dst_mask */
522          FALSE),                /* pcrel_offset */
523
524   /* Group relocations to create high part of a 16, 32, 48 or 64 bit
525      signed data or abs address inline. Will change instruction
526      to MOVN or MOVZ depending on sign of calculated value.  */
527
528   /* MOV[ZN]:   ((S+A) >>  0) & 0xffff */
529   HOWTO (AARCH64_R (MOVW_SABS_G0),      /* type */
530          0,                     /* rightshift */
531          2,                     /* size (0 = byte, 1 = short, 2 = long) */
532          16,                    /* bitsize */
533          FALSE,                 /* pc_relative */
534          0,                     /* bitpos */
535          complain_overflow_signed,      /* complain_on_overflow */
536          bfd_elf_generic_reloc, /* special_function */
537          AARCH64_R_STR (MOVW_SABS_G0),  /* name */
538          FALSE,                 /* partial_inplace */
539          0xffff,                /* src_mask */
540          0xffff,                /* dst_mask */
541          FALSE),                /* pcrel_offset */
542
543   /* MOV[ZN]:   ((S+A) >> 16) & 0xffff */
544   HOWTO64 (AARCH64_R (MOVW_SABS_G1),    /* type */
545          16,                    /* rightshift */
546          2,                     /* size (0 = byte, 1 = short, 2 = long) */
547          16,                    /* bitsize */
548          FALSE,                 /* pc_relative */
549          0,                     /* bitpos */
550          complain_overflow_signed,      /* complain_on_overflow */
551          bfd_elf_generic_reloc, /* special_function */
552          AARCH64_R_STR (MOVW_SABS_G1),  /* name */
553          FALSE,                 /* partial_inplace */
554          0xffff,                /* src_mask */
555          0xffff,                /* dst_mask */
556          FALSE),                /* pcrel_offset */
557
558   /* MOV[ZN]:   ((S+A) >> 32) & 0xffff */
559   HOWTO64 (AARCH64_R (MOVW_SABS_G2),    /* type */
560          32,                    /* rightshift */
561          2,                     /* size (0 = byte, 1 = short, 2 = long) */
562          16,                    /* bitsize */
563          FALSE,                 /* pc_relative */
564          0,                     /* bitpos */
565          complain_overflow_signed,      /* complain_on_overflow */
566          bfd_elf_generic_reloc, /* special_function */
567          AARCH64_R_STR (MOVW_SABS_G2),  /* name */
568          FALSE,                 /* partial_inplace */
569          0xffff,                /* src_mask */
570          0xffff,                /* dst_mask */
571          FALSE),                /* pcrel_offset */
572
573 /* Relocations to generate 19, 21 and 33 bit PC-relative load/store
574    addresses: PG(x) is (x & ~0xfff).  */
575
576   /* LD-lit: ((S+A-P) >> 2) & 0x7ffff */
577   HOWTO (AARCH64_R (LD_PREL_LO19),      /* type */
578          2,                     /* rightshift */
579          2,                     /* size (0 = byte, 1 = short, 2 = long) */
580          19,                    /* bitsize */
581          TRUE,                  /* pc_relative */
582          0,                     /* bitpos */
583          complain_overflow_signed,      /* complain_on_overflow */
584          bfd_elf_generic_reloc, /* special_function */
585          AARCH64_R_STR (LD_PREL_LO19),  /* name */
586          FALSE,                 /* partial_inplace */
587          0x7ffff,               /* src_mask */
588          0x7ffff,               /* dst_mask */
589          TRUE),                 /* pcrel_offset */
590
591   /* ADR:    (S+A-P) & 0x1fffff */
592   HOWTO (AARCH64_R (ADR_PREL_LO21),     /* type */
593          0,                     /* rightshift */
594          2,                     /* size (0 = byte, 1 = short, 2 = long) */
595          21,                    /* bitsize */
596          TRUE,                  /* pc_relative */
597          0,                     /* bitpos */
598          complain_overflow_signed,      /* complain_on_overflow */
599          bfd_elf_generic_reloc, /* special_function */
600          AARCH64_R_STR (ADR_PREL_LO21), /* name */
601          FALSE,                 /* partial_inplace */
602          0x1fffff,              /* src_mask */
603          0x1fffff,              /* dst_mask */
604          TRUE),                 /* pcrel_offset */
605
606   /* ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
607   HOWTO (AARCH64_R (ADR_PREL_PG_HI21),  /* type */
608          12,                    /* rightshift */
609          2,                     /* size (0 = byte, 1 = short, 2 = long) */
610          21,                    /* bitsize */
611          TRUE,                  /* pc_relative */
612          0,                     /* bitpos */
613          complain_overflow_signed,      /* complain_on_overflow */
614          bfd_elf_generic_reloc, /* special_function */
615          AARCH64_R_STR (ADR_PREL_PG_HI21),      /* name */
616          FALSE,                 /* partial_inplace */
617          0x1fffff,              /* src_mask */
618          0x1fffff,              /* dst_mask */
619          TRUE),                 /* pcrel_offset */
620
621   /* ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff [no overflow check] */
622   HOWTO64 (AARCH64_R (ADR_PREL_PG_HI21_NC),     /* type */
623          12,                    /* rightshift */
624          2,                     /* size (0 = byte, 1 = short, 2 = long) */
625          21,                    /* bitsize */
626          TRUE,                  /* pc_relative */
627          0,                     /* bitpos */
628          complain_overflow_dont,        /* complain_on_overflow */
629          bfd_elf_generic_reloc, /* special_function */
630          AARCH64_R_STR (ADR_PREL_PG_HI21_NC),   /* name */
631          FALSE,                 /* partial_inplace */
632          0x1fffff,              /* src_mask */
633          0x1fffff,              /* dst_mask */
634          TRUE),                 /* pcrel_offset */
635
636   /* ADD:    (S+A) & 0xfff [no overflow check] */
637   HOWTO (AARCH64_R (ADD_ABS_LO12_NC),   /* type */
638          0,                     /* rightshift */
639          2,                     /* size (0 = byte, 1 = short, 2 = long) */
640          12,                    /* bitsize */
641          FALSE,                 /* pc_relative */
642          10,                    /* bitpos */
643          complain_overflow_dont,        /* complain_on_overflow */
644          bfd_elf_generic_reloc, /* special_function */
645          AARCH64_R_STR (ADD_ABS_LO12_NC),       /* name */
646          FALSE,                 /* partial_inplace */
647          0x3ffc00,              /* src_mask */
648          0x3ffc00,              /* dst_mask */
649          FALSE),                /* pcrel_offset */
650
651   /* LD/ST8:  (S+A) & 0xfff */
652   HOWTO (AARCH64_R (LDST8_ABS_LO12_NC), /* type */
653          0,                     /* rightshift */
654          2,                     /* size (0 = byte, 1 = short, 2 = long) */
655          12,                    /* bitsize */
656          FALSE,                 /* pc_relative */
657          0,                     /* bitpos */
658          complain_overflow_dont,        /* complain_on_overflow */
659          bfd_elf_generic_reloc, /* special_function */
660          AARCH64_R_STR (LDST8_ABS_LO12_NC),     /* name */
661          FALSE,                 /* partial_inplace */
662          0xfff,                 /* src_mask */
663          0xfff,                 /* dst_mask */
664          FALSE),                /* pcrel_offset */
665
666   /* Relocations for control-flow instructions.  */
667
668   /* TBZ/NZ: ((S+A-P) >> 2) & 0x3fff */
669   HOWTO (AARCH64_R (TSTBR14),   /* type */
670          2,                     /* rightshift */
671          2,                     /* size (0 = byte, 1 = short, 2 = long) */
672          14,                    /* bitsize */
673          TRUE,                  /* pc_relative */
674          0,                     /* bitpos */
675          complain_overflow_signed,      /* complain_on_overflow */
676          bfd_elf_generic_reloc, /* special_function */
677          AARCH64_R_STR (TSTBR14),       /* name */
678          FALSE,                 /* partial_inplace */
679          0x3fff,                /* src_mask */
680          0x3fff,                /* dst_mask */
681          TRUE),                 /* pcrel_offset */
682
683   /* B.cond: ((S+A-P) >> 2) & 0x7ffff */
684   HOWTO (AARCH64_R (CONDBR19),  /* type */
685          2,                     /* rightshift */
686          2,                     /* size (0 = byte, 1 = short, 2 = long) */
687          19,                    /* bitsize */
688          TRUE,                  /* pc_relative */
689          0,                     /* bitpos */
690          complain_overflow_signed,      /* complain_on_overflow */
691          bfd_elf_generic_reloc, /* special_function */
692          AARCH64_R_STR (CONDBR19),      /* name */
693          FALSE,                 /* partial_inplace */
694          0x7ffff,               /* src_mask */
695          0x7ffff,               /* dst_mask */
696          TRUE),                 /* pcrel_offset */
697
698   /* B:      ((S+A-P) >> 2) & 0x3ffffff */
699   HOWTO (AARCH64_R (JUMP26),    /* type */
700          2,                     /* rightshift */
701          2,                     /* size (0 = byte, 1 = short, 2 = long) */
702          26,                    /* bitsize */
703          TRUE,                  /* pc_relative */
704          0,                     /* bitpos */
705          complain_overflow_signed,      /* complain_on_overflow */
706          bfd_elf_generic_reloc, /* special_function */
707          AARCH64_R_STR (JUMP26),        /* name */
708          FALSE,                 /* partial_inplace */
709          0x3ffffff,             /* src_mask */
710          0x3ffffff,             /* dst_mask */
711          TRUE),                 /* pcrel_offset */
712
713   /* BL:     ((S+A-P) >> 2) & 0x3ffffff */
714   HOWTO (AARCH64_R (CALL26),    /* type */
715          2,                     /* rightshift */
716          2,                     /* size (0 = byte, 1 = short, 2 = long) */
717          26,                    /* bitsize */
718          TRUE,                  /* pc_relative */
719          0,                     /* bitpos */
720          complain_overflow_signed,      /* complain_on_overflow */
721          bfd_elf_generic_reloc, /* special_function */
722          AARCH64_R_STR (CALL26),        /* name */
723          FALSE,                 /* partial_inplace */
724          0x3ffffff,             /* src_mask */
725          0x3ffffff,             /* dst_mask */
726          TRUE),                 /* pcrel_offset */
727
728   /* LD/ST16:  (S+A) & 0xffe */
729   HOWTO (AARCH64_R (LDST16_ABS_LO12_NC),        /* type */
730          1,                     /* rightshift */
731          2,                     /* size (0 = byte, 1 = short, 2 = long) */
732          12,                    /* bitsize */
733          FALSE,                 /* pc_relative */
734          0,                     /* bitpos */
735          complain_overflow_dont,        /* complain_on_overflow */
736          bfd_elf_generic_reloc, /* special_function */
737          AARCH64_R_STR (LDST16_ABS_LO12_NC),    /* name */
738          FALSE,                 /* partial_inplace */
739          0xffe,                 /* src_mask */
740          0xffe,                 /* dst_mask */
741          FALSE),                /* pcrel_offset */
742
743   /* LD/ST32:  (S+A) & 0xffc */
744   HOWTO (AARCH64_R (LDST32_ABS_LO12_NC),        /* type */
745          2,                     /* rightshift */
746          2,                     /* size (0 = byte, 1 = short, 2 = long) */
747          12,                    /* bitsize */
748          FALSE,                 /* pc_relative */
749          0,                     /* bitpos */
750          complain_overflow_dont,        /* complain_on_overflow */
751          bfd_elf_generic_reloc, /* special_function */
752          AARCH64_R_STR (LDST32_ABS_LO12_NC),    /* name */
753          FALSE,                 /* partial_inplace */
754          0xffc,                 /* src_mask */
755          0xffc,                 /* dst_mask */
756          FALSE),                /* pcrel_offset */
757
758   /* LD/ST64:  (S+A) & 0xff8 */
759   HOWTO (AARCH64_R (LDST64_ABS_LO12_NC),        /* type */
760          3,                     /* rightshift */
761          2,                     /* size (0 = byte, 1 = short, 2 = long) */
762          12,                    /* bitsize */
763          FALSE,                 /* pc_relative */
764          0,                     /* bitpos */
765          complain_overflow_dont,        /* complain_on_overflow */
766          bfd_elf_generic_reloc, /* special_function */
767          AARCH64_R_STR (LDST64_ABS_LO12_NC),    /* name */
768          FALSE,                 /* partial_inplace */
769          0xff8,                 /* src_mask */
770          0xff8,                 /* dst_mask */
771          FALSE),                /* pcrel_offset */
772
773   /* LD/ST128:  (S+A) & 0xff0 */
774   HOWTO (AARCH64_R (LDST128_ABS_LO12_NC),       /* type */
775          4,                     /* rightshift */
776          2,                     /* size (0 = byte, 1 = short, 2 = long) */
777          12,                    /* bitsize */
778          FALSE,                 /* pc_relative */
779          0,                     /* bitpos */
780          complain_overflow_dont,        /* complain_on_overflow */
781          bfd_elf_generic_reloc, /* special_function */
782          AARCH64_R_STR (LDST128_ABS_LO12_NC),   /* name */
783          FALSE,                 /* partial_inplace */
784          0xff0,                 /* src_mask */
785          0xff0,                 /* dst_mask */
786          FALSE),                /* pcrel_offset */
787
788   /* Set a load-literal immediate field to bits
789      0x1FFFFC of G(S)-P */
790   HOWTO (AARCH64_R (GOT_LD_PREL19),     /* type */
791          2,                             /* rightshift */
792          2,                             /* size (0 = byte,1 = short,2 = long) */
793          19,                            /* bitsize */
794          TRUE,                          /* pc_relative */
795          0,                             /* bitpos */
796          complain_overflow_signed,      /* complain_on_overflow */
797          bfd_elf_generic_reloc,         /* special_function */
798          AARCH64_R_STR (GOT_LD_PREL19), /* name */
799          FALSE,                         /* partial_inplace */
800          0xffffe0,                      /* src_mask */
801          0xffffe0,                      /* dst_mask */
802          TRUE),                         /* pcrel_offset */
803
804   /* Get to the page for the GOT entry for the symbol
805      (G(S) - P) using an ADRP instruction.  */
806   HOWTO (AARCH64_R (ADR_GOT_PAGE),      /* type */
807          12,                    /* rightshift */
808          2,                     /* size (0 = byte, 1 = short, 2 = long) */
809          21,                    /* bitsize */
810          TRUE,                  /* pc_relative */
811          0,                     /* bitpos */
812          complain_overflow_dont,        /* complain_on_overflow */
813          bfd_elf_generic_reloc, /* special_function */
814          AARCH64_R_STR (ADR_GOT_PAGE),  /* name */
815          FALSE,                 /* partial_inplace */
816          0x1fffff,              /* src_mask */
817          0x1fffff,              /* dst_mask */
818          TRUE),                 /* pcrel_offset */
819
820   /* LD64: GOT offset G(S) & 0xff8  */
821   HOWTO64 (AARCH64_R (LD64_GOT_LO12_NC),        /* type */
822          3,                     /* rightshift */
823          2,                     /* size (0 = byte, 1 = short, 2 = long) */
824          12,                    /* bitsize */
825          FALSE,                 /* pc_relative */
826          0,                     /* bitpos */
827          complain_overflow_dont,        /* complain_on_overflow */
828          bfd_elf_generic_reloc, /* special_function */
829          AARCH64_R_STR (LD64_GOT_LO12_NC),      /* name */
830          FALSE,                 /* partial_inplace */
831          0xff8,                 /* src_mask */
832          0xff8,                 /* dst_mask */
833          FALSE),                /* pcrel_offset */
834
835   /* LD32: GOT offset G(S) & 0xffc  */
836   HOWTO32 (AARCH64_R (LD32_GOT_LO12_NC),        /* type */
837          2,                     /* rightshift */
838          2,                     /* size (0 = byte, 1 = short, 2 = long) */
839          12,                    /* bitsize */
840          FALSE,                 /* pc_relative */
841          0,                     /* bitpos */
842          complain_overflow_dont,        /* complain_on_overflow */
843          bfd_elf_generic_reloc, /* special_function */
844          AARCH64_R_STR (LD32_GOT_LO12_NC),      /* name */
845          FALSE,                 /* partial_inplace */
846          0xffc,                 /* src_mask */
847          0xffc,                 /* dst_mask */
848          FALSE),                /* pcrel_offset */
849
850   /* Get to the page for the GOT entry for the symbol
851      (G(S) - P) using an ADRP instruction.  */
852   HOWTO (AARCH64_R (TLSGD_ADR_PAGE21),  /* type */
853          12,                    /* rightshift */
854          2,                     /* size (0 = byte, 1 = short, 2 = long) */
855          21,                    /* bitsize */
856          TRUE,                  /* pc_relative */
857          0,                     /* bitpos */
858          complain_overflow_dont,        /* complain_on_overflow */
859          bfd_elf_generic_reloc, /* special_function */
860          AARCH64_R_STR (TLSGD_ADR_PAGE21),      /* name */
861          FALSE,                 /* partial_inplace */
862          0x1fffff,              /* src_mask */
863          0x1fffff,              /* dst_mask */
864          TRUE),                 /* pcrel_offset */
865
866   /* ADD: GOT offset G(S) & 0xff8 [no overflow check] */
867   HOWTO (AARCH64_R (TLSGD_ADD_LO12_NC), /* type */
868          0,                     /* rightshift */
869          2,                     /* size (0 = byte, 1 = short, 2 = long) */
870          12,                    /* bitsize */
871          FALSE,                 /* pc_relative */
872          0,                     /* bitpos */
873          complain_overflow_dont,        /* complain_on_overflow */
874          bfd_elf_generic_reloc, /* special_function */
875          AARCH64_R_STR (TLSGD_ADD_LO12_NC),     /* name */
876          FALSE,                 /* partial_inplace */
877          0xfff,                 /* src_mask */
878          0xfff,                 /* dst_mask */
879          FALSE),                /* pcrel_offset */
880
881   HOWTO64 (AARCH64_R (TLSIE_MOVW_GOTTPREL_G1),  /* type */
882          16,                    /* rightshift */
883          2,                     /* size (0 = byte, 1 = short, 2 = long) */
884          16,                    /* bitsize */
885          FALSE,                 /* pc_relative */
886          0,                     /* bitpos */
887          complain_overflow_dont,        /* complain_on_overflow */
888          bfd_elf_generic_reloc, /* special_function */
889          AARCH64_R_STR (TLSIE_MOVW_GOTTPREL_G1),        /* name */
890          FALSE,                 /* partial_inplace */
891          0xffff,                /* src_mask */
892          0xffff,                /* dst_mask */
893          FALSE),                /* pcrel_offset */
894
895   HOWTO64 (AARCH64_R (TLSIE_MOVW_GOTTPREL_G0_NC),       /* type */
896          0,                     /* rightshift */
897          2,                     /* size (0 = byte, 1 = short, 2 = long) */
898          32,                    /* bitsize */
899          FALSE,                 /* pc_relative */
900          0,                     /* bitpos */
901          complain_overflow_dont,        /* complain_on_overflow */
902          bfd_elf_generic_reloc, /* special_function */
903          AARCH64_R_STR (TLSIE_MOVW_GOTTPREL_G0_NC),     /* name */
904          FALSE,                 /* partial_inplace */
905          0xffff,                /* src_mask */
906          0xffff,                /* dst_mask */
907          FALSE),                /* pcrel_offset */
908
909   HOWTO (AARCH64_R (TLSIE_ADR_GOTTPREL_PAGE21), /* type */
910          12,                    /* rightshift */
911          2,                     /* size (0 = byte, 1 = short, 2 = long) */
912          21,                    /* bitsize */
913          FALSE,                 /* pc_relative */
914          0,                     /* bitpos */
915          complain_overflow_dont,        /* complain_on_overflow */
916          bfd_elf_generic_reloc, /* special_function */
917          AARCH64_R_STR (TLSIE_ADR_GOTTPREL_PAGE21),     /* name */
918          FALSE,                 /* partial_inplace */
919          0x1fffff,              /* src_mask */
920          0x1fffff,              /* dst_mask */
921          FALSE),                /* pcrel_offset */
922
923   HOWTO64 (AARCH64_R (TLSIE_LD64_GOTTPREL_LO12_NC),     /* type */
924          3,                     /* rightshift */
925          2,                     /* size (0 = byte, 1 = short, 2 = long) */
926          12,                    /* bitsize */
927          FALSE,                 /* pc_relative */
928          0,                     /* bitpos */
929          complain_overflow_dont,        /* complain_on_overflow */
930          bfd_elf_generic_reloc, /* special_function */
931          AARCH64_R_STR (TLSIE_LD64_GOTTPREL_LO12_NC),   /* name */
932          FALSE,                 /* partial_inplace */
933          0xff8,                 /* src_mask */
934          0xff8,                 /* dst_mask */
935          FALSE),                /* pcrel_offset */
936
937   HOWTO32 (AARCH64_R (TLSIE_LD32_GOTTPREL_LO12_NC),     /* type */
938          2,                     /* rightshift */
939          2,                     /* size (0 = byte, 1 = short, 2 = long) */
940          12,                    /* bitsize */
941          FALSE,                 /* pc_relative */
942          0,                     /* bitpos */
943          complain_overflow_dont,        /* complain_on_overflow */
944          bfd_elf_generic_reloc, /* special_function */
945          AARCH64_R_STR (TLSIE_LD32_GOTTPREL_LO12_NC),   /* name */
946          FALSE,                 /* partial_inplace */
947          0xffc,                 /* src_mask */
948          0xffc,                 /* dst_mask */
949          FALSE),                /* pcrel_offset */
950
951   HOWTO (AARCH64_R (TLSIE_LD_GOTTPREL_PREL19),  /* type */
952          2,                     /* rightshift */
953          2,                     /* size (0 = byte, 1 = short, 2 = long) */
954          21,                    /* bitsize */
955          FALSE,                 /* pc_relative */
956          0,                     /* bitpos */
957          complain_overflow_dont,        /* complain_on_overflow */
958          bfd_elf_generic_reloc, /* special_function */
959          AARCH64_R_STR (TLSIE_LD_GOTTPREL_PREL19),      /* name */
960          FALSE,                 /* partial_inplace */
961          0x1ffffc,              /* src_mask */
962          0x1ffffc,              /* dst_mask */
963          FALSE),                /* pcrel_offset */
964
965   HOWTO64 (AARCH64_R (TLSLE_MOVW_TPREL_G2),     /* type */
966          32,                    /* rightshift */
967          2,                     /* size (0 = byte, 1 = short, 2 = long) */
968          12,                    /* bitsize */
969          FALSE,                 /* pc_relative */
970          0,                     /* bitpos */
971          complain_overflow_dont,        /* complain_on_overflow */
972          bfd_elf_generic_reloc, /* special_function */
973          AARCH64_R_STR (TLSLE_MOVW_TPREL_G2),   /* name */
974          FALSE,                 /* partial_inplace */
975          0xffff,                /* src_mask */
976          0xffff,                /* dst_mask */
977          FALSE),                /* pcrel_offset */
978
979   HOWTO (AARCH64_R (TLSLE_MOVW_TPREL_G1),       /* type */
980          16,                    /* rightshift */
981          2,                     /* size (0 = byte, 1 = short, 2 = long) */
982          12,                    /* bitsize */
983          FALSE,                 /* pc_relative */
984          0,                     /* bitpos */
985          complain_overflow_dont,        /* complain_on_overflow */
986          bfd_elf_generic_reloc, /* special_function */
987          AARCH64_R_STR (TLSLE_MOVW_TPREL_G1),   /* name */
988          FALSE,                 /* partial_inplace */
989          0xffff,                /* src_mask */
990          0xffff,                /* dst_mask */
991          FALSE),                /* pcrel_offset */
992
993   HOWTO64 (AARCH64_R (TLSLE_MOVW_TPREL_G1_NC),  /* type */
994          16,                    /* rightshift */
995          2,                     /* size (0 = byte, 1 = short, 2 = long) */
996          12,                    /* bitsize */
997          FALSE,                 /* pc_relative */
998          0,                     /* bitpos */
999          complain_overflow_dont,        /* complain_on_overflow */
1000          bfd_elf_generic_reloc, /* special_function */
1001          AARCH64_R_STR (TLSLE_MOVW_TPREL_G1_NC),        /* name */
1002          FALSE,                 /* partial_inplace */
1003          0xffff,                /* src_mask */
1004          0xffff,                /* dst_mask */
1005          FALSE),                /* pcrel_offset */
1006
1007   HOWTO (AARCH64_R (TLSLE_MOVW_TPREL_G0),       /* type */
1008          0,                     /* rightshift */
1009          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1010          12,                    /* bitsize */
1011          FALSE,                 /* pc_relative */
1012          0,                     /* bitpos */
1013          complain_overflow_dont,        /* complain_on_overflow */
1014          bfd_elf_generic_reloc, /* special_function */
1015          AARCH64_R_STR (TLSLE_MOVW_TPREL_G0),   /* name */
1016          FALSE,                 /* partial_inplace */
1017          0xffff,                /* src_mask */
1018          0xffff,                /* dst_mask */
1019          FALSE),                /* pcrel_offset */
1020
1021   HOWTO (AARCH64_R (TLSLE_MOVW_TPREL_G0_NC),    /* type */
1022          0,                     /* rightshift */
1023          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1024          12,                    /* bitsize */
1025          FALSE,                 /* pc_relative */
1026          0,                     /* bitpos */
1027          complain_overflow_dont,        /* complain_on_overflow */
1028          bfd_elf_generic_reloc, /* special_function */
1029          AARCH64_R_STR (TLSLE_MOVW_TPREL_G0_NC),        /* name */
1030          FALSE,                 /* partial_inplace */
1031          0xffff,                /* src_mask */
1032          0xffff,                /* dst_mask */
1033          FALSE),                /* pcrel_offset */
1034
1035   HOWTO (AARCH64_R (TLSLE_ADD_TPREL_HI12),      /* type */
1036          12,                    /* rightshift */
1037          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1038          12,                    /* bitsize */
1039          FALSE,                 /* pc_relative */
1040          0,                     /* bitpos */
1041          complain_overflow_dont,        /* complain_on_overflow */
1042          bfd_elf_generic_reloc, /* special_function */
1043          AARCH64_R_STR (TLSLE_ADD_TPREL_HI12),  /* name */
1044          FALSE,                 /* partial_inplace */
1045          0xfff,                 /* src_mask */
1046          0xfff,                 /* dst_mask */
1047          FALSE),                /* pcrel_offset */
1048
1049   HOWTO (AARCH64_R (TLSLE_ADD_TPREL_LO12),      /* type */
1050          0,                     /* rightshift */
1051          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1052          12,                    /* bitsize */
1053          FALSE,                 /* pc_relative */
1054          0,                     /* bitpos */
1055          complain_overflow_dont,        /* complain_on_overflow */
1056          bfd_elf_generic_reloc, /* special_function */
1057          AARCH64_R_STR (TLSLE_ADD_TPREL_LO12),  /* name */
1058          FALSE,                 /* partial_inplace */
1059          0xfff,                 /* src_mask */
1060          0xfff,                 /* dst_mask */
1061          FALSE),                /* pcrel_offset */
1062
1063   HOWTO (AARCH64_R (TLSLE_ADD_TPREL_LO12_NC),   /* type */
1064          0,                     /* rightshift */
1065          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1066          12,                    /* bitsize */
1067          FALSE,                 /* pc_relative */
1068          0,                     /* bitpos */
1069          complain_overflow_dont,        /* complain_on_overflow */
1070          bfd_elf_generic_reloc, /* special_function */
1071          AARCH64_R_STR (TLSLE_ADD_TPREL_LO12_NC),       /* name */
1072          FALSE,                 /* partial_inplace */
1073          0xfff,                 /* src_mask */
1074          0xfff,                 /* dst_mask */
1075          FALSE),                /* pcrel_offset */
1076
1077   HOWTO (AARCH64_R (TLSDESC_LD_PREL19), /* type */
1078          2,                     /* rightshift */
1079          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1080          21,                    /* bitsize */
1081          TRUE,                  /* pc_relative */
1082          0,                     /* bitpos */
1083          complain_overflow_dont,        /* complain_on_overflow */
1084          bfd_elf_generic_reloc, /* special_function */
1085          AARCH64_R_STR (TLSDESC_LD_PREL19),     /* name */
1086          FALSE,                 /* partial_inplace */
1087          0x1ffffc,              /* src_mask */
1088          0x1ffffc,              /* dst_mask */
1089          TRUE),                 /* pcrel_offset */
1090
1091   HOWTO (AARCH64_R (TLSDESC_ADR_PREL21),        /* type */
1092          0,                     /* rightshift */
1093          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1094          21,                    /* bitsize */
1095          TRUE,                  /* pc_relative */
1096          0,                     /* bitpos */
1097          complain_overflow_dont,        /* complain_on_overflow */
1098          bfd_elf_generic_reloc, /* special_function */
1099          AARCH64_R_STR (TLSDESC_ADR_PREL21),    /* name */
1100          FALSE,                 /* partial_inplace */
1101          0x1fffff,              /* src_mask */
1102          0x1fffff,              /* dst_mask */
1103          TRUE),                 /* pcrel_offset */
1104
1105   /* Get to the page for the GOT entry for the symbol
1106      (G(S) - P) using an ADRP instruction.  */
1107   HOWTO (AARCH64_R (TLSDESC_ADR_PAGE21),        /* type */
1108          12,                    /* rightshift */
1109          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1110          21,                    /* bitsize */
1111          TRUE,                  /* pc_relative */
1112          0,                     /* bitpos */
1113          complain_overflow_dont,        /* complain_on_overflow */
1114          bfd_elf_generic_reloc, /* special_function */
1115          AARCH64_R_STR (TLSDESC_ADR_PAGE21),    /* name */
1116          FALSE,                 /* partial_inplace */
1117          0x1fffff,              /* src_mask */
1118          0x1fffff,              /* dst_mask */
1119          TRUE),                 /* pcrel_offset */
1120
1121   /* LD64: GOT offset G(S) & 0xff8.  */
1122   HOWTO64 (AARCH64_R (TLSDESC_LD64_LO12_NC),    /* type */
1123          3,                     /* rightshift */
1124          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1125          12,                    /* bitsize */
1126          FALSE,                 /* pc_relative */
1127          0,                     /* bitpos */
1128          complain_overflow_dont,        /* complain_on_overflow */
1129          bfd_elf_generic_reloc, /* special_function */
1130          AARCH64_R_STR (TLSDESC_LD64_LO12_NC),  /* name */
1131          FALSE,                 /* partial_inplace */
1132          0xff8,                 /* src_mask */
1133          0xff8,                 /* dst_mask */
1134          FALSE),                /* pcrel_offset */
1135
1136   /* LD32: GOT offset G(S) & 0xffc.  */
1137   HOWTO32 (AARCH64_R (TLSDESC_LD32_LO12_NC),    /* type */
1138          2,                     /* rightshift */
1139          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1140          12,                    /* bitsize */
1141          FALSE,                 /* pc_relative */
1142          0,                     /* bitpos */
1143          complain_overflow_dont,        /* complain_on_overflow */
1144          bfd_elf_generic_reloc, /* special_function */
1145          AARCH64_R_STR (TLSDESC_LD32_LO12_NC),  /* name */
1146          FALSE,                 /* partial_inplace */
1147          0xffc,                 /* src_mask */
1148          0xffc,                 /* dst_mask */
1149          FALSE),                /* pcrel_offset */
1150
1151   /* ADD: GOT offset G(S) & 0xfff.  */
1152   HOWTO (AARCH64_R (TLSDESC_ADD_LO12_NC),       /* type */
1153          0,                     /* rightshift */
1154          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1155          12,                    /* bitsize */
1156          FALSE,                 /* pc_relative */
1157          0,                     /* bitpos */
1158          complain_overflow_dont,        /* complain_on_overflow */
1159          bfd_elf_generic_reloc, /* special_function */
1160          AARCH64_R_STR (TLSDESC_ADD_LO12_NC),   /* name */
1161          FALSE,                 /* partial_inplace */
1162          0xfff,                 /* src_mask */
1163          0xfff,                 /* dst_mask */
1164          FALSE),                /* pcrel_offset */
1165
1166   HOWTO64 (AARCH64_R (TLSDESC_OFF_G1),  /* type */
1167          16,                    /* rightshift */
1168          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1169          12,                    /* bitsize */
1170          FALSE,                 /* pc_relative */
1171          0,                     /* bitpos */
1172          complain_overflow_dont,        /* complain_on_overflow */
1173          bfd_elf_generic_reloc, /* special_function */
1174          AARCH64_R_STR (TLSDESC_OFF_G1),        /* name */
1175          FALSE,                 /* partial_inplace */
1176          0xffff,                /* src_mask */
1177          0xffff,                /* dst_mask */
1178          FALSE),                /* pcrel_offset */
1179
1180   HOWTO64 (AARCH64_R (TLSDESC_OFF_G0_NC),       /* type */
1181          0,                     /* rightshift */
1182          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1183          12,                    /* bitsize */
1184          FALSE,                 /* pc_relative */
1185          0,                     /* bitpos */
1186          complain_overflow_dont,        /* complain_on_overflow */
1187          bfd_elf_generic_reloc, /* special_function */
1188          AARCH64_R_STR (TLSDESC_OFF_G0_NC),     /* name */
1189          FALSE,                 /* partial_inplace */
1190          0xffff,                /* src_mask */
1191          0xffff,                /* dst_mask */
1192          FALSE),                /* pcrel_offset */
1193
1194   HOWTO64 (AARCH64_R (TLSDESC_LDR),     /* type */
1195          0,                     /* rightshift */
1196          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1197          12,                    /* bitsize */
1198          FALSE,                 /* pc_relative */
1199          0,                     /* bitpos */
1200          complain_overflow_dont,        /* complain_on_overflow */
1201          bfd_elf_generic_reloc, /* special_function */
1202          AARCH64_R_STR (TLSDESC_LDR),   /* name */
1203          FALSE,                 /* partial_inplace */
1204          0x0,                   /* src_mask */
1205          0x0,                   /* dst_mask */
1206          FALSE),                /* pcrel_offset */
1207
1208   HOWTO64 (AARCH64_R (TLSDESC_ADD),     /* type */
1209          0,                     /* rightshift */
1210          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1211          12,                    /* bitsize */
1212          FALSE,                 /* pc_relative */
1213          0,                     /* bitpos */
1214          complain_overflow_dont,        /* complain_on_overflow */
1215          bfd_elf_generic_reloc, /* special_function */
1216          AARCH64_R_STR (TLSDESC_ADD),   /* name */
1217          FALSE,                 /* partial_inplace */
1218          0x0,                   /* src_mask */
1219          0x0,                   /* dst_mask */
1220          FALSE),                /* pcrel_offset */
1221
1222   HOWTO (AARCH64_R (TLSDESC_CALL),      /* type */
1223          0,                     /* rightshift */
1224          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1225          12,                    /* bitsize */
1226          FALSE,                 /* pc_relative */
1227          0,                     /* bitpos */
1228          complain_overflow_dont,        /* complain_on_overflow */
1229          bfd_elf_generic_reloc, /* special_function */
1230          AARCH64_R_STR (TLSDESC_CALL),  /* name */
1231          FALSE,                 /* partial_inplace */
1232          0x0,                   /* src_mask */
1233          0x0,                   /* dst_mask */
1234          FALSE),                /* pcrel_offset */
1235
1236   HOWTO (AARCH64_R (COPY),      /* type */
1237          0,                     /* rightshift */
1238          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1239          64,                    /* bitsize */
1240          FALSE,                 /* pc_relative */
1241          0,                     /* bitpos */
1242          complain_overflow_bitfield,    /* complain_on_overflow */
1243          bfd_elf_generic_reloc, /* special_function */
1244          AARCH64_R_STR (COPY),  /* name */
1245          TRUE,                  /* partial_inplace */
1246          0xffffffff,            /* src_mask */
1247          0xffffffff,            /* dst_mask */
1248          FALSE),                /* pcrel_offset */
1249
1250   HOWTO (AARCH64_R (GLOB_DAT),  /* type */
1251          0,                     /* rightshift */
1252          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1253          64,                    /* bitsize */
1254          FALSE,                 /* pc_relative */
1255          0,                     /* bitpos */
1256          complain_overflow_bitfield,    /* complain_on_overflow */
1257          bfd_elf_generic_reloc, /* special_function */
1258          AARCH64_R_STR (GLOB_DAT),      /* name */
1259          TRUE,                  /* partial_inplace */
1260          0xffffffff,            /* src_mask */
1261          0xffffffff,            /* dst_mask */
1262          FALSE),                /* pcrel_offset */
1263
1264   HOWTO (AARCH64_R (JUMP_SLOT), /* type */
1265          0,                     /* rightshift */
1266          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1267          64,                    /* bitsize */
1268          FALSE,                 /* pc_relative */
1269          0,                     /* bitpos */
1270          complain_overflow_bitfield,    /* complain_on_overflow */
1271          bfd_elf_generic_reloc, /* special_function */
1272          AARCH64_R_STR (JUMP_SLOT),     /* name */
1273          TRUE,                  /* partial_inplace */
1274          0xffffffff,            /* src_mask */
1275          0xffffffff,            /* dst_mask */
1276          FALSE),                /* pcrel_offset */
1277
1278   HOWTO (AARCH64_R (RELATIVE),  /* type */
1279          0,                     /* rightshift */
1280          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1281          64,                    /* bitsize */
1282          FALSE,                 /* pc_relative */
1283          0,                     /* bitpos */
1284          complain_overflow_bitfield,    /* complain_on_overflow */
1285          bfd_elf_generic_reloc, /* special_function */
1286          AARCH64_R_STR (RELATIVE),      /* name */
1287          TRUE,                  /* partial_inplace */
1288          ALL_ONES,              /* src_mask */
1289          ALL_ONES,              /* dst_mask */
1290          FALSE),                /* pcrel_offset */
1291
1292   HOWTO (AARCH64_R (TLS_DTPMOD),        /* type */
1293          0,                     /* rightshift */
1294          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1295          64,                    /* bitsize */
1296          FALSE,                 /* pc_relative */
1297          0,                     /* bitpos */
1298          complain_overflow_dont,        /* complain_on_overflow */
1299          bfd_elf_generic_reloc, /* special_function */
1300 #if ARCH_SIZE == 64
1301          AARCH64_R_STR (TLS_DTPMOD64),  /* name */
1302 #else
1303          AARCH64_R_STR (TLS_DTPMOD),    /* name */
1304 #endif
1305          FALSE,                 /* partial_inplace */
1306          0,                     /* src_mask */
1307          ALL_ONES,              /* dst_mask */
1308          FALSE),                /* pc_reloffset */
1309
1310   HOWTO (AARCH64_R (TLS_DTPREL),        /* type */
1311          0,                     /* rightshift */
1312          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1313          64,                    /* bitsize */
1314          FALSE,                 /* pc_relative */
1315          0,                     /* bitpos */
1316          complain_overflow_dont,        /* complain_on_overflow */
1317          bfd_elf_generic_reloc, /* special_function */
1318 #if ARCH_SIZE == 64
1319          AARCH64_R_STR (TLS_DTPREL64),  /* name */
1320 #else
1321          AARCH64_R_STR (TLS_DTPREL),    /* name */
1322 #endif
1323          FALSE,                 /* partial_inplace */
1324          0,                     /* src_mask */
1325          ALL_ONES,              /* dst_mask */
1326          FALSE),                /* pcrel_offset */
1327
1328   HOWTO (AARCH64_R (TLS_TPREL), /* type */
1329          0,                     /* rightshift */
1330          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1331          64,                    /* bitsize */
1332          FALSE,                 /* pc_relative */
1333          0,                     /* bitpos */
1334          complain_overflow_dont,        /* complain_on_overflow */
1335          bfd_elf_generic_reloc, /* special_function */
1336 #if ARCH_SIZE == 64
1337          AARCH64_R_STR (TLS_TPREL64),   /* name */
1338 #else
1339          AARCH64_R_STR (TLS_TPREL),     /* name */
1340 #endif
1341          FALSE,                 /* partial_inplace */
1342          0,                     /* src_mask */
1343          ALL_ONES,              /* dst_mask */
1344          FALSE),                /* pcrel_offset */
1345
1346   HOWTO (AARCH64_R (TLSDESC),   /* type */
1347          0,                     /* rightshift */
1348          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1349          64,                    /* bitsize */
1350          FALSE,                 /* pc_relative */
1351          0,                     /* bitpos */
1352          complain_overflow_dont,        /* complain_on_overflow */
1353          bfd_elf_generic_reloc, /* special_function */
1354          AARCH64_R_STR (TLSDESC),       /* name */
1355          FALSE,                 /* partial_inplace */
1356          0,                     /* src_mask */
1357          ALL_ONES,              /* dst_mask */
1358          FALSE),                /* pcrel_offset */
1359
1360   HOWTO (AARCH64_R (IRELATIVE), /* type */
1361          0,                     /* rightshift */
1362          2,                     /* size (0 = byte, 1 = short, 2 = long) */
1363          64,                    /* bitsize */
1364          FALSE,                 /* pc_relative */
1365          0,                     /* bitpos */
1366          complain_overflow_bitfield,    /* complain_on_overflow */
1367          bfd_elf_generic_reloc, /* special_function */
1368          AARCH64_R_STR (IRELATIVE),     /* name */
1369          FALSE,                 /* partial_inplace */
1370          0,                     /* src_mask */
1371          ALL_ONES,              /* dst_mask */
1372          FALSE),                /* pcrel_offset */
1373
1374   EMPTY_HOWTO (0),
1375 };
1376
1377 static reloc_howto_type elfNN_aarch64_howto_none =
1378   HOWTO (R_AARCH64_NONE,        /* type */
1379          0,                     /* rightshift */
1380          0,                     /* size (0 = byte, 1 = short, 2 = long) */
1381          0,                     /* bitsize */
1382          FALSE,                 /* pc_relative */
1383          0,                     /* bitpos */
1384          complain_overflow_dont,/* complain_on_overflow */
1385          bfd_elf_generic_reloc, /* special_function */
1386          "R_AARCH64_NONE",      /* name */
1387          FALSE,                 /* partial_inplace */
1388          0,                     /* src_mask */
1389          0,                     /* dst_mask */
1390          FALSE);                /* pcrel_offset */
1391
1392 /* Given HOWTO, return the bfd internal relocation enumerator.  */
1393
1394 static bfd_reloc_code_real_type
1395 elfNN_aarch64_bfd_reloc_from_howto (reloc_howto_type *howto)
1396 {
1397   const int size
1398     = (int) ARRAY_SIZE (elfNN_aarch64_howto_table);
1399   const ptrdiff_t offset
1400     = howto - elfNN_aarch64_howto_table;
1401
1402   if (offset > 0 && offset < size - 1)
1403     return BFD_RELOC_AARCH64_RELOC_START + offset;
1404
1405   if (howto == &elfNN_aarch64_howto_none)
1406     return BFD_RELOC_AARCH64_NONE;
1407
1408   return BFD_RELOC_AARCH64_RELOC_START;
1409 }
1410
1411 /* Given R_TYPE, return the bfd internal relocation enumerator.  */
1412
1413 static bfd_reloc_code_real_type
1414 elfNN_aarch64_bfd_reloc_from_type (unsigned int r_type)
1415 {
1416   static bfd_boolean initialized_p = FALSE;
1417   /* Indexed by R_TYPE, values are offsets in the howto_table.  */
1418   static unsigned int offsets[R_AARCH64_end];
1419
1420   if (initialized_p == FALSE)
1421     {
1422       unsigned int i;
1423
1424       for (i = 1; i < ARRAY_SIZE (elfNN_aarch64_howto_table) - 1; ++i)
1425         if (elfNN_aarch64_howto_table[i].type != 0)
1426           offsets[elfNN_aarch64_howto_table[i].type] = i;
1427
1428       initialized_p = TRUE;
1429     }
1430
1431   if (r_type == R_AARCH64_NONE || r_type == R_AARCH64_NULL)
1432     return BFD_RELOC_AARCH64_NONE;
1433
1434   return BFD_RELOC_AARCH64_RELOC_START + offsets[r_type];
1435 }
1436
1437 struct elf_aarch64_reloc_map
1438 {
1439   bfd_reloc_code_real_type from;
1440   bfd_reloc_code_real_type to;
1441 };
1442
1443 /* Map bfd generic reloc to AArch64-specific reloc.  */
1444 static const struct elf_aarch64_reloc_map elf_aarch64_reloc_map[] =
1445 {
1446   {BFD_RELOC_NONE, BFD_RELOC_AARCH64_NONE},
1447
1448   /* Basic data relocations.  */
1449   {BFD_RELOC_CTOR, BFD_RELOC_AARCH64_NN},
1450   {BFD_RELOC_64, BFD_RELOC_AARCH64_64},
1451   {BFD_RELOC_32, BFD_RELOC_AARCH64_32},
1452   {BFD_RELOC_16, BFD_RELOC_AARCH64_16},
1453   {BFD_RELOC_64_PCREL, BFD_RELOC_AARCH64_64_PCREL},
1454   {BFD_RELOC_32_PCREL, BFD_RELOC_AARCH64_32_PCREL},
1455   {BFD_RELOC_16_PCREL, BFD_RELOC_AARCH64_16_PCREL},
1456 };
1457
1458 /* Given the bfd internal relocation enumerator in CODE, return the
1459    corresponding howto entry.  */
1460
1461 static reloc_howto_type *
1462 elfNN_aarch64_howto_from_bfd_reloc (bfd_reloc_code_real_type code)
1463 {
1464   unsigned int i;
1465
1466   /* Convert bfd generic reloc to AArch64-specific reloc.  */
1467   if (code < BFD_RELOC_AARCH64_RELOC_START
1468       || code > BFD_RELOC_AARCH64_RELOC_END)
1469     for (i = 0; i < ARRAY_SIZE (elf_aarch64_reloc_map); i++)
1470       if (elf_aarch64_reloc_map[i].from == code)
1471         {
1472           code = elf_aarch64_reloc_map[i].to;
1473           break;
1474         }
1475
1476   if (code > BFD_RELOC_AARCH64_RELOC_START
1477       && code < BFD_RELOC_AARCH64_RELOC_END)
1478     if (elfNN_aarch64_howto_table[code - BFD_RELOC_AARCH64_RELOC_START].type)
1479       return &elfNN_aarch64_howto_table[code - BFD_RELOC_AARCH64_RELOC_START];
1480
1481   if (code == BFD_RELOC_AARCH64_NONE)
1482     return &elfNN_aarch64_howto_none;
1483
1484   return NULL;
1485 }
1486
1487 static reloc_howto_type *
1488 elfNN_aarch64_howto_from_type (unsigned int r_type)
1489 {
1490   bfd_reloc_code_real_type val;
1491   reloc_howto_type *howto;
1492
1493 #if ARCH_SIZE == 32
1494   if (r_type > 256)
1495     {
1496       bfd_set_error (bfd_error_bad_value);
1497       return NULL;
1498     }
1499 #endif
1500
1501   if (r_type == R_AARCH64_NONE)
1502     return &elfNN_aarch64_howto_none;
1503
1504   val = elfNN_aarch64_bfd_reloc_from_type (r_type);
1505   howto = elfNN_aarch64_howto_from_bfd_reloc (val);
1506
1507   if (howto != NULL)
1508     return howto;
1509
1510   bfd_set_error (bfd_error_bad_value);
1511   return NULL;
1512 }
1513
1514 static void
1515 elfNN_aarch64_info_to_howto (bfd *abfd ATTRIBUTE_UNUSED, arelent *bfd_reloc,
1516                              Elf_Internal_Rela *elf_reloc)
1517 {
1518   unsigned int r_type;
1519
1520   r_type = ELFNN_R_TYPE (elf_reloc->r_info);
1521   bfd_reloc->howto = elfNN_aarch64_howto_from_type (r_type);
1522 }
1523
1524 static reloc_howto_type *
1525 elfNN_aarch64_reloc_type_lookup (bfd *abfd ATTRIBUTE_UNUSED,
1526                                  bfd_reloc_code_real_type code)
1527 {
1528   reloc_howto_type *howto = elfNN_aarch64_howto_from_bfd_reloc (code);
1529
1530   if (howto != NULL)
1531     return howto;
1532
1533   bfd_set_error (bfd_error_bad_value);
1534   return NULL;
1535 }
1536
1537 static reloc_howto_type *
1538 elfNN_aarch64_reloc_name_lookup (bfd *abfd ATTRIBUTE_UNUSED,
1539                                  const char *r_name)
1540 {
1541   unsigned int i;
1542
1543   for (i = 1; i < ARRAY_SIZE (elfNN_aarch64_howto_table) - 1; ++i)
1544     if (elfNN_aarch64_howto_table[i].name != NULL
1545         && strcasecmp (elfNN_aarch64_howto_table[i].name, r_name) == 0)
1546       return &elfNN_aarch64_howto_table[i];
1547
1548   return NULL;
1549 }
1550
1551 #define TARGET_LITTLE_SYM               bfd_elfNN_littleaarch64_vec
1552 #define TARGET_LITTLE_NAME              "elfNN-littleaarch64"
1553 #define TARGET_BIG_SYM                  bfd_elfNN_bigaarch64_vec
1554 #define TARGET_BIG_NAME                 "elfNN-bigaarch64"
1555
1556 /* The linker script knows the section names for placement.
1557    The entry_names are used to do simple name mangling on the stubs.
1558    Given a function name, and its type, the stub can be found. The
1559    name can be changed. The only requirement is the %s be present.  */
1560 #define STUB_ENTRY_NAME   "__%s_veneer"
1561
1562 /* The name of the dynamic interpreter.  This is put in the .interp
1563    section.  */
1564 #define ELF_DYNAMIC_INTERPRETER     "/lib/ld.so.1"
1565
1566 #define AARCH64_MAX_FWD_BRANCH_OFFSET \
1567   (((1 << 25) - 1) << 2)
1568 #define AARCH64_MAX_BWD_BRANCH_OFFSET \
1569   (-((1 << 25) << 2))
1570
1571 #define AARCH64_MAX_ADRP_IMM ((1 << 20) - 1)
1572 #define AARCH64_MIN_ADRP_IMM (-(1 << 20))
1573
1574 static int
1575 aarch64_valid_for_adrp_p (bfd_vma value, bfd_vma place)
1576 {
1577   bfd_signed_vma offset = (bfd_signed_vma) (PG (value) - PG (place)) >> 12;
1578   return offset <= AARCH64_MAX_ADRP_IMM && offset >= AARCH64_MIN_ADRP_IMM;
1579 }
1580
1581 static int
1582 aarch64_valid_branch_p (bfd_vma value, bfd_vma place)
1583 {
1584   bfd_signed_vma offset = (bfd_signed_vma) (value - place);
1585   return (offset <= AARCH64_MAX_FWD_BRANCH_OFFSET
1586           && offset >= AARCH64_MAX_BWD_BRANCH_OFFSET);
1587 }
1588
1589 static const uint32_t aarch64_adrp_branch_stub [] =
1590 {
1591   0x90000010,                   /*      adrp    ip0, X */
1592                                 /*              R_AARCH64_ADR_HI21_PCREL(X) */
1593   0x91000210,                   /*      add     ip0, ip0, :lo12:X */
1594                                 /*              R_AARCH64_ADD_ABS_LO12_NC(X) */
1595   0xd61f0200,                   /*      br      ip0 */
1596 };
1597
1598 static const uint32_t aarch64_long_branch_stub[] =
1599 {
1600 #if ARCH_SIZE == 64
1601   0x58000090,                   /*      ldr   ip0, 1f */
1602 #else
1603   0x18000090,                   /*      ldr   wip0, 1f */
1604 #endif
1605   0x10000011,                   /*      adr   ip1, #0 */
1606   0x8b110210,                   /*      add   ip0, ip0, ip1 */
1607   0xd61f0200,                   /*      br      ip0 */
1608   0x00000000,                   /* 1:   .xword or .word
1609                                    R_AARCH64_PRELNN(X) + 12
1610                                  */
1611   0x00000000,
1612 };
1613
1614 /* Section name for stubs is the associated section name plus this
1615    string.  */
1616 #define STUB_SUFFIX ".stub"
1617
1618 enum elf_aarch64_stub_type
1619 {
1620   aarch64_stub_none,
1621   aarch64_stub_adrp_branch,
1622   aarch64_stub_long_branch,
1623 };
1624
1625 struct elf_aarch64_stub_hash_entry
1626 {
1627   /* Base hash table entry structure.  */
1628   struct bfd_hash_entry root;
1629
1630   /* The stub section.  */
1631   asection *stub_sec;
1632
1633   /* Offset within stub_sec of the beginning of this stub.  */
1634   bfd_vma stub_offset;
1635
1636   /* Given the symbol's value and its section we can determine its final
1637      value when building the stubs (so the stub knows where to jump).  */
1638   bfd_vma target_value;
1639   asection *target_section;
1640
1641   enum elf_aarch64_stub_type stub_type;
1642
1643   /* The symbol table entry, if any, that this was derived from.  */
1644   struct elf_aarch64_link_hash_entry *h;
1645
1646   /* Destination symbol type */
1647   unsigned char st_type;
1648
1649   /* Where this stub is being called from, or, in the case of combined
1650      stub sections, the first input section in the group.  */
1651   asection *id_sec;
1652
1653   /* The name for the local symbol at the start of this stub.  The
1654      stub name in the hash table has to be unique; this does not, so
1655      it can be friendlier.  */
1656   char *output_name;
1657 };
1658
1659 /* Used to build a map of a section.  This is required for mixed-endian
1660    code/data.  */
1661
1662 typedef struct elf_elf_section_map
1663 {
1664   bfd_vma vma;
1665   char type;
1666 }
1667 elf_aarch64_section_map;
1668
1669
1670 typedef struct _aarch64_elf_section_data
1671 {
1672   struct bfd_elf_section_data elf;
1673   unsigned int mapcount;
1674   unsigned int mapsize;
1675   elf_aarch64_section_map *map;
1676 }
1677 _aarch64_elf_section_data;
1678
1679 #define elf_aarch64_section_data(sec) \
1680   ((_aarch64_elf_section_data *) elf_section_data (sec))
1681
1682 /* The size of the thread control block which is defined to be two pointers.  */
1683 #define TCB_SIZE        (ARCH_SIZE/8)*2
1684
1685 struct elf_aarch64_local_symbol
1686 {
1687   unsigned int got_type;
1688   bfd_signed_vma got_refcount;
1689   bfd_vma got_offset;
1690
1691   /* Offset of the GOTPLT entry reserved for the TLS descriptor. The
1692      offset is from the end of the jump table and reserved entries
1693      within the PLTGOT.
1694
1695      The magic value (bfd_vma) -1 indicates that an offset has not be
1696      allocated.  */
1697   bfd_vma tlsdesc_got_jump_table_offset;
1698 };
1699
1700 struct elf_aarch64_obj_tdata
1701 {
1702   struct elf_obj_tdata root;
1703
1704   /* local symbol descriptors */
1705   struct elf_aarch64_local_symbol *locals;
1706
1707   /* Zero to warn when linking objects with incompatible enum sizes.  */
1708   int no_enum_size_warning;
1709
1710   /* Zero to warn when linking objects with incompatible wchar_t sizes.  */
1711   int no_wchar_size_warning;
1712 };
1713
1714 #define elf_aarch64_tdata(bfd)                          \
1715   ((struct elf_aarch64_obj_tdata *) (bfd)->tdata.any)
1716
1717 #define elf_aarch64_locals(bfd) (elf_aarch64_tdata (bfd)->locals)
1718
1719 #define is_aarch64_elf(bfd)                             \
1720   (bfd_get_flavour (bfd) == bfd_target_elf_flavour      \
1721    && elf_tdata (bfd) != NULL                           \
1722    && elf_object_id (bfd) == AARCH64_ELF_DATA)
1723
1724 static bfd_boolean
1725 elfNN_aarch64_mkobject (bfd *abfd)
1726 {
1727   return bfd_elf_allocate_object (abfd, sizeof (struct elf_aarch64_obj_tdata),
1728                                   AARCH64_ELF_DATA);
1729 }
1730
1731 #define elf_aarch64_hash_entry(ent) \
1732   ((struct elf_aarch64_link_hash_entry *)(ent))
1733
1734 #define GOT_UNKNOWN    0
1735 #define GOT_NORMAL     1
1736 #define GOT_TLS_GD     2
1737 #define GOT_TLS_IE     4
1738 #define GOT_TLSDESC_GD 8
1739
1740 #define GOT_TLS_GD_ANY_P(type)  ((type & GOT_TLS_GD) || (type & GOT_TLSDESC_GD))
1741
1742 /* AArch64 ELF linker hash entry.  */
1743 struct elf_aarch64_link_hash_entry
1744 {
1745   struct elf_link_hash_entry root;
1746
1747   /* Track dynamic relocs copied for this symbol.  */
1748   struct elf_dyn_relocs *dyn_relocs;
1749
1750   /* Since PLT entries have variable size, we need to record the
1751      index into .got.plt instead of recomputing it from the PLT
1752      offset.  */
1753   bfd_signed_vma plt_got_offset;
1754
1755   /* Bit mask representing the type of GOT entry(s) if any required by
1756      this symbol.  */
1757   unsigned int got_type;
1758
1759   /* A pointer to the most recently used stub hash entry against this
1760      symbol.  */
1761   struct elf_aarch64_stub_hash_entry *stub_cache;
1762
1763   /* Offset of the GOTPLT entry reserved for the TLS descriptor.  The offset
1764      is from the end of the jump table and reserved entries within the PLTGOT.
1765
1766      The magic value (bfd_vma) -1 indicates that an offset has not
1767      be allocated.  */
1768   bfd_vma tlsdesc_got_jump_table_offset;
1769 };
1770
1771 static unsigned int
1772 elfNN_aarch64_symbol_got_type (struct elf_link_hash_entry *h,
1773                                bfd *abfd,
1774                                unsigned long r_symndx)
1775 {
1776   if (h)
1777     return elf_aarch64_hash_entry (h)->got_type;
1778
1779   if (! elf_aarch64_locals (abfd))
1780     return GOT_UNKNOWN;
1781
1782   return elf_aarch64_locals (abfd)[r_symndx].got_type;
1783 }
1784
1785 /* Get the AArch64 elf linker hash table from a link_info structure.  */
1786 #define elf_aarch64_hash_table(info)                                    \
1787   ((struct elf_aarch64_link_hash_table *) ((info)->hash))
1788
1789 #define aarch64_stub_hash_lookup(table, string, create, copy)           \
1790   ((struct elf_aarch64_stub_hash_entry *)                               \
1791    bfd_hash_lookup ((table), (string), (create), (copy)))
1792
1793 /* AArch64 ELF linker hash table.  */
1794 struct elf_aarch64_link_hash_table
1795 {
1796   /* The main hash table.  */
1797   struct elf_link_hash_table root;
1798
1799   /* Nonzero to force PIC branch veneers.  */
1800   int pic_veneer;
1801
1802   /* The number of bytes in the initial entry in the PLT.  */
1803   bfd_size_type plt_header_size;
1804
1805   /* The number of bytes in the subsequent PLT etries.  */
1806   bfd_size_type plt_entry_size;
1807
1808   /* Short-cuts to get to dynamic linker sections.  */
1809   asection *sdynbss;
1810   asection *srelbss;
1811
1812   /* Small local sym cache.  */
1813   struct sym_cache sym_cache;
1814
1815   /* For convenience in allocate_dynrelocs.  */
1816   bfd *obfd;
1817
1818   /* The amount of space used by the reserved portion of the sgotplt
1819      section, plus whatever space is used by the jump slots.  */
1820   bfd_vma sgotplt_jump_table_size;
1821
1822   /* The stub hash table.  */
1823   struct bfd_hash_table stub_hash_table;
1824
1825   /* Linker stub bfd.  */
1826   bfd *stub_bfd;
1827
1828   /* Linker call-backs.  */
1829   asection *(*add_stub_section) (const char *, asection *);
1830   void (*layout_sections_again) (void);
1831
1832   /* Array to keep track of which stub sections have been created, and
1833      information on stub grouping.  */
1834   struct map_stub
1835   {
1836     /* This is the section to which stubs in the group will be
1837        attached.  */
1838     asection *link_sec;
1839     /* The stub section.  */
1840     asection *stub_sec;
1841   } *stub_group;
1842
1843   /* Assorted information used by elfNN_aarch64_size_stubs.  */
1844   unsigned int bfd_count;
1845   int top_index;
1846   asection **input_list;
1847
1848   /* The offset into splt of the PLT entry for the TLS descriptor
1849      resolver.  Special values are 0, if not necessary (or not found
1850      to be necessary yet), and -1 if needed but not determined
1851      yet.  */
1852   bfd_vma tlsdesc_plt;
1853
1854   /* The GOT offset for the lazy trampoline.  Communicated to the
1855      loader via DT_TLSDESC_GOT.  The magic value (bfd_vma) -1
1856      indicates an offset is not allocated.  */
1857   bfd_vma dt_tlsdesc_got;
1858
1859   /* Used by local STT_GNU_IFUNC symbols.  */
1860   htab_t loc_hash_table;
1861   void * loc_hash_memory;
1862 };
1863
1864 /* Create an entry in an AArch64 ELF linker hash table.  */
1865
1866 static struct bfd_hash_entry *
1867 elfNN_aarch64_link_hash_newfunc (struct bfd_hash_entry *entry,
1868                                  struct bfd_hash_table *table,
1869                                  const char *string)
1870 {
1871   struct elf_aarch64_link_hash_entry *ret =
1872     (struct elf_aarch64_link_hash_entry *) entry;
1873
1874   /* Allocate the structure if it has not already been allocated by a
1875      subclass.  */
1876   if (ret == NULL)
1877     ret = bfd_hash_allocate (table,
1878                              sizeof (struct elf_aarch64_link_hash_entry));
1879   if (ret == NULL)
1880     return (struct bfd_hash_entry *) ret;
1881
1882   /* Call the allocation method of the superclass.  */
1883   ret = ((struct elf_aarch64_link_hash_entry *)
1884          _bfd_elf_link_hash_newfunc ((struct bfd_hash_entry *) ret,
1885                                      table, string));
1886   if (ret != NULL)
1887     {
1888       ret->dyn_relocs = NULL;
1889       ret->got_type = GOT_UNKNOWN;
1890       ret->plt_got_offset = (bfd_vma) - 1;
1891       ret->stub_cache = NULL;
1892       ret->tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
1893     }
1894
1895   return (struct bfd_hash_entry *) ret;
1896 }
1897
1898 /* Initialize an entry in the stub hash table.  */
1899
1900 static struct bfd_hash_entry *
1901 stub_hash_newfunc (struct bfd_hash_entry *entry,
1902                    struct bfd_hash_table *table, const char *string)
1903 {
1904   /* Allocate the structure if it has not already been allocated by a
1905      subclass.  */
1906   if (entry == NULL)
1907     {
1908       entry = bfd_hash_allocate (table,
1909                                  sizeof (struct
1910                                          elf_aarch64_stub_hash_entry));
1911       if (entry == NULL)
1912         return entry;
1913     }
1914
1915   /* Call the allocation method of the superclass.  */
1916   entry = bfd_hash_newfunc (entry, table, string);
1917   if (entry != NULL)
1918     {
1919       struct elf_aarch64_stub_hash_entry *eh;
1920
1921       /* Initialize the local fields.  */
1922       eh = (struct elf_aarch64_stub_hash_entry *) entry;
1923       eh->stub_sec = NULL;
1924       eh->stub_offset = 0;
1925       eh->target_value = 0;
1926       eh->target_section = NULL;
1927       eh->stub_type = aarch64_stub_none;
1928       eh->h = NULL;
1929       eh->id_sec = NULL;
1930     }
1931
1932   return entry;
1933 }
1934
1935 /* Compute a hash of a local hash entry.  We use elf_link_hash_entry
1936   for local symbol so that we can handle local STT_GNU_IFUNC symbols
1937   as global symbol.  We reuse indx and dynstr_index for local symbol
1938   hash since they aren't used by global symbols in this backend.  */
1939
1940 static hashval_t
1941 elfNN_aarch64_local_htab_hash (const void *ptr)
1942 {
1943   struct elf_link_hash_entry *h
1944     = (struct elf_link_hash_entry *) ptr;
1945   return ELF_LOCAL_SYMBOL_HASH (h->indx, h->dynstr_index);
1946 }
1947
1948 /* Compare local hash entries.  */
1949
1950 static int
1951 elfNN_aarch64_local_htab_eq (const void *ptr1, const void *ptr2)
1952 {
1953   struct elf_link_hash_entry *h1
1954      = (struct elf_link_hash_entry *) ptr1;
1955   struct elf_link_hash_entry *h2
1956     = (struct elf_link_hash_entry *) ptr2;
1957
1958   return h1->indx == h2->indx && h1->dynstr_index == h2->dynstr_index;
1959 }
1960
1961 /* Find and/or create a hash entry for local symbol.  */
1962
1963 static struct elf_link_hash_entry *
1964 elfNN_aarch64_get_local_sym_hash (struct elf_aarch64_link_hash_table *htab,
1965                                   bfd *abfd, const Elf_Internal_Rela *rel,
1966                                   bfd_boolean create)
1967 {
1968   struct elf_aarch64_link_hash_entry e, *ret;
1969   asection *sec = abfd->sections;
1970   hashval_t h = ELF_LOCAL_SYMBOL_HASH (sec->id,
1971                                        ELFNN_R_SYM (rel->r_info));
1972   void **slot;
1973
1974   e.root.indx = sec->id;
1975   e.root.dynstr_index = ELFNN_R_SYM (rel->r_info);
1976   slot = htab_find_slot_with_hash (htab->loc_hash_table, &e, h,
1977                                    create ? INSERT : NO_INSERT);
1978
1979   if (!slot)
1980     return NULL;
1981
1982   if (*slot)
1983     {
1984       ret = (struct elf_aarch64_link_hash_entry *) *slot;
1985       return &ret->root;
1986     }
1987
1988   ret = (struct elf_aarch64_link_hash_entry *)
1989         objalloc_alloc ((struct objalloc *) htab->loc_hash_memory,
1990                         sizeof (struct elf_aarch64_link_hash_entry));
1991   if (ret)
1992     {
1993       memset (ret, 0, sizeof (*ret));
1994       ret->root.indx = sec->id;
1995       ret->root.dynstr_index = ELFNN_R_SYM (rel->r_info);
1996       ret->root.dynindx = -1;
1997       *slot = ret;
1998     }
1999   return &ret->root;
2000 }
2001
2002 /* Copy the extra info we tack onto an elf_link_hash_entry.  */
2003
2004 static void
2005 elfNN_aarch64_copy_indirect_symbol (struct bfd_link_info *info,
2006                                     struct elf_link_hash_entry *dir,
2007                                     struct elf_link_hash_entry *ind)
2008 {
2009   struct elf_aarch64_link_hash_entry *edir, *eind;
2010
2011   edir = (struct elf_aarch64_link_hash_entry *) dir;
2012   eind = (struct elf_aarch64_link_hash_entry *) ind;
2013
2014   if (eind->dyn_relocs != NULL)
2015     {
2016       if (edir->dyn_relocs != NULL)
2017         {
2018           struct elf_dyn_relocs **pp;
2019           struct elf_dyn_relocs *p;
2020
2021           /* Add reloc counts against the indirect sym to the direct sym
2022              list.  Merge any entries against the same section.  */
2023           for (pp = &eind->dyn_relocs; (p = *pp) != NULL;)
2024             {
2025               struct elf_dyn_relocs *q;
2026
2027               for (q = edir->dyn_relocs; q != NULL; q = q->next)
2028                 if (q->sec == p->sec)
2029                   {
2030                     q->pc_count += p->pc_count;
2031                     q->count += p->count;
2032                     *pp = p->next;
2033                     break;
2034                   }
2035               if (q == NULL)
2036                 pp = &p->next;
2037             }
2038           *pp = edir->dyn_relocs;
2039         }
2040
2041       edir->dyn_relocs = eind->dyn_relocs;
2042       eind->dyn_relocs = NULL;
2043     }
2044
2045   if (ind->root.type == bfd_link_hash_indirect)
2046     {
2047       /* Copy over PLT info.  */
2048       if (dir->got.refcount <= 0)
2049         {
2050           edir->got_type = eind->got_type;
2051           eind->got_type = GOT_UNKNOWN;
2052         }
2053     }
2054
2055   _bfd_elf_link_hash_copy_indirect (info, dir, ind);
2056 }
2057
2058 /* Create an AArch64 elf linker hash table.  */
2059
2060 static struct bfd_link_hash_table *
2061 elfNN_aarch64_link_hash_table_create (bfd *abfd)
2062 {
2063   struct elf_aarch64_link_hash_table *ret;
2064   bfd_size_type amt = sizeof (struct elf_aarch64_link_hash_table);
2065
2066   ret = bfd_zmalloc (amt);
2067   if (ret == NULL)
2068     return NULL;
2069
2070   if (!_bfd_elf_link_hash_table_init
2071       (&ret->root, abfd, elfNN_aarch64_link_hash_newfunc,
2072        sizeof (struct elf_aarch64_link_hash_entry), AARCH64_ELF_DATA))
2073     {
2074       free (ret);
2075       return NULL;
2076     }
2077
2078   ret->plt_header_size = PLT_ENTRY_SIZE;
2079   ret->plt_entry_size = PLT_SMALL_ENTRY_SIZE;
2080   ret->obfd = abfd;
2081   ret->dt_tlsdesc_got = (bfd_vma) - 1;
2082
2083   if (!bfd_hash_table_init (&ret->stub_hash_table, stub_hash_newfunc,
2084                             sizeof (struct elf_aarch64_stub_hash_entry)))
2085     {
2086       free (ret);
2087       return NULL;
2088     }
2089
2090   ret->loc_hash_table = htab_try_create (1024,
2091                                          elfNN_aarch64_local_htab_hash,
2092                                          elfNN_aarch64_local_htab_eq,
2093                                          NULL);
2094   ret->loc_hash_memory = objalloc_create ();
2095   if (!ret->loc_hash_table || !ret->loc_hash_memory)
2096     {
2097       free (ret);
2098       return NULL;
2099     }
2100
2101   return &ret->root.root;
2102 }
2103
2104 /* Free the derived linker hash table.  */
2105
2106 static void
2107 elfNN_aarch64_hash_table_free (struct bfd_link_hash_table *hash)
2108 {
2109   struct elf_aarch64_link_hash_table *ret
2110     = (struct elf_aarch64_link_hash_table *) hash;
2111
2112   if (ret->loc_hash_table)
2113     htab_delete (ret->loc_hash_table);
2114   if (ret->loc_hash_memory)
2115     objalloc_free ((struct objalloc *) ret->loc_hash_memory);
2116
2117   bfd_hash_table_free (&ret->stub_hash_table);
2118   _bfd_elf_link_hash_table_free (hash);
2119 }
2120
2121 static bfd_boolean
2122 aarch64_relocate (unsigned int r_type, bfd *input_bfd, asection *input_section,
2123                   bfd_vma offset, bfd_vma value)
2124 {
2125   reloc_howto_type *howto;
2126   bfd_vma place;
2127
2128   howto = elfNN_aarch64_howto_from_type (r_type);
2129   place = (input_section->output_section->vma + input_section->output_offset
2130            + offset);
2131
2132   r_type = elfNN_aarch64_bfd_reloc_from_type (r_type);
2133   value = _bfd_aarch64_elf_resolve_relocation (r_type, place, value, 0, FALSE);
2134   return _bfd_aarch64_elf_put_addend (input_bfd,
2135                                       input_section->contents + offset, r_type,
2136                                       howto, value);
2137 }
2138
2139 static enum elf_aarch64_stub_type
2140 aarch64_select_branch_stub (bfd_vma value, bfd_vma place)
2141 {
2142   if (aarch64_valid_for_adrp_p (value, place))
2143     return aarch64_stub_adrp_branch;
2144   return aarch64_stub_long_branch;
2145 }
2146
2147 /* Determine the type of stub needed, if any, for a call.  */
2148
2149 static enum elf_aarch64_stub_type
2150 aarch64_type_of_stub (struct bfd_link_info *info,
2151                       asection *input_sec,
2152                       const Elf_Internal_Rela *rel,
2153                       unsigned char st_type,
2154                       struct elf_aarch64_link_hash_entry *hash,
2155                       bfd_vma destination)
2156 {
2157   bfd_vma location;
2158   bfd_signed_vma branch_offset;
2159   unsigned int r_type;
2160   struct elf_aarch64_link_hash_table *globals;
2161   enum elf_aarch64_stub_type stub_type = aarch64_stub_none;
2162   bfd_boolean via_plt_p;
2163
2164   if (st_type != STT_FUNC)
2165     return stub_type;
2166
2167   globals = elf_aarch64_hash_table (info);
2168   via_plt_p = (globals->root.splt != NULL && hash != NULL
2169                && hash->root.plt.offset != (bfd_vma) - 1);
2170
2171   if (via_plt_p)
2172     return stub_type;
2173
2174   /* Determine where the call point is.  */
2175   location = (input_sec->output_offset
2176               + input_sec->output_section->vma + rel->r_offset);
2177
2178   branch_offset = (bfd_signed_vma) (destination - location);
2179
2180   r_type = ELFNN_R_TYPE (rel->r_info);
2181
2182   /* We don't want to redirect any old unconditional jump in this way,
2183      only one which is being used for a sibcall, where it is
2184      acceptable for the IP0 and IP1 registers to be clobbered.  */
2185   if ((r_type == AARCH64_R (CALL26) || r_type == AARCH64_R (JUMP26))
2186       && (branch_offset > AARCH64_MAX_FWD_BRANCH_OFFSET
2187           || branch_offset < AARCH64_MAX_BWD_BRANCH_OFFSET))
2188     {
2189       stub_type = aarch64_stub_long_branch;
2190     }
2191
2192   return stub_type;
2193 }
2194
2195 /* Build a name for an entry in the stub hash table.  */
2196
2197 static char *
2198 elfNN_aarch64_stub_name (const asection *input_section,
2199                          const asection *sym_sec,
2200                          const struct elf_aarch64_link_hash_entry *hash,
2201                          const Elf_Internal_Rela *rel)
2202 {
2203   char *stub_name;
2204   bfd_size_type len;
2205
2206   if (hash)
2207     {
2208       len = 8 + 1 + strlen (hash->root.root.root.string) + 1 + 16 + 1;
2209       stub_name = bfd_malloc (len);
2210       if (stub_name != NULL)
2211         snprintf (stub_name, len, "%08x_%s+%" BFD_VMA_FMT "x",
2212                   (unsigned int) input_section->id,
2213                   hash->root.root.root.string,
2214                   rel->r_addend);
2215     }
2216   else
2217     {
2218       len = 8 + 1 + 8 + 1 + 8 + 1 + 16 + 1;
2219       stub_name = bfd_malloc (len);
2220       if (stub_name != NULL)
2221         snprintf (stub_name, len, "%08x_%x:%x+%" BFD_VMA_FMT "x",
2222                   (unsigned int) input_section->id,
2223                   (unsigned int) sym_sec->id,
2224                   (unsigned int) ELFNN_R_SYM (rel->r_info),
2225                   rel->r_addend);
2226     }
2227
2228   return stub_name;
2229 }
2230
2231 /* Look up an entry in the stub hash.  Stub entries are cached because
2232    creating the stub name takes a bit of time.  */
2233
2234 static struct elf_aarch64_stub_hash_entry *
2235 elfNN_aarch64_get_stub_entry (const asection *input_section,
2236                               const asection *sym_sec,
2237                               struct elf_link_hash_entry *hash,
2238                               const Elf_Internal_Rela *rel,
2239                               struct elf_aarch64_link_hash_table *htab)
2240 {
2241   struct elf_aarch64_stub_hash_entry *stub_entry;
2242   struct elf_aarch64_link_hash_entry *h =
2243     (struct elf_aarch64_link_hash_entry *) hash;
2244   const asection *id_sec;
2245
2246   if ((input_section->flags & SEC_CODE) == 0)
2247     return NULL;
2248
2249   /* If this input section is part of a group of sections sharing one
2250      stub section, then use the id of the first section in the group.
2251      Stub names need to include a section id, as there may well be
2252      more than one stub used to reach say, printf, and we need to
2253      distinguish between them.  */
2254   id_sec = htab->stub_group[input_section->id].link_sec;
2255
2256   if (h != NULL && h->stub_cache != NULL
2257       && h->stub_cache->h == h && h->stub_cache->id_sec == id_sec)
2258     {
2259       stub_entry = h->stub_cache;
2260     }
2261   else
2262     {
2263       char *stub_name;
2264
2265       stub_name = elfNN_aarch64_stub_name (id_sec, sym_sec, h, rel);
2266       if (stub_name == NULL)
2267         return NULL;
2268
2269       stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table,
2270                                              stub_name, FALSE, FALSE);
2271       if (h != NULL)
2272         h->stub_cache = stub_entry;
2273
2274       free (stub_name);
2275     }
2276
2277   return stub_entry;
2278 }
2279
2280 /* Add a new stub entry to the stub hash.  Not all fields of the new
2281    stub entry are initialised.  */
2282
2283 static struct elf_aarch64_stub_hash_entry *
2284 elfNN_aarch64_add_stub (const char *stub_name,
2285                         asection *section,
2286                         struct elf_aarch64_link_hash_table *htab)
2287 {
2288   asection *link_sec;
2289   asection *stub_sec;
2290   struct elf_aarch64_stub_hash_entry *stub_entry;
2291
2292   link_sec = htab->stub_group[section->id].link_sec;
2293   stub_sec = htab->stub_group[section->id].stub_sec;
2294   if (stub_sec == NULL)
2295     {
2296       stub_sec = htab->stub_group[link_sec->id].stub_sec;
2297       if (stub_sec == NULL)
2298         {
2299           size_t namelen;
2300           bfd_size_type len;
2301           char *s_name;
2302
2303           namelen = strlen (link_sec->name);
2304           len = namelen + sizeof (STUB_SUFFIX);
2305           s_name = bfd_alloc (htab->stub_bfd, len);
2306           if (s_name == NULL)
2307             return NULL;
2308
2309           memcpy (s_name, link_sec->name, namelen);
2310           memcpy (s_name + namelen, STUB_SUFFIX, sizeof (STUB_SUFFIX));
2311           stub_sec = (*htab->add_stub_section) (s_name, link_sec);
2312           if (stub_sec == NULL)
2313             return NULL;
2314           htab->stub_group[link_sec->id].stub_sec = stub_sec;
2315         }
2316       htab->stub_group[section->id].stub_sec = stub_sec;
2317     }
2318
2319   /* Enter this entry into the linker stub hash table.  */
2320   stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table, stub_name,
2321                                          TRUE, FALSE);
2322   if (stub_entry == NULL)
2323     {
2324       (*_bfd_error_handler) (_("%s: cannot create stub entry %s"),
2325                              section->owner, stub_name);
2326       return NULL;
2327     }
2328
2329   stub_entry->stub_sec = stub_sec;
2330   stub_entry->stub_offset = 0;
2331   stub_entry->id_sec = link_sec;
2332
2333   return stub_entry;
2334 }
2335
2336 static bfd_boolean
2337 aarch64_build_one_stub (struct bfd_hash_entry *gen_entry,
2338                         void *in_arg ATTRIBUTE_UNUSED)
2339 {
2340   struct elf_aarch64_stub_hash_entry *stub_entry;
2341   asection *stub_sec;
2342   bfd *stub_bfd;
2343   bfd_byte *loc;
2344   bfd_vma sym_value;
2345   unsigned int template_size;
2346   const uint32_t *template;
2347   unsigned int i;
2348
2349   /* Massage our args to the form they really have.  */
2350   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
2351
2352   stub_sec = stub_entry->stub_sec;
2353
2354   /* Make a note of the offset within the stubs for this entry.  */
2355   stub_entry->stub_offset = stub_sec->size;
2356   loc = stub_sec->contents + stub_entry->stub_offset;
2357
2358   stub_bfd = stub_sec->owner;
2359
2360   /* This is the address of the stub destination.  */
2361   sym_value = (stub_entry->target_value
2362                + stub_entry->target_section->output_offset
2363                + stub_entry->target_section->output_section->vma);
2364
2365   if (stub_entry->stub_type == aarch64_stub_long_branch)
2366     {
2367       bfd_vma place = (stub_entry->stub_offset + stub_sec->output_section->vma
2368                        + stub_sec->output_offset);
2369
2370       /* See if we can relax the stub.  */
2371       if (aarch64_valid_for_adrp_p (sym_value, place))
2372         stub_entry->stub_type = aarch64_select_branch_stub (sym_value, place);
2373     }
2374
2375   switch (stub_entry->stub_type)
2376     {
2377     case aarch64_stub_adrp_branch:
2378       template = aarch64_adrp_branch_stub;
2379       template_size = sizeof (aarch64_adrp_branch_stub);
2380       break;
2381     case aarch64_stub_long_branch:
2382       template = aarch64_long_branch_stub;
2383       template_size = sizeof (aarch64_long_branch_stub);
2384       break;
2385     default:
2386       BFD_FAIL ();
2387       return FALSE;
2388     }
2389
2390   for (i = 0; i < (template_size / sizeof template[0]); i++)
2391     {
2392       bfd_putl32 (template[i], loc);
2393       loc += 4;
2394     }
2395
2396   template_size = (template_size + 7) & ~7;
2397   stub_sec->size += template_size;
2398
2399   switch (stub_entry->stub_type)
2400     {
2401     case aarch64_stub_adrp_branch:
2402       if (aarch64_relocate (AARCH64_R (ADR_PREL_PG_HI21), stub_bfd, stub_sec,
2403                             stub_entry->stub_offset, sym_value))
2404         /* The stub would not have been relaxed if the offset was out
2405            of range.  */
2406         BFD_FAIL ();
2407
2408       _bfd_final_link_relocate
2409         (elfNN_aarch64_howto_from_type (AARCH64_R (ADD_ABS_LO12_NC)),
2410          stub_bfd,
2411          stub_sec,
2412          stub_sec->contents,
2413          stub_entry->stub_offset + 4,
2414          sym_value,
2415          0);
2416       break;
2417
2418     case aarch64_stub_long_branch:
2419       /* We want the value relative to the address 12 bytes back from the
2420          value itself.  */
2421       _bfd_final_link_relocate (elfNN_aarch64_howto_from_type
2422                                 (AARCH64_R (PRELNN)), stub_bfd, stub_sec,
2423                                 stub_sec->contents,
2424                                 stub_entry->stub_offset + 16,
2425                                 sym_value + 12, 0);
2426       break;
2427     default:
2428       break;
2429     }
2430
2431   return TRUE;
2432 }
2433
2434 /* As above, but don't actually build the stub.  Just bump offset so
2435    we know stub section sizes.  */
2436
2437 static bfd_boolean
2438 aarch64_size_one_stub (struct bfd_hash_entry *gen_entry,
2439                        void *in_arg ATTRIBUTE_UNUSED)
2440 {
2441   struct elf_aarch64_stub_hash_entry *stub_entry;
2442   int size;
2443
2444   /* Massage our args to the form they really have.  */
2445   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
2446
2447   switch (stub_entry->stub_type)
2448     {
2449     case aarch64_stub_adrp_branch:
2450       size = sizeof (aarch64_adrp_branch_stub);
2451       break;
2452     case aarch64_stub_long_branch:
2453       size = sizeof (aarch64_long_branch_stub);
2454       break;
2455     default:
2456       BFD_FAIL ();
2457       return FALSE;
2458       break;
2459     }
2460
2461   size = (size + 7) & ~7;
2462   stub_entry->stub_sec->size += size;
2463   return TRUE;
2464 }
2465
2466 /* External entry points for sizing and building linker stubs.  */
2467
2468 /* Set up various things so that we can make a list of input sections
2469    for each output section included in the link.  Returns -1 on error,
2470    0 when no stubs will be needed, and 1 on success.  */
2471
2472 int
2473 elfNN_aarch64_setup_section_lists (bfd *output_bfd,
2474                                    struct bfd_link_info *info)
2475 {
2476   bfd *input_bfd;
2477   unsigned int bfd_count;
2478   int top_id, top_index;
2479   asection *section;
2480   asection **input_list, **list;
2481   bfd_size_type amt;
2482   struct elf_aarch64_link_hash_table *htab =
2483     elf_aarch64_hash_table (info);
2484
2485   if (!is_elf_hash_table (htab))
2486     return 0;
2487
2488   /* Count the number of input BFDs and find the top input section id.  */
2489   for (input_bfd = info->input_bfds, bfd_count = 0, top_id = 0;
2490        input_bfd != NULL; input_bfd = input_bfd->link_next)
2491     {
2492       bfd_count += 1;
2493       for (section = input_bfd->sections;
2494            section != NULL; section = section->next)
2495         {
2496           if (top_id < section->id)
2497             top_id = section->id;
2498         }
2499     }
2500   htab->bfd_count = bfd_count;
2501
2502   amt = sizeof (struct map_stub) * (top_id + 1);
2503   htab->stub_group = bfd_zmalloc (amt);
2504   if (htab->stub_group == NULL)
2505     return -1;
2506
2507   /* We can't use output_bfd->section_count here to find the top output
2508      section index as some sections may have been removed, and
2509      _bfd_strip_section_from_output doesn't renumber the indices.  */
2510   for (section = output_bfd->sections, top_index = 0;
2511        section != NULL; section = section->next)
2512     {
2513       if (top_index < section->index)
2514         top_index = section->index;
2515     }
2516
2517   htab->top_index = top_index;
2518   amt = sizeof (asection *) * (top_index + 1);
2519   input_list = bfd_malloc (amt);
2520   htab->input_list = input_list;
2521   if (input_list == NULL)
2522     return -1;
2523
2524   /* For sections we aren't interested in, mark their entries with a
2525      value we can check later.  */
2526   list = input_list + top_index;
2527   do
2528     *list = bfd_abs_section_ptr;
2529   while (list-- != input_list);
2530
2531   for (section = output_bfd->sections;
2532        section != NULL; section = section->next)
2533     {
2534       if ((section->flags & SEC_CODE) != 0)
2535         input_list[section->index] = NULL;
2536     }
2537
2538   return 1;
2539 }
2540
2541 /* Used by elfNN_aarch64_next_input_section and group_sections.  */
2542 #define PREV_SEC(sec) (htab->stub_group[(sec)->id].link_sec)
2543
2544 /* The linker repeatedly calls this function for each input section,
2545    in the order that input sections are linked into output sections.
2546    Build lists of input sections to determine groupings between which
2547    we may insert linker stubs.  */
2548
2549 void
2550 elfNN_aarch64_next_input_section (struct bfd_link_info *info, asection *isec)
2551 {
2552   struct elf_aarch64_link_hash_table *htab =
2553     elf_aarch64_hash_table (info);
2554
2555   if (isec->output_section->index <= htab->top_index)
2556     {
2557       asection **list = htab->input_list + isec->output_section->index;
2558
2559       if (*list != bfd_abs_section_ptr)
2560         {
2561           /* Steal the link_sec pointer for our list.  */
2562           /* This happens to make the list in reverse order,
2563              which is what we want.  */
2564           PREV_SEC (isec) = *list;
2565           *list = isec;
2566         }
2567     }
2568 }
2569
2570 /* See whether we can group stub sections together.  Grouping stub
2571    sections may result in fewer stubs.  More importantly, we need to
2572    put all .init* and .fini* stubs at the beginning of the .init or
2573    .fini output sections respectively, because glibc splits the
2574    _init and _fini functions into multiple parts.  Putting a stub in
2575    the middle of a function is not a good idea.  */
2576
2577 static void
2578 group_sections (struct elf_aarch64_link_hash_table *htab,
2579                 bfd_size_type stub_group_size,
2580                 bfd_boolean stubs_always_before_branch)
2581 {
2582   asection **list = htab->input_list + htab->top_index;
2583
2584   do
2585     {
2586       asection *tail = *list;
2587
2588       if (tail == bfd_abs_section_ptr)
2589         continue;
2590
2591       while (tail != NULL)
2592         {
2593           asection *curr;
2594           asection *prev;
2595           bfd_size_type total;
2596
2597           curr = tail;
2598           total = tail->size;
2599           while ((prev = PREV_SEC (curr)) != NULL
2600                  && ((total += curr->output_offset - prev->output_offset)
2601                      < stub_group_size))
2602             curr = prev;
2603
2604           /* OK, the size from the start of CURR to the end is less
2605              than stub_group_size and thus can be handled by one stub
2606              section.  (Or the tail section is itself larger than
2607              stub_group_size, in which case we may be toast.)
2608              We should really be keeping track of the total size of
2609              stubs added here, as stubs contribute to the final output
2610              section size.  */
2611           do
2612             {
2613               prev = PREV_SEC (tail);
2614               /* Set up this stub group.  */
2615               htab->stub_group[tail->id].link_sec = curr;
2616             }
2617           while (tail != curr && (tail = prev) != NULL);
2618
2619           /* But wait, there's more!  Input sections up to stub_group_size
2620              bytes before the stub section can be handled by it too.  */
2621           if (!stubs_always_before_branch)
2622             {
2623               total = 0;
2624               while (prev != NULL
2625                      && ((total += tail->output_offset - prev->output_offset)
2626                          < stub_group_size))
2627                 {
2628                   tail = prev;
2629                   prev = PREV_SEC (tail);
2630                   htab->stub_group[tail->id].link_sec = curr;
2631                 }
2632             }
2633           tail = prev;
2634         }
2635     }
2636   while (list-- != htab->input_list);
2637
2638   free (htab->input_list);
2639 }
2640
2641 #undef PREV_SEC
2642
2643 /* Determine and set the size of the stub section for a final link.
2644
2645    The basic idea here is to examine all the relocations looking for
2646    PC-relative calls to a target that is unreachable with a "bl"
2647    instruction.  */
2648
2649 bfd_boolean
2650 elfNN_aarch64_size_stubs (bfd *output_bfd,
2651                           bfd *stub_bfd,
2652                           struct bfd_link_info *info,
2653                           bfd_signed_vma group_size,
2654                           asection * (*add_stub_section) (const char *,
2655                                                           asection *),
2656                           void (*layout_sections_again) (void))
2657 {
2658   bfd_size_type stub_group_size;
2659   bfd_boolean stubs_always_before_branch;
2660   bfd_boolean stub_changed = 0;
2661   struct elf_aarch64_link_hash_table *htab = elf_aarch64_hash_table (info);
2662
2663   /* Propagate mach to stub bfd, because it may not have been
2664      finalized when we created stub_bfd.  */
2665   bfd_set_arch_mach (stub_bfd, bfd_get_arch (output_bfd),
2666                      bfd_get_mach (output_bfd));
2667
2668   /* Stash our params away.  */
2669   htab->stub_bfd = stub_bfd;
2670   htab->add_stub_section = add_stub_section;
2671   htab->layout_sections_again = layout_sections_again;
2672   stubs_always_before_branch = group_size < 0;
2673   if (group_size < 0)
2674     stub_group_size = -group_size;
2675   else
2676     stub_group_size = group_size;
2677
2678   if (stub_group_size == 1)
2679     {
2680       /* Default values.  */
2681       /* AArch64 branch range is +-128MB. The value used is 1MB less.  */
2682       stub_group_size = 127 * 1024 * 1024;
2683     }
2684
2685   group_sections (htab, stub_group_size, stubs_always_before_branch);
2686
2687   while (1)
2688     {
2689       bfd *input_bfd;
2690       unsigned int bfd_indx;
2691       asection *stub_sec;
2692
2693       for (input_bfd = info->input_bfds, bfd_indx = 0;
2694            input_bfd != NULL; input_bfd = input_bfd->link_next, bfd_indx++)
2695         {
2696           Elf_Internal_Shdr *symtab_hdr;
2697           asection *section;
2698           Elf_Internal_Sym *local_syms = NULL;
2699
2700           /* We'll need the symbol table in a second.  */
2701           symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
2702           if (symtab_hdr->sh_info == 0)
2703             continue;
2704
2705           /* Walk over each section attached to the input bfd.  */
2706           for (section = input_bfd->sections;
2707                section != NULL; section = section->next)
2708             {
2709               Elf_Internal_Rela *internal_relocs, *irelaend, *irela;
2710
2711               /* If there aren't any relocs, then there's nothing more
2712                  to do.  */
2713               if ((section->flags & SEC_RELOC) == 0
2714                   || section->reloc_count == 0
2715                   || (section->flags & SEC_CODE) == 0)
2716                 continue;
2717
2718               /* If this section is a link-once section that will be
2719                  discarded, then don't create any stubs.  */
2720               if (section->output_section == NULL
2721                   || section->output_section->owner != output_bfd)
2722                 continue;
2723
2724               /* Get the relocs.  */
2725               internal_relocs
2726                 = _bfd_elf_link_read_relocs (input_bfd, section, NULL,
2727                                              NULL, info->keep_memory);
2728               if (internal_relocs == NULL)
2729                 goto error_ret_free_local;
2730
2731               /* Now examine each relocation.  */
2732               irela = internal_relocs;
2733               irelaend = irela + section->reloc_count;
2734               for (; irela < irelaend; irela++)
2735                 {
2736                   unsigned int r_type, r_indx;
2737                   enum elf_aarch64_stub_type stub_type;
2738                   struct elf_aarch64_stub_hash_entry *stub_entry;
2739                   asection *sym_sec;
2740                   bfd_vma sym_value;
2741                   bfd_vma destination;
2742                   struct elf_aarch64_link_hash_entry *hash;
2743                   const char *sym_name;
2744                   char *stub_name;
2745                   const asection *id_sec;
2746                   unsigned char st_type;
2747                   bfd_size_type len;
2748
2749                   r_type = ELFNN_R_TYPE (irela->r_info);
2750                   r_indx = ELFNN_R_SYM (irela->r_info);
2751
2752                   if (r_type >= (unsigned int) R_AARCH64_end)
2753                     {
2754                       bfd_set_error (bfd_error_bad_value);
2755                     error_ret_free_internal:
2756                       if (elf_section_data (section)->relocs == NULL)
2757                         free (internal_relocs);
2758                       goto error_ret_free_local;
2759                     }
2760
2761                   /* Only look for stubs on unconditional branch and
2762                      branch and link instructions.  */
2763                   if (r_type != (unsigned int) AARCH64_R (CALL26)
2764                       && r_type != (unsigned int) AARCH64_R (JUMP26))
2765                     continue;
2766
2767                   /* Now determine the call target, its name, value,
2768                      section.  */
2769                   sym_sec = NULL;
2770                   sym_value = 0;
2771                   destination = 0;
2772                   hash = NULL;
2773                   sym_name = NULL;
2774                   if (r_indx < symtab_hdr->sh_info)
2775                     {
2776                       /* It's a local symbol.  */
2777                       Elf_Internal_Sym *sym;
2778                       Elf_Internal_Shdr *hdr;
2779
2780                       if (local_syms == NULL)
2781                         {
2782                           local_syms
2783                             = (Elf_Internal_Sym *) symtab_hdr->contents;
2784                           if (local_syms == NULL)
2785                             local_syms
2786                               = bfd_elf_get_elf_syms (input_bfd, symtab_hdr,
2787                                                       symtab_hdr->sh_info, 0,
2788                                                       NULL, NULL, NULL);
2789                           if (local_syms == NULL)
2790                             goto error_ret_free_internal;
2791                         }
2792
2793                       sym = local_syms + r_indx;
2794                       hdr = elf_elfsections (input_bfd)[sym->st_shndx];
2795                       sym_sec = hdr->bfd_section;
2796                       if (!sym_sec)
2797                         /* This is an undefined symbol.  It can never
2798                            be resolved.  */
2799                         continue;
2800
2801                       if (ELF_ST_TYPE (sym->st_info) != STT_SECTION)
2802                         sym_value = sym->st_value;
2803                       destination = (sym_value + irela->r_addend
2804                                      + sym_sec->output_offset
2805                                      + sym_sec->output_section->vma);
2806                       st_type = ELF_ST_TYPE (sym->st_info);
2807                       sym_name
2808                         = bfd_elf_string_from_elf_section (input_bfd,
2809                                                            symtab_hdr->sh_link,
2810                                                            sym->st_name);
2811                     }
2812                   else
2813                     {
2814                       int e_indx;
2815
2816                       e_indx = r_indx - symtab_hdr->sh_info;
2817                       hash = ((struct elf_aarch64_link_hash_entry *)
2818                               elf_sym_hashes (input_bfd)[e_indx]);
2819
2820                       while (hash->root.root.type == bfd_link_hash_indirect
2821                              || hash->root.root.type == bfd_link_hash_warning)
2822                         hash = ((struct elf_aarch64_link_hash_entry *)
2823                                 hash->root.root.u.i.link);
2824
2825                       if (hash->root.root.type == bfd_link_hash_defined
2826                           || hash->root.root.type == bfd_link_hash_defweak)
2827                         {
2828                           struct elf_aarch64_link_hash_table *globals =
2829                             elf_aarch64_hash_table (info);
2830                           sym_sec = hash->root.root.u.def.section;
2831                           sym_value = hash->root.root.u.def.value;
2832                           /* For a destination in a shared library,
2833                              use the PLT stub as target address to
2834                              decide whether a branch stub is
2835                              needed.  */
2836                           if (globals->root.splt != NULL && hash != NULL
2837                               && hash->root.plt.offset != (bfd_vma) - 1)
2838                             {
2839                               sym_sec = globals->root.splt;
2840                               sym_value = hash->root.plt.offset;
2841                               if (sym_sec->output_section != NULL)
2842                                 destination = (sym_value
2843                                                + sym_sec->output_offset
2844                                                +
2845                                                sym_sec->output_section->vma);
2846                             }
2847                           else if (sym_sec->output_section != NULL)
2848                             destination = (sym_value + irela->r_addend
2849                                            + sym_sec->output_offset
2850                                            + sym_sec->output_section->vma);
2851                         }
2852                       else if (hash->root.root.type == bfd_link_hash_undefined
2853                                || (hash->root.root.type
2854                                    == bfd_link_hash_undefweak))
2855                         {
2856                           /* For a shared library, use the PLT stub as
2857                              target address to decide whether a long
2858                              branch stub is needed.
2859                              For absolute code, they cannot be handled.  */
2860                           struct elf_aarch64_link_hash_table *globals =
2861                             elf_aarch64_hash_table (info);
2862
2863                           if (globals->root.splt != NULL && hash != NULL
2864                               && hash->root.plt.offset != (bfd_vma) - 1)
2865                             {
2866                               sym_sec = globals->root.splt;
2867                               sym_value = hash->root.plt.offset;
2868                               if (sym_sec->output_section != NULL)
2869                                 destination = (sym_value
2870                                                + sym_sec->output_offset
2871                                                +
2872                                                sym_sec->output_section->vma);
2873                             }
2874                           else
2875                             continue;
2876                         }
2877                       else
2878                         {
2879                           bfd_set_error (bfd_error_bad_value);
2880                           goto error_ret_free_internal;
2881                         }
2882                       st_type = ELF_ST_TYPE (hash->root.type);
2883                       sym_name = hash->root.root.root.string;
2884                     }
2885
2886                   /* Determine what (if any) linker stub is needed.  */
2887                   stub_type = aarch64_type_of_stub
2888                     (info, section, irela, st_type, hash, destination);
2889                   if (stub_type == aarch64_stub_none)
2890                     continue;
2891
2892                   /* Support for grouping stub sections.  */
2893                   id_sec = htab->stub_group[section->id].link_sec;
2894
2895                   /* Get the name of this stub.  */
2896                   stub_name = elfNN_aarch64_stub_name (id_sec, sym_sec, hash,
2897                                                        irela);
2898                   if (!stub_name)
2899                     goto error_ret_free_internal;
2900
2901                   stub_entry =
2902                     aarch64_stub_hash_lookup (&htab->stub_hash_table,
2903                                               stub_name, FALSE, FALSE);
2904                   if (stub_entry != NULL)
2905                     {
2906                       /* The proper stub has already been created.  */
2907                       free (stub_name);
2908                       continue;
2909                     }
2910
2911                   stub_entry = elfNN_aarch64_add_stub (stub_name, section,
2912                                                        htab);
2913                   if (stub_entry == NULL)
2914                     {
2915                       free (stub_name);
2916                       goto error_ret_free_internal;
2917                     }
2918
2919                   stub_entry->target_value = sym_value;
2920                   stub_entry->target_section = sym_sec;
2921                   stub_entry->stub_type = stub_type;
2922                   stub_entry->h = hash;
2923                   stub_entry->st_type = st_type;
2924
2925                   if (sym_name == NULL)
2926                     sym_name = "unnamed";
2927                   len = sizeof (STUB_ENTRY_NAME) + strlen (sym_name);
2928                   stub_entry->output_name = bfd_alloc (htab->stub_bfd, len);
2929                   if (stub_entry->output_name == NULL)
2930                     {
2931                       free (stub_name);
2932                       goto error_ret_free_internal;
2933                     }
2934
2935                   snprintf (stub_entry->output_name, len, STUB_ENTRY_NAME,
2936                             sym_name);
2937
2938                   stub_changed = TRUE;
2939                 }
2940
2941               /* We're done with the internal relocs, free them.  */
2942               if (elf_section_data (section)->relocs == NULL)
2943                 free (internal_relocs);
2944             }
2945         }
2946
2947       if (!stub_changed)
2948         break;
2949
2950       /* OK, we've added some stubs.  Find out the new size of the
2951          stub sections.  */
2952       for (stub_sec = htab->stub_bfd->sections;
2953            stub_sec != NULL; stub_sec = stub_sec->next)
2954         stub_sec->size = 0;
2955
2956       bfd_hash_traverse (&htab->stub_hash_table, aarch64_size_one_stub, htab);
2957
2958       /* Ask the linker to do its stuff.  */
2959       (*htab->layout_sections_again) ();
2960       stub_changed = FALSE;
2961     }
2962
2963   return TRUE;
2964
2965 error_ret_free_local:
2966   return FALSE;
2967 }
2968
2969 /* Build all the stubs associated with the current output file.  The
2970    stubs are kept in a hash table attached to the main linker hash
2971    table.  We also set up the .plt entries for statically linked PIC
2972    functions here.  This function is called via aarch64_elf_finish in the
2973    linker.  */
2974
2975 bfd_boolean
2976 elfNN_aarch64_build_stubs (struct bfd_link_info *info)
2977 {
2978   asection *stub_sec;
2979   struct bfd_hash_table *table;
2980   struct elf_aarch64_link_hash_table *htab;
2981
2982   htab = elf_aarch64_hash_table (info);
2983
2984   for (stub_sec = htab->stub_bfd->sections;
2985        stub_sec != NULL; stub_sec = stub_sec->next)
2986     {
2987       bfd_size_type size;
2988
2989       /* Ignore non-stub sections.  */
2990       if (!strstr (stub_sec->name, STUB_SUFFIX))
2991         continue;
2992
2993       /* Allocate memory to hold the linker stubs.  */
2994       size = stub_sec->size;
2995       stub_sec->contents = bfd_zalloc (htab->stub_bfd, size);
2996       if (stub_sec->contents == NULL && size != 0)
2997         return FALSE;
2998       stub_sec->size = 0;
2999     }
3000
3001   /* Build the stubs as directed by the stub hash table.  */
3002   table = &htab->stub_hash_table;
3003   bfd_hash_traverse (table, aarch64_build_one_stub, info);
3004
3005   return TRUE;
3006 }
3007
3008
3009 /* Add an entry to the code/data map for section SEC.  */
3010
3011 static void
3012 elfNN_aarch64_section_map_add (asection *sec, char type, bfd_vma vma)
3013 {
3014   struct _aarch64_elf_section_data *sec_data =
3015     elf_aarch64_section_data (sec);
3016   unsigned int newidx;
3017
3018   if (sec_data->map == NULL)
3019     {
3020       sec_data->map = bfd_malloc (sizeof (elf_aarch64_section_map));
3021       sec_data->mapcount = 0;
3022       sec_data->mapsize = 1;
3023     }
3024
3025   newidx = sec_data->mapcount++;
3026
3027   if (sec_data->mapcount > sec_data->mapsize)
3028     {
3029       sec_data->mapsize *= 2;
3030       sec_data->map = bfd_realloc_or_free
3031         (sec_data->map, sec_data->mapsize * sizeof (elf_aarch64_section_map));
3032     }
3033
3034   if (sec_data->map)
3035     {
3036       sec_data->map[newidx].vma = vma;
3037       sec_data->map[newidx].type = type;
3038     }
3039 }
3040
3041
3042 /* Initialise maps of insn/data for input BFDs.  */
3043 void
3044 bfd_elfNN_aarch64_init_maps (bfd *abfd)
3045 {
3046   Elf_Internal_Sym *isymbuf;
3047   Elf_Internal_Shdr *hdr;
3048   unsigned int i, localsyms;
3049
3050   /* Make sure that we are dealing with an AArch64 elf binary.  */
3051   if (!is_aarch64_elf (abfd))
3052     return;
3053
3054   if ((abfd->flags & DYNAMIC) != 0)
3055     return;
3056
3057   hdr = &elf_symtab_hdr (abfd);
3058   localsyms = hdr->sh_info;
3059
3060   /* Obtain a buffer full of symbols for this BFD. The hdr->sh_info field
3061      should contain the number of local symbols, which should come before any
3062      global symbols.  Mapping symbols are always local.  */
3063   isymbuf = bfd_elf_get_elf_syms (abfd, hdr, localsyms, 0, NULL, NULL, NULL);
3064
3065   /* No internal symbols read?  Skip this BFD.  */
3066   if (isymbuf == NULL)
3067     return;
3068
3069   for (i = 0; i < localsyms; i++)
3070     {
3071       Elf_Internal_Sym *isym = &isymbuf[i];
3072       asection *sec = bfd_section_from_elf_index (abfd, isym->st_shndx);
3073       const char *name;
3074
3075       if (sec != NULL && ELF_ST_BIND (isym->st_info) == STB_LOCAL)
3076         {
3077           name = bfd_elf_string_from_elf_section (abfd,
3078                                                   hdr->sh_link,
3079                                                   isym->st_name);
3080
3081           if (bfd_is_aarch64_special_symbol_name
3082               (name, BFD_AARCH64_SPECIAL_SYM_TYPE_MAP))
3083             elfNN_aarch64_section_map_add (sec, name[1], isym->st_value);
3084         }
3085     }
3086 }
3087
3088 /* Set option values needed during linking.  */
3089 void
3090 bfd_elfNN_aarch64_set_options (struct bfd *output_bfd,
3091                                struct bfd_link_info *link_info,
3092                                int no_enum_warn,
3093                                int no_wchar_warn, int pic_veneer)
3094 {
3095   struct elf_aarch64_link_hash_table *globals;
3096
3097   globals = elf_aarch64_hash_table (link_info);
3098   globals->pic_veneer = pic_veneer;
3099
3100   BFD_ASSERT (is_aarch64_elf (output_bfd));
3101   elf_aarch64_tdata (output_bfd)->no_enum_size_warning = no_enum_warn;
3102   elf_aarch64_tdata (output_bfd)->no_wchar_size_warning = no_wchar_warn;
3103 }
3104
3105 static bfd_vma
3106 aarch64_calculate_got_entry_vma (struct elf_link_hash_entry *h,
3107                                  struct elf_aarch64_link_hash_table
3108                                  *globals, struct bfd_link_info *info,
3109                                  bfd_vma value, bfd *output_bfd,
3110                                  bfd_boolean *unresolved_reloc_p)
3111 {
3112   bfd_vma off = (bfd_vma) - 1;
3113   asection *basegot = globals->root.sgot;
3114   bfd_boolean dyn = globals->root.dynamic_sections_created;
3115
3116   if (h != NULL)
3117     {
3118       BFD_ASSERT (basegot != NULL);
3119       off = h->got.offset;
3120       BFD_ASSERT (off != (bfd_vma) - 1);
3121       if (!WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, info->shared, h)
3122           || (info->shared
3123               && SYMBOL_REFERENCES_LOCAL (info, h))
3124           || (ELF_ST_VISIBILITY (h->other)
3125               && h->root.type == bfd_link_hash_undefweak))
3126         {
3127           /* This is actually a static link, or it is a -Bsymbolic link
3128              and the symbol is defined locally.  We must initialize this
3129              entry in the global offset table.  Since the offset must
3130              always be a multiple of 8 (4 in the case of ILP32), we use
3131              the least significant bit to record whether we have
3132              initialized it already.
3133              When doing a dynamic link, we create a .rel(a).got relocation
3134              entry to initialize the value.  This is done in the
3135              finish_dynamic_symbol routine.  */
3136           if ((off & 1) != 0)
3137             off &= ~1;
3138           else
3139             {
3140               bfd_put_NN (output_bfd, value, basegot->contents + off);
3141               h->got.offset |= 1;
3142             }
3143         }
3144       else
3145         *unresolved_reloc_p = FALSE;
3146
3147       off = off + basegot->output_section->vma + basegot->output_offset;
3148     }
3149
3150   return off;
3151 }
3152
3153 /* Change R_TYPE to a more efficient access model where possible,
3154    return the new reloc type.  */
3155
3156 static bfd_reloc_code_real_type
3157 aarch64_tls_transition_without_check (bfd_reloc_code_real_type r_type,
3158                                       struct elf_link_hash_entry *h)
3159 {
3160   bfd_boolean is_local = h == NULL;
3161
3162   switch (r_type)
3163     {
3164     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3165     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3166       return (is_local
3167               ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1
3168               : BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21);
3169
3170     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3171     case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
3172       return (is_local
3173               ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC
3174               : BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC);
3175
3176     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3177       return is_local ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1 : r_type;
3178
3179     case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
3180       return is_local ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC : r_type;
3181
3182     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3183     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3184       /* Instructions with these relocations will become NOPs.  */
3185       return BFD_RELOC_AARCH64_NONE;
3186
3187     default:
3188       break;
3189     }
3190
3191   return r_type;
3192 }
3193
3194 static unsigned int
3195 aarch64_reloc_got_type (bfd_reloc_code_real_type r_type)
3196 {
3197   switch (r_type)
3198     {
3199     case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
3200     case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
3201     case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
3202     case BFD_RELOC_AARCH64_GOT_LD_PREL19:
3203       return GOT_NORMAL;
3204
3205     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3206     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3207       return GOT_TLS_GD;
3208
3209     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3210     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3211     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3212     case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
3213     case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
3214       return GOT_TLSDESC_GD;
3215
3216     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3217     case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
3218     case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
3219       return GOT_TLS_IE;
3220
3221     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
3222     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
3223     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
3224     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
3225     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
3226     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
3227     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
3228     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
3229       return GOT_UNKNOWN;
3230
3231     default:
3232       break;
3233     }
3234   return GOT_UNKNOWN;
3235 }
3236
3237 static bfd_boolean
3238 aarch64_can_relax_tls (bfd *input_bfd,
3239                        struct bfd_link_info *info,
3240                        bfd_reloc_code_real_type r_type,
3241                        struct elf_link_hash_entry *h,
3242                        unsigned long r_symndx)
3243 {
3244   unsigned int symbol_got_type;
3245   unsigned int reloc_got_type;
3246
3247   if (! IS_AARCH64_TLS_RELOC (r_type))
3248     return FALSE;
3249
3250   symbol_got_type = elfNN_aarch64_symbol_got_type (h, input_bfd, r_symndx);
3251   reloc_got_type = aarch64_reloc_got_type (r_type);
3252
3253   if (symbol_got_type == GOT_TLS_IE && GOT_TLS_GD_ANY_P (reloc_got_type))
3254     return TRUE;
3255
3256   if (info->shared)
3257     return FALSE;
3258
3259   if  (h && h->root.type == bfd_link_hash_undefweak)
3260     return FALSE;
3261
3262   return TRUE;
3263 }
3264
3265 /* Given the relocation code R_TYPE, return the relaxed bfd reloc
3266    enumerator.  */
3267
3268 static bfd_reloc_code_real_type
3269 aarch64_tls_transition (bfd *input_bfd,
3270                         struct bfd_link_info *info,
3271                         unsigned int r_type,
3272                         struct elf_link_hash_entry *h,
3273                         unsigned long r_symndx)
3274 {
3275   bfd_reloc_code_real_type bfd_r_type
3276     = elfNN_aarch64_bfd_reloc_from_type (r_type);
3277
3278   if (! aarch64_can_relax_tls (input_bfd, info, bfd_r_type, h, r_symndx))
3279     return bfd_r_type;
3280
3281   return aarch64_tls_transition_without_check (bfd_r_type, h);
3282 }
3283
3284 /* Return the base VMA address which should be subtracted from real addresses
3285    when resolving R_AARCH64_TLS_DTPREL relocation.  */
3286
3287 static bfd_vma
3288 dtpoff_base (struct bfd_link_info *info)
3289 {
3290   /* If tls_sec is NULL, we should have signalled an error already.  */
3291   BFD_ASSERT (elf_hash_table (info)->tls_sec != NULL);
3292   return elf_hash_table (info)->tls_sec->vma;
3293 }
3294
3295 /* Return the base VMA address which should be subtracted from real addresses
3296    when resolving R_AARCH64_TLS_GOTTPREL64 relocations.  */
3297
3298 static bfd_vma
3299 tpoff_base (struct bfd_link_info *info)
3300 {
3301   struct elf_link_hash_table *htab = elf_hash_table (info);
3302
3303   /* If tls_sec is NULL, we should have signalled an error already.  */
3304   if (htab->tls_sec == NULL)
3305     return 0;
3306
3307   bfd_vma base = align_power ((bfd_vma) TCB_SIZE,
3308                               htab->tls_sec->alignment_power);
3309   return htab->tls_sec->vma - base;
3310 }
3311
3312 static bfd_vma *
3313 symbol_got_offset_ref (bfd *input_bfd, struct elf_link_hash_entry *h,
3314                        unsigned long r_symndx)
3315 {
3316   /* Calculate the address of the GOT entry for symbol
3317      referred to in h.  */
3318   if (h != NULL)
3319     return &h->got.offset;
3320   else
3321     {
3322       /* local symbol */
3323       struct elf_aarch64_local_symbol *l;
3324
3325       l = elf_aarch64_locals (input_bfd);
3326       return &l[r_symndx].got_offset;
3327     }
3328 }
3329
3330 static void
3331 symbol_got_offset_mark (bfd *input_bfd, struct elf_link_hash_entry *h,
3332                         unsigned long r_symndx)
3333 {
3334   bfd_vma *p;
3335   p = symbol_got_offset_ref (input_bfd, h, r_symndx);
3336   *p |= 1;
3337 }
3338
3339 static int
3340 symbol_got_offset_mark_p (bfd *input_bfd, struct elf_link_hash_entry *h,
3341                           unsigned long r_symndx)
3342 {
3343   bfd_vma value;
3344   value = * symbol_got_offset_ref (input_bfd, h, r_symndx);
3345   return value & 1;
3346 }
3347
3348 static bfd_vma
3349 symbol_got_offset (bfd *input_bfd, struct elf_link_hash_entry *h,
3350                    unsigned long r_symndx)
3351 {
3352   bfd_vma value;
3353   value = * symbol_got_offset_ref (input_bfd, h, r_symndx);
3354   value &= ~1;
3355   return value;
3356 }
3357
3358 static bfd_vma *
3359 symbol_tlsdesc_got_offset_ref (bfd *input_bfd, struct elf_link_hash_entry *h,
3360                                unsigned long r_symndx)
3361 {
3362   /* Calculate the address of the GOT entry for symbol
3363      referred to in h.  */
3364   if (h != NULL)
3365     {
3366       struct elf_aarch64_link_hash_entry *eh;
3367       eh = (struct elf_aarch64_link_hash_entry *) h;
3368       return &eh->tlsdesc_got_jump_table_offset;
3369     }
3370   else
3371     {
3372       /* local symbol */
3373       struct elf_aarch64_local_symbol *l;
3374
3375       l = elf_aarch64_locals (input_bfd);
3376       return &l[r_symndx].tlsdesc_got_jump_table_offset;
3377     }
3378 }
3379
3380 static void
3381 symbol_tlsdesc_got_offset_mark (bfd *input_bfd, struct elf_link_hash_entry *h,
3382                                 unsigned long r_symndx)
3383 {
3384   bfd_vma *p;
3385   p = symbol_tlsdesc_got_offset_ref (input_bfd, h, r_symndx);
3386   *p |= 1;
3387 }
3388
3389 static int
3390 symbol_tlsdesc_got_offset_mark_p (bfd *input_bfd,
3391                                   struct elf_link_hash_entry *h,
3392                                   unsigned long r_symndx)
3393 {
3394   bfd_vma value;
3395   value = * symbol_tlsdesc_got_offset_ref (input_bfd, h, r_symndx);
3396   return value & 1;
3397 }
3398
3399 static bfd_vma
3400 symbol_tlsdesc_got_offset (bfd *input_bfd, struct elf_link_hash_entry *h,
3401                           unsigned long r_symndx)
3402 {
3403   bfd_vma value;
3404   value = * symbol_tlsdesc_got_offset_ref (input_bfd, h, r_symndx);
3405   value &= ~1;
3406   return value;
3407 }
3408
3409 /* Perform a relocation as part of a final link.  */
3410 static bfd_reloc_status_type
3411 elfNN_aarch64_final_link_relocate (reloc_howto_type *howto,
3412                                    bfd *input_bfd,
3413                                    bfd *output_bfd,
3414                                    asection *input_section,
3415                                    bfd_byte *contents,
3416                                    Elf_Internal_Rela *rel,
3417                                    bfd_vma value,
3418                                    struct bfd_link_info *info,
3419                                    asection *sym_sec,
3420                                    struct elf_link_hash_entry *h,
3421                                    bfd_boolean *unresolved_reloc_p,
3422                                    bfd_boolean save_addend,
3423                                    bfd_vma *saved_addend,
3424                                    Elf_Internal_Sym *sym)
3425 {
3426   Elf_Internal_Shdr *symtab_hdr;
3427   unsigned int r_type = howto->type;
3428   bfd_reloc_code_real_type bfd_r_type
3429     = elfNN_aarch64_bfd_reloc_from_howto (howto);
3430   bfd_reloc_code_real_type new_bfd_r_type;
3431   unsigned long r_symndx;
3432   bfd_byte *hit_data = contents + rel->r_offset;
3433   bfd_vma place;
3434   bfd_signed_vma signed_addend;
3435   struct elf_aarch64_link_hash_table *globals;
3436   bfd_boolean weak_undef_p;
3437
3438   globals = elf_aarch64_hash_table (info);
3439
3440   symtab_hdr = &elf_symtab_hdr (input_bfd);
3441
3442   BFD_ASSERT (is_aarch64_elf (input_bfd));
3443
3444   r_symndx = ELFNN_R_SYM (rel->r_info);
3445
3446   /* It is possible to have linker relaxations on some TLS access
3447      models.  Update our information here.  */
3448   new_bfd_r_type = aarch64_tls_transition (input_bfd, info, r_type, h, r_symndx);
3449   if (new_bfd_r_type != bfd_r_type)
3450     {
3451       bfd_r_type = new_bfd_r_type;
3452       howto = elfNN_aarch64_howto_from_bfd_reloc (bfd_r_type);
3453       BFD_ASSERT (howto != NULL);
3454       r_type = howto->type;
3455     }
3456
3457   place = input_section->output_section->vma
3458     + input_section->output_offset + rel->r_offset;
3459
3460   /* Get addend, accumulating the addend for consecutive relocs
3461      which refer to the same offset.  */
3462   signed_addend = saved_addend ? *saved_addend : 0;
3463   signed_addend += rel->r_addend;
3464
3465   weak_undef_p = (h ? h->root.type == bfd_link_hash_undefweak
3466                   : bfd_is_und_section (sym_sec));
3467
3468   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle
3469      it here if it is defined in a non-shared object.  */
3470   if (h != NULL
3471       && h->type == STT_GNU_IFUNC
3472       && h->def_regular)
3473     {
3474       asection *plt;
3475       const char *name;
3476       asection *base_got;
3477       bfd_vma off;
3478
3479       if ((input_section->flags & SEC_ALLOC) == 0
3480           || h->plt.offset == (bfd_vma) -1)
3481         abort ();
3482
3483       /* STT_GNU_IFUNC symbol must go through PLT.  */
3484       plt = globals->root.splt ? globals->root.splt : globals->root.iplt;
3485       value = (plt->output_section->vma + plt->output_offset + h->plt.offset);
3486
3487       switch (bfd_r_type)
3488         {
3489         default:
3490           if (h->root.root.string)
3491             name = h->root.root.string;
3492           else
3493             name = bfd_elf_sym_name (input_bfd, symtab_hdr, sym,
3494                                      NULL);
3495           (*_bfd_error_handler)
3496             (_("%B: relocation %s against STT_GNU_IFUNC "
3497                "symbol `%s' isn't handled by %s"), input_bfd,
3498              howto->name, name, __FUNCTION__);
3499           bfd_set_error (bfd_error_bad_value);
3500           return FALSE;
3501
3502         case BFD_RELOC_AARCH64_NN:
3503           if (rel->r_addend != 0)
3504             {
3505               if (h->root.root.string)
3506                 name = h->root.root.string;
3507               else
3508                 name = bfd_elf_sym_name (input_bfd, symtab_hdr,
3509                                          sym, NULL);
3510               (*_bfd_error_handler)
3511                 (_("%B: relocation %s against STT_GNU_IFUNC "
3512                    "symbol `%s' has non-zero addend: %d"),
3513                  input_bfd, howto->name, name, rel->r_addend);
3514               bfd_set_error (bfd_error_bad_value);
3515               return FALSE;
3516             }
3517
3518           /* Generate dynamic relocation only when there is a
3519              non-GOT reference in a shared object.  */
3520           if (info->shared && h->non_got_ref)
3521             {
3522               Elf_Internal_Rela outrel;
3523               asection *sreloc;
3524
3525               /* Need a dynamic relocation to get the real function
3526                  address.  */
3527               outrel.r_offset = _bfd_elf_section_offset (output_bfd,
3528                                                          info,
3529                                                          input_section,
3530                                                          rel->r_offset);
3531               if (outrel.r_offset == (bfd_vma) -1
3532                   || outrel.r_offset == (bfd_vma) -2)
3533                 abort ();
3534
3535               outrel.r_offset += (input_section->output_section->vma
3536                                   + input_section->output_offset);
3537
3538               if (h->dynindx == -1
3539                   || h->forced_local
3540                   || info->executable)
3541                 {
3542                   /* This symbol is resolved locally.  */
3543                   outrel.r_info = ELFNN_R_INFO (0, AARCH64_R (IRELATIVE));
3544                   outrel.r_addend = (h->root.u.def.value
3545                                      + h->root.u.def.section->output_section->vma
3546                                      + h->root.u.def.section->output_offset);
3547                 }
3548               else
3549                 {
3550                   outrel.r_info = ELFNN_R_INFO (h->dynindx, r_type);
3551                   outrel.r_addend = 0;
3552                 }
3553
3554               sreloc = globals->root.irelifunc;
3555               elf_append_rela (output_bfd, sreloc, &outrel);
3556
3557               /* If this reloc is against an external symbol, we
3558                  do not want to fiddle with the addend.  Otherwise,
3559                  we need to include the symbol value so that it
3560                  becomes an addend for the dynamic reloc.  For an
3561                  internal symbol, we have updated addend.  */
3562               return bfd_reloc_ok;
3563             }
3564           /* FALLTHROUGH */
3565         case BFD_RELOC_AARCH64_JUMP26:
3566         case BFD_RELOC_AARCH64_CALL26:
3567           value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3568                                                        signed_addend,
3569                                                        weak_undef_p);
3570           return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type,
3571                                               howto, value);
3572         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
3573         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
3574         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
3575         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
3576           base_got = globals->root.sgot;
3577           off = h->got.offset;
3578
3579           if (base_got == NULL)
3580             abort ();
3581
3582           if (off == (bfd_vma) -1)
3583             {
3584               bfd_vma plt_index;
3585
3586               /* We can't use h->got.offset here to save state, or
3587                  even just remember the offset, as finish_dynamic_symbol
3588                  would use that as offset into .got.  */
3589
3590               if (globals->root.splt != NULL)
3591                 {
3592                   plt_index = ((h->plt.offset - globals->plt_header_size) /
3593                                globals->plt_entry_size);
3594                   off = (plt_index + 3) * GOT_ENTRY_SIZE;
3595                   base_got = globals->root.sgotplt;
3596                 }
3597               else
3598                 {
3599                   plt_index = h->plt.offset / globals->plt_entry_size;
3600                   off = plt_index * GOT_ENTRY_SIZE;
3601                   base_got = globals->root.igotplt;
3602                 }
3603
3604               if (h->dynindx == -1
3605                   || h->forced_local
3606                   || info->symbolic)
3607                 {
3608                   /* This references the local definition.  We must
3609                      initialize this entry in the global offset table.
3610                      Since the offset must always be a multiple of 8,
3611                      we use the least significant bit to record
3612                      whether we have initialized it already.
3613
3614                      When doing a dynamic link, we create a .rela.got
3615                      relocation entry to initialize the value.  This
3616                      is done in the finish_dynamic_symbol routine.       */
3617                   if ((off & 1) != 0)
3618                     off &= ~1;
3619                   else
3620                     {
3621                       bfd_put_NN (output_bfd, value,
3622                                   base_got->contents + off);
3623                       /* Note that this is harmless as -1 | 1 still is -1.  */
3624                       h->got.offset |= 1;
3625                     }
3626                 }
3627               value = (base_got->output_section->vma
3628                        + base_got->output_offset + off);
3629             }
3630           else
3631             value = aarch64_calculate_got_entry_vma (h, globals, info,
3632                                                      value, output_bfd,
3633                                                      unresolved_reloc_p);
3634           value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3635                                                        0, weak_undef_p);
3636           return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type, howto, value);
3637         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
3638         case BFD_RELOC_AARCH64_ADD_LO12:
3639           break;
3640         }
3641     }
3642
3643   switch (bfd_r_type)
3644     {
3645     case BFD_RELOC_AARCH64_NONE:
3646     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3647       *unresolved_reloc_p = FALSE;
3648       return bfd_reloc_ok;
3649
3650     case BFD_RELOC_AARCH64_NN:
3651
3652       /* When generating a shared object or relocatable executable, these
3653          relocations are copied into the output file to be resolved at
3654          run time.  */
3655       if (((info->shared == TRUE) || globals->root.is_relocatable_executable)
3656           && (input_section->flags & SEC_ALLOC)
3657           && (h == NULL
3658               || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
3659               || h->root.type != bfd_link_hash_undefweak))
3660         {
3661           Elf_Internal_Rela outrel;
3662           bfd_byte *loc;
3663           bfd_boolean skip, relocate;
3664           asection *sreloc;
3665
3666           *unresolved_reloc_p = FALSE;
3667
3668           skip = FALSE;
3669           relocate = FALSE;
3670
3671           outrel.r_addend = signed_addend;
3672           outrel.r_offset =
3673             _bfd_elf_section_offset (output_bfd, info, input_section,
3674                                      rel->r_offset);
3675           if (outrel.r_offset == (bfd_vma) - 1)
3676             skip = TRUE;
3677           else if (outrel.r_offset == (bfd_vma) - 2)
3678             {
3679               skip = TRUE;
3680               relocate = TRUE;
3681             }
3682
3683           outrel.r_offset += (input_section->output_section->vma
3684                               + input_section->output_offset);
3685
3686           if (skip)
3687             memset (&outrel, 0, sizeof outrel);
3688           else if (h != NULL
3689                    && h->dynindx != -1
3690                    && (!info->shared || !info->symbolic || !h->def_regular))
3691             outrel.r_info = ELFNN_R_INFO (h->dynindx, r_type);
3692           else
3693             {
3694               int symbol;
3695
3696               /* On SVR4-ish systems, the dynamic loader cannot
3697                  relocate the text and data segments independently,
3698                  so the symbol does not matter.  */
3699               symbol = 0;
3700               outrel.r_info = ELFNN_R_INFO (symbol, AARCH64_R (RELATIVE));
3701               outrel.r_addend += value;
3702             }
3703
3704           sreloc = elf_section_data (input_section)->sreloc;
3705           if (sreloc == NULL || sreloc->contents == NULL)
3706             return bfd_reloc_notsupported;
3707
3708           loc = sreloc->contents + sreloc->reloc_count++ * RELOC_SIZE (globals);
3709           bfd_elfNN_swap_reloca_out (output_bfd, &outrel, loc);
3710
3711           if (sreloc->reloc_count * RELOC_SIZE (globals) > sreloc->size)
3712             {
3713               /* Sanity to check that we have previously allocated
3714                  sufficient space in the relocation section for the
3715                  number of relocations we actually want to emit.  */
3716               abort ();
3717             }
3718
3719           /* If this reloc is against an external symbol, we do not want to
3720              fiddle with the addend.  Otherwise, we need to include the symbol
3721              value so that it becomes an addend for the dynamic reloc.  */
3722           if (!relocate)
3723             return bfd_reloc_ok;
3724
3725           return _bfd_final_link_relocate (howto, input_bfd, input_section,
3726                                            contents, rel->r_offset, value,
3727                                            signed_addend);
3728         }
3729       else
3730         value += signed_addend;
3731       break;
3732
3733     case BFD_RELOC_AARCH64_JUMP26:
3734     case BFD_RELOC_AARCH64_CALL26:
3735       {
3736         asection *splt = globals->root.splt;
3737         bfd_boolean via_plt_p =
3738           splt != NULL && h != NULL && h->plt.offset != (bfd_vma) - 1;
3739
3740         /* A call to an undefined weak symbol is converted to a jump to
3741            the next instruction unless a PLT entry will be created.
3742            The jump to the next instruction is optimized as a NOP.
3743            Do the same for local undefined symbols.  */
3744         if (weak_undef_p && ! via_plt_p)
3745           {
3746             bfd_putl32 (INSN_NOP, hit_data);
3747             return bfd_reloc_ok;
3748           }
3749
3750         /* If the call goes through a PLT entry, make sure to
3751            check distance to the right destination address.  */
3752         if (via_plt_p)
3753           {
3754             value = (splt->output_section->vma
3755                      + splt->output_offset + h->plt.offset);
3756             *unresolved_reloc_p = FALSE;
3757           }
3758
3759         /* If the target symbol is global and marked as a function the
3760            relocation applies a function call or a tail call.  In this
3761            situation we can veneer out of range branches.  The veneers
3762            use IP0 and IP1 hence cannot be used arbitrary out of range
3763            branches that occur within the body of a function.  */
3764         if (h && h->type == STT_FUNC)
3765           {
3766             /* Check if a stub has to be inserted because the destination
3767                is too far away.  */
3768             if (! aarch64_valid_branch_p (value, place))
3769               {
3770                 /* The target is out of reach, so redirect the branch to
3771                    the local stub for this function.  */
3772                 struct elf_aarch64_stub_hash_entry *stub_entry;
3773                 stub_entry = elfNN_aarch64_get_stub_entry (input_section,
3774                                                            sym_sec, h,
3775                                                            rel, globals);
3776                 if (stub_entry != NULL)
3777                   value = (stub_entry->stub_offset
3778                            + stub_entry->stub_sec->output_offset
3779                            + stub_entry->stub_sec->output_section->vma);
3780               }
3781           }
3782       }
3783       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3784                                                    signed_addend, weak_undef_p);
3785       break;
3786
3787     case BFD_RELOC_AARCH64_16:
3788 #if ARCH_SIZE == 64
3789     case BFD_RELOC_AARCH64_32:
3790 #endif
3791     case BFD_RELOC_AARCH64_ADD_LO12:
3792     case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
3793     case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
3794     case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
3795     case BFD_RELOC_AARCH64_BRANCH19:
3796     case BFD_RELOC_AARCH64_LD_LO19_PCREL:
3797     case BFD_RELOC_AARCH64_LDST8_LO12:
3798     case BFD_RELOC_AARCH64_LDST16_LO12:
3799     case BFD_RELOC_AARCH64_LDST32_LO12:
3800     case BFD_RELOC_AARCH64_LDST64_LO12:
3801     case BFD_RELOC_AARCH64_LDST128_LO12:
3802     case BFD_RELOC_AARCH64_MOVW_G0_S:
3803     case BFD_RELOC_AARCH64_MOVW_G1_S:
3804     case BFD_RELOC_AARCH64_MOVW_G2_S:
3805     case BFD_RELOC_AARCH64_MOVW_G0:
3806     case BFD_RELOC_AARCH64_MOVW_G0_NC:
3807     case BFD_RELOC_AARCH64_MOVW_G1:
3808     case BFD_RELOC_AARCH64_MOVW_G1_NC:
3809     case BFD_RELOC_AARCH64_MOVW_G2:
3810     case BFD_RELOC_AARCH64_MOVW_G2_NC:
3811     case BFD_RELOC_AARCH64_MOVW_G3:
3812     case BFD_RELOC_AARCH64_16_PCREL:
3813     case BFD_RELOC_AARCH64_32_PCREL:
3814     case BFD_RELOC_AARCH64_64_PCREL:
3815     case BFD_RELOC_AARCH64_TSTBR14:
3816       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3817                                                    signed_addend, weak_undef_p);
3818       break;
3819
3820     case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
3821     case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
3822     case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
3823     case BFD_RELOC_AARCH64_GOT_LD_PREL19:
3824       if (globals->root.sgot == NULL)
3825         BFD_ASSERT (h != NULL);
3826
3827       if (h != NULL)
3828         {
3829           value = aarch64_calculate_got_entry_vma (h, globals, info, value,
3830                                                    output_bfd,
3831                                                    unresolved_reloc_p);
3832           value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3833                                                        0, weak_undef_p);
3834         }
3835       break;
3836
3837     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3838     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3839     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3840     case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
3841     case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
3842       if (globals->root.sgot == NULL)
3843         return bfd_reloc_notsupported;
3844
3845       value = (symbol_got_offset (input_bfd, h, r_symndx)
3846                + globals->root.sgot->output_section->vma
3847                + globals->root.sgot->output_section->output_offset);
3848
3849       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3850                                                    0, weak_undef_p);
3851       *unresolved_reloc_p = FALSE;
3852       break;
3853
3854     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
3855     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
3856     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
3857     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
3858     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
3859     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
3860     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
3861     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
3862       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3863                                                    signed_addend - tpoff_base (info),
3864                                                    weak_undef_p);
3865       *unresolved_reloc_p = FALSE;
3866       break;
3867
3868     case BFD_RELOC_AARCH64_TLSDESC_ADD:
3869     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3870     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3871     case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
3872     case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
3873     case BFD_RELOC_AARCH64_TLSDESC_LDR:
3874       if (globals->root.sgot == NULL)
3875         return bfd_reloc_notsupported;
3876
3877       value = (symbol_tlsdesc_got_offset (input_bfd, h, r_symndx)
3878                + globals->root.sgotplt->output_section->vma
3879                + globals->root.sgotplt->output_section->output_offset
3880                + globals->sgotplt_jump_table_size);
3881
3882       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3883                                                    0, weak_undef_p);
3884       *unresolved_reloc_p = FALSE;
3885       break;
3886
3887     default:
3888       return bfd_reloc_notsupported;
3889     }
3890
3891   if (saved_addend)
3892     *saved_addend = value;
3893
3894   /* Only apply the final relocation in a sequence.  */
3895   if (save_addend)
3896     return bfd_reloc_continue;
3897
3898   return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type,
3899                                       howto, value);
3900 }
3901
3902 /* Handle TLS relaxations.  Relaxing is possible for symbols that use
3903    R_AARCH64_TLSDESC_ADR_{PAGE, LD64_LO12_NC, ADD_LO12_NC} during a static
3904    link.
3905
3906    Return bfd_reloc_ok if we're done, bfd_reloc_continue if the caller
3907    is to then call final_link_relocate.  Return other values in the
3908    case of error.  */
3909
3910 static bfd_reloc_status_type
3911 elfNN_aarch64_tls_relax (struct elf_aarch64_link_hash_table *globals,
3912                          bfd *input_bfd, bfd_byte *contents,
3913                          Elf_Internal_Rela *rel, struct elf_link_hash_entry *h)
3914 {
3915   bfd_boolean is_local = h == NULL;
3916   unsigned int r_type = ELFNN_R_TYPE (rel->r_info);
3917   unsigned long insn;
3918
3919   BFD_ASSERT (globals && input_bfd && contents && rel);
3920
3921   switch (elfNN_aarch64_bfd_reloc_from_type (r_type))
3922     {
3923     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3924     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3925       if (is_local)
3926         {
3927           /* GD->LE relaxation:
3928              adrp x0, :tlsgd:var     =>   movz x0, :tprel_g1:var
3929              or
3930              adrp x0, :tlsdesc:var   =>   movz x0, :tprel_g1:var
3931            */
3932           bfd_putl32 (0xd2a00000, contents + rel->r_offset);
3933           return bfd_reloc_continue;
3934         }
3935       else
3936         {
3937           /* GD->IE relaxation:
3938              adrp x0, :tlsgd:var     =>   adrp x0, :gottprel:var
3939              or
3940              adrp x0, :tlsdesc:var   =>   adrp x0, :gottprel:var
3941            */
3942           insn = bfd_getl32 (contents + rel->r_offset);
3943           return bfd_reloc_continue;
3944         }
3945
3946     case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
3947       if (is_local)
3948         {
3949           /* GD->LE relaxation:
3950              ldr xd, [x0, #:tlsdesc_lo12:var]   =>   movk x0, :tprel_g0_nc:var
3951            */
3952           bfd_putl32 (0xf2800000, contents + rel->r_offset);
3953           return bfd_reloc_continue;
3954         }
3955       else
3956         {
3957           /* GD->IE relaxation:
3958              ldr xd, [x0, #:tlsdesc_lo12:var] => ldr x0, [x0, #:gottprel_lo12:var]
3959            */
3960           insn = bfd_getl32 (contents + rel->r_offset);
3961           insn &= 0xfffffff0;
3962           bfd_putl32 (insn, contents + rel->r_offset);
3963           return bfd_reloc_continue;
3964         }
3965
3966     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3967       if (is_local)
3968         {
3969           /* GD->LE relaxation
3970              add  x0, #:tlsgd_lo12:var  => movk x0, :tprel_g0_nc:var
3971              bl   __tls_get_addr        => mrs  x1, tpidr_el0
3972              nop                        => add  x0, x1, x0
3973            */
3974
3975           /* First kill the tls_get_addr reloc on the bl instruction.  */
3976           BFD_ASSERT (rel->r_offset + 4 == rel[1].r_offset);
3977           rel[1].r_info = ELFNN_R_INFO (STN_UNDEF, R_AARCH64_NONE);
3978
3979           bfd_putl32 (0xf2800000, contents + rel->r_offset);
3980           bfd_putl32 (0xd53bd041, contents + rel->r_offset + 4);
3981           bfd_putl32 (0x8b000020, contents + rel->r_offset + 8);
3982           return bfd_reloc_continue;
3983         }
3984       else
3985         {
3986           /* GD->IE relaxation
3987              ADD  x0, #:tlsgd_lo12:var  => ldr  x0, [x0, #:gottprel_lo12:var]
3988              BL   __tls_get_addr        => mrs  x1, tpidr_el0
3989                R_AARCH64_CALL26
3990              NOP                        => add  x0, x1, x0
3991            */
3992
3993           BFD_ASSERT (ELFNN_R_TYPE (rel[1].r_info) == AARCH64_R (CALL26));
3994
3995           /* Remove the relocation on the BL instruction.  */
3996           rel[1].r_info = ELFNN_R_INFO (STN_UNDEF, R_AARCH64_NONE);
3997
3998           bfd_putl32 (0xf9400000, contents + rel->r_offset);
3999
4000           /* We choose to fixup the BL and NOP instructions using the
4001              offset from the second relocation to allow flexibility in
4002              scheduling instructions between the ADD and BL.  */
4003           bfd_putl32 (0xd53bd041, contents + rel[1].r_offset);
4004           bfd_putl32 (0x8b000020, contents + rel[1].r_offset + 4);
4005           return bfd_reloc_continue;
4006         }
4007
4008     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4009     case BFD_RELOC_AARCH64_TLSDESC_CALL:
4010       /* GD->IE/LE relaxation:
4011          add x0, x0, #:tlsdesc_lo12:var   =>   nop
4012          blr xd                           =>   nop
4013        */
4014       bfd_putl32 (INSN_NOP, contents + rel->r_offset);
4015       return bfd_reloc_ok;
4016
4017     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4018       /* IE->LE relaxation:
4019          adrp xd, :gottprel:var   =>   movz xd, :tprel_g1:var
4020        */
4021       if (is_local)
4022         {
4023           insn = bfd_getl32 (contents + rel->r_offset);
4024           bfd_putl32 (0xd2a00000 | (insn & 0x1f), contents + rel->r_offset);
4025         }
4026       return bfd_reloc_continue;
4027
4028     case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
4029       /* IE->LE relaxation:
4030          ldr  xd, [xm, #:gottprel_lo12:var]   =>   movk xd, :tprel_g0_nc:var
4031        */
4032       if (is_local)
4033         {
4034           insn = bfd_getl32 (contents + rel->r_offset);
4035           bfd_putl32 (0xf2800000 | (insn & 0x1f), contents + rel->r_offset);
4036         }
4037       return bfd_reloc_continue;
4038
4039     default:
4040       return bfd_reloc_continue;
4041     }
4042
4043   return bfd_reloc_ok;
4044 }
4045
4046 /* Relocate an AArch64 ELF section.  */
4047
4048 static bfd_boolean
4049 elfNN_aarch64_relocate_section (bfd *output_bfd,
4050                                 struct bfd_link_info *info,
4051                                 bfd *input_bfd,
4052                                 asection *input_section,
4053                                 bfd_byte *contents,
4054                                 Elf_Internal_Rela *relocs,
4055                                 Elf_Internal_Sym *local_syms,
4056                                 asection **local_sections)
4057 {
4058   Elf_Internal_Shdr *symtab_hdr;
4059   struct elf_link_hash_entry **sym_hashes;
4060   Elf_Internal_Rela *rel;
4061   Elf_Internal_Rela *relend;
4062   const char *name;
4063   struct elf_aarch64_link_hash_table *globals;
4064   bfd_boolean save_addend = FALSE;
4065   bfd_vma addend = 0;
4066
4067   globals = elf_aarch64_hash_table (info);
4068
4069   symtab_hdr = &elf_symtab_hdr (input_bfd);
4070   sym_hashes = elf_sym_hashes (input_bfd);
4071
4072   rel = relocs;
4073   relend = relocs + input_section->reloc_count;
4074   for (; rel < relend; rel++)
4075     {
4076       unsigned int r_type;
4077       bfd_reloc_code_real_type bfd_r_type;
4078       bfd_reloc_code_real_type relaxed_bfd_r_type;
4079       reloc_howto_type *howto;
4080       unsigned long r_symndx;
4081       Elf_Internal_Sym *sym;
4082       asection *sec;
4083       struct elf_link_hash_entry *h;
4084       bfd_vma relocation;
4085       bfd_reloc_status_type r;
4086       arelent bfd_reloc;
4087       char sym_type;
4088       bfd_boolean unresolved_reloc = FALSE;
4089       char *error_message = NULL;
4090
4091       r_symndx = ELFNN_R_SYM (rel->r_info);
4092       r_type = ELFNN_R_TYPE (rel->r_info);
4093
4094       bfd_reloc.howto = elfNN_aarch64_howto_from_type (r_type);
4095       howto = bfd_reloc.howto;
4096
4097       if (howto == NULL)
4098         {
4099           (*_bfd_error_handler)
4100             (_("%B: unrecognized relocation (0x%x) in section `%A'"),
4101              input_bfd, input_section, r_type);
4102           return FALSE;
4103         }
4104       bfd_r_type = elfNN_aarch64_bfd_reloc_from_howto (howto);
4105
4106       h = NULL;
4107       sym = NULL;
4108       sec = NULL;
4109
4110       if (r_symndx < symtab_hdr->sh_info)
4111         {
4112           sym = local_syms + r_symndx;
4113           sym_type = ELFNN_ST_TYPE (sym->st_info);
4114           sec = local_sections[r_symndx];
4115
4116           /* An object file might have a reference to a local
4117              undefined symbol.  This is a daft object file, but we
4118              should at least do something about it.  */
4119           if (r_type != R_AARCH64_NONE && r_type != R_AARCH64_NULL
4120               && bfd_is_und_section (sec)
4121               && ELF_ST_BIND (sym->st_info) != STB_WEAK)
4122             {
4123               if (!info->callbacks->undefined_symbol
4124                   (info, bfd_elf_string_from_elf_section
4125                    (input_bfd, symtab_hdr->sh_link, sym->st_name),
4126                    input_bfd, input_section, rel->r_offset, TRUE))
4127                 return FALSE;
4128             }
4129
4130           relocation = _bfd_elf_rela_local_sym (output_bfd, sym, &sec, rel);
4131
4132           /* Relocate against local STT_GNU_IFUNC symbol.  */
4133           if (!info->relocatable
4134               && ELF_ST_TYPE (sym->st_info) == STT_GNU_IFUNC)
4135             {
4136               h = elfNN_aarch64_get_local_sym_hash (globals, input_bfd,
4137                                                     rel, FALSE);
4138               if (h == NULL)
4139                 abort ();
4140
4141               /* Set STT_GNU_IFUNC symbol value.  */
4142               h->root.u.def.value = sym->st_value;
4143               h->root.u.def.section = sec;
4144             }
4145         }
4146       else
4147         {
4148           bfd_boolean warned, ignored;
4149
4150           RELOC_FOR_GLOBAL_SYMBOL (info, input_bfd, input_section, rel,
4151                                    r_symndx, symtab_hdr, sym_hashes,
4152                                    h, sec, relocation,
4153                                    unresolved_reloc, warned, ignored);
4154
4155           sym_type = h->type;
4156         }
4157
4158       if (sec != NULL && discarded_section (sec))
4159         RELOC_AGAINST_DISCARDED_SECTION (info, input_bfd, input_section,
4160                                          rel, 1, relend, howto, 0, contents);
4161
4162       if (info->relocatable)
4163         {
4164           /* This is a relocatable link.  We don't have to change
4165              anything, unless the reloc is against a section symbol,
4166              in which case we have to adjust according to where the
4167              section symbol winds up in the output section.  */
4168           if (sym != NULL && ELF_ST_TYPE (sym->st_info) == STT_SECTION)
4169             rel->r_addend += sec->output_offset;
4170           continue;
4171         }
4172
4173       if (h != NULL)
4174         name = h->root.root.string;
4175       else
4176         {
4177           name = (bfd_elf_string_from_elf_section
4178                   (input_bfd, symtab_hdr->sh_link, sym->st_name));
4179           if (name == NULL || *name == '\0')
4180             name = bfd_section_name (input_bfd, sec);
4181         }
4182
4183       if (r_symndx != 0
4184           && r_type != R_AARCH64_NONE
4185           && r_type != R_AARCH64_NULL
4186           && (h == NULL
4187               || h->root.type == bfd_link_hash_defined
4188               || h->root.type == bfd_link_hash_defweak)
4189           && IS_AARCH64_TLS_RELOC (bfd_r_type) != (sym_type == STT_TLS))
4190         {
4191           (*_bfd_error_handler)
4192             ((sym_type == STT_TLS
4193               ? _("%B(%A+0x%lx): %s used with TLS symbol %s")
4194               : _("%B(%A+0x%lx): %s used with non-TLS symbol %s")),
4195              input_bfd,
4196              input_section, (long) rel->r_offset, howto->name, name);
4197         }
4198
4199       /* We relax only if we can see that there can be a valid transition
4200          from a reloc type to another.
4201          We call elfNN_aarch64_final_link_relocate unless we're completely
4202          done, i.e., the relaxation produced the final output we want.  */
4203
4204       relaxed_bfd_r_type = aarch64_tls_transition (input_bfd, info, r_type,
4205                                                    h, r_symndx);
4206       if (relaxed_bfd_r_type != bfd_r_type)
4207         {
4208           bfd_r_type = relaxed_bfd_r_type;
4209           howto = elfNN_aarch64_howto_from_bfd_reloc (bfd_r_type);
4210           BFD_ASSERT (howto != NULL);
4211           r_type = howto->type;
4212           r = elfNN_aarch64_tls_relax (globals, input_bfd, contents, rel, h);
4213           unresolved_reloc = 0;
4214         }
4215       else
4216         r = bfd_reloc_continue;
4217
4218       /* There may be multiple consecutive relocations for the
4219          same offset.  In that case we are supposed to treat the
4220          output of each relocation as the addend for the next.  */
4221       if (rel + 1 < relend
4222           && rel->r_offset == rel[1].r_offset
4223           && ELFNN_R_TYPE (rel[1].r_info) != R_AARCH64_NONE
4224           && ELFNN_R_TYPE (rel[1].r_info) != R_AARCH64_NULL)
4225         save_addend = TRUE;
4226       else
4227         save_addend = FALSE;
4228
4229       if (r == bfd_reloc_continue)
4230         r = elfNN_aarch64_final_link_relocate (howto, input_bfd, output_bfd,
4231                                                input_section, contents, rel,
4232                                                relocation, info, sec,
4233                                                h, &unresolved_reloc,
4234                                                save_addend, &addend, sym);
4235
4236       switch (elfNN_aarch64_bfd_reloc_from_type (r_type))
4237         {
4238         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4239         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4240           if (! symbol_got_offset_mark_p (input_bfd, h, r_symndx))
4241             {
4242               bfd_boolean need_relocs = FALSE;
4243               bfd_byte *loc;
4244               int indx;
4245               bfd_vma off;
4246
4247               off = symbol_got_offset (input_bfd, h, r_symndx);
4248               indx = h && h->dynindx != -1 ? h->dynindx : 0;
4249
4250               need_relocs =
4251                 (info->shared || indx != 0) &&
4252                 (h == NULL
4253                  || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4254                  || h->root.type != bfd_link_hash_undefweak);
4255
4256               BFD_ASSERT (globals->root.srelgot != NULL);
4257
4258               if (need_relocs)
4259                 {
4260                   Elf_Internal_Rela rela;
4261                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLS_DTPMOD));
4262                   rela.r_addend = 0;
4263                   rela.r_offset = globals->root.sgot->output_section->vma +
4264                     globals->root.sgot->output_offset + off;
4265
4266
4267                   loc = globals->root.srelgot->contents;
4268                   loc += globals->root.srelgot->reloc_count++
4269                     * RELOC_SIZE (htab);
4270                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4271
4272                   if (indx == 0)
4273                     {
4274                       bfd_put_NN (output_bfd,
4275                                   relocation - dtpoff_base (info),
4276                                   globals->root.sgot->contents + off
4277                                   + GOT_ENTRY_SIZE);
4278                     }
4279                   else
4280                     {
4281                       /* This TLS symbol is global. We emit a
4282                          relocation to fixup the tls offset at load
4283                          time.  */
4284                       rela.r_info =
4285                         ELFNN_R_INFO (indx, AARCH64_R (TLS_DTPREL));
4286                       rela.r_addend = 0;
4287                       rela.r_offset =
4288                         (globals->root.sgot->output_section->vma
4289                          + globals->root.sgot->output_offset + off
4290                          + GOT_ENTRY_SIZE);
4291
4292                       loc = globals->root.srelgot->contents;
4293                       loc += globals->root.srelgot->reloc_count++
4294                         * RELOC_SIZE (globals);
4295                       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4296                       bfd_put_NN (output_bfd, (bfd_vma) 0,
4297                                   globals->root.sgot->contents + off
4298                                   + GOT_ENTRY_SIZE);
4299                     }
4300                 }
4301               else
4302                 {
4303                   bfd_put_NN (output_bfd, (bfd_vma) 1,
4304                               globals->root.sgot->contents + off);
4305                   bfd_put_NN (output_bfd,
4306                               relocation - dtpoff_base (info),
4307                               globals->root.sgot->contents + off
4308                               + GOT_ENTRY_SIZE);
4309                 }
4310
4311               symbol_got_offset_mark (input_bfd, h, r_symndx);
4312             }
4313           break;
4314
4315         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4316         case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
4317           if (! symbol_got_offset_mark_p (input_bfd, h, r_symndx))
4318             {
4319               bfd_boolean need_relocs = FALSE;
4320               bfd_byte *loc;
4321               int indx;
4322               bfd_vma off;
4323
4324               off = symbol_got_offset (input_bfd, h, r_symndx);
4325
4326               indx = h && h->dynindx != -1 ? h->dynindx : 0;
4327
4328               need_relocs =
4329                 (info->shared || indx != 0) &&
4330                 (h == NULL
4331                  || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4332                  || h->root.type != bfd_link_hash_undefweak);
4333
4334               BFD_ASSERT (globals->root.srelgot != NULL);
4335
4336               if (need_relocs)
4337                 {
4338                   Elf_Internal_Rela rela;
4339
4340                   if (indx == 0)
4341                     rela.r_addend = relocation - dtpoff_base (info);
4342                   else
4343                     rela.r_addend = 0;
4344
4345                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLS_TPREL));
4346                   rela.r_offset = globals->root.sgot->output_section->vma +
4347                     globals->root.sgot->output_offset + off;
4348
4349                   loc = globals->root.srelgot->contents;
4350                   loc += globals->root.srelgot->reloc_count++
4351                     * RELOC_SIZE (htab);
4352
4353                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4354
4355                   bfd_put_NN (output_bfd, rela.r_addend,
4356                               globals->root.sgot->contents + off);
4357                 }
4358               else
4359                 bfd_put_NN (output_bfd, relocation - tpoff_base (info),
4360                             globals->root.sgot->contents + off);
4361
4362               symbol_got_offset_mark (input_bfd, h, r_symndx);
4363             }
4364           break;
4365
4366         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
4367         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
4368         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
4369         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
4370         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
4371         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
4372         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
4373         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
4374           break;
4375
4376         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4377         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
4378         case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
4379           if (! symbol_tlsdesc_got_offset_mark_p (input_bfd, h, r_symndx))
4380             {
4381               bfd_boolean need_relocs = FALSE;
4382               int indx = h && h->dynindx != -1 ? h->dynindx : 0;
4383               bfd_vma off = symbol_tlsdesc_got_offset (input_bfd, h, r_symndx);
4384
4385               need_relocs = (h == NULL
4386                              || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4387                              || h->root.type != bfd_link_hash_undefweak);
4388
4389               BFD_ASSERT (globals->root.srelgot != NULL);
4390               BFD_ASSERT (globals->root.sgot != NULL);
4391
4392               if (need_relocs)
4393                 {
4394                   bfd_byte *loc;
4395                   Elf_Internal_Rela rela;
4396                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLSDESC));
4397
4398                   rela.r_addend = 0;
4399                   rela.r_offset = (globals->root.sgotplt->output_section->vma
4400                                    + globals->root.sgotplt->output_offset
4401                                    + off + globals->sgotplt_jump_table_size);
4402
4403                   if (indx == 0)
4404                     rela.r_addend = relocation - dtpoff_base (info);
4405
4406                   /* Allocate the next available slot in the PLT reloc
4407                      section to hold our R_AARCH64_TLSDESC, the next
4408                      available slot is determined from reloc_count,
4409                      which we step. But note, reloc_count was
4410                      artifically moved down while allocating slots for
4411                      real PLT relocs such that all of the PLT relocs
4412                      will fit above the initial reloc_count and the
4413                      extra stuff will fit below.  */
4414                   loc = globals->root.srelplt->contents;
4415                   loc += globals->root.srelplt->reloc_count++
4416                     * RELOC_SIZE (globals);
4417
4418                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4419
4420                   bfd_put_NN (output_bfd, (bfd_vma) 0,
4421                               globals->root.sgotplt->contents + off +
4422                               globals->sgotplt_jump_table_size);
4423                   bfd_put_NN (output_bfd, (bfd_vma) 0,
4424                               globals->root.sgotplt->contents + off +
4425                               globals->sgotplt_jump_table_size +
4426                               GOT_ENTRY_SIZE);
4427                 }
4428
4429               symbol_tlsdesc_got_offset_mark (input_bfd, h, r_symndx);
4430             }
4431           break;
4432         default:
4433           break;
4434         }
4435
4436       if (!save_addend)
4437         addend = 0;
4438
4439
4440       /* Dynamic relocs are not propagated for SEC_DEBUGGING sections
4441          because such sections are not SEC_ALLOC and thus ld.so will
4442          not process them.  */
4443       if (unresolved_reloc
4444           && !((input_section->flags & SEC_DEBUGGING) != 0
4445                && h->def_dynamic)
4446           && _bfd_elf_section_offset (output_bfd, info, input_section,
4447                                       +rel->r_offset) != (bfd_vma) - 1)
4448         {
4449           (*_bfd_error_handler)
4450             (_
4451              ("%B(%A+0x%lx): unresolvable %s relocation against symbol `%s'"),
4452              input_bfd, input_section, (long) rel->r_offset, howto->name,
4453              h->root.root.string);
4454           return FALSE;
4455         }
4456
4457       if (r != bfd_reloc_ok && r != bfd_reloc_continue)
4458         {
4459           switch (r)
4460             {
4461             case bfd_reloc_overflow:
4462               /* If the overflowing reloc was to an undefined symbol,
4463                  we have already printed one error message and there
4464                  is no point complaining again.  */
4465               if ((!h ||
4466                    h->root.type != bfd_link_hash_undefined)
4467                   && (!((*info->callbacks->reloc_overflow)
4468                         (info, (h ? &h->root : NULL), name, howto->name,
4469                          (bfd_vma) 0, input_bfd, input_section,
4470                          rel->r_offset))))
4471                 return FALSE;
4472               break;
4473
4474             case bfd_reloc_undefined:
4475               if (!((*info->callbacks->undefined_symbol)
4476                     (info, name, input_bfd, input_section,
4477                      rel->r_offset, TRUE)))
4478                 return FALSE;
4479               break;
4480
4481             case bfd_reloc_outofrange:
4482               error_message = _("out of range");
4483               goto common_error;
4484
4485             case bfd_reloc_notsupported:
4486               error_message = _("unsupported relocation");
4487               goto common_error;
4488
4489             case bfd_reloc_dangerous:
4490               /* error_message should already be set.  */
4491               goto common_error;
4492
4493             default:
4494               error_message = _("unknown error");
4495               /* Fall through.  */
4496
4497             common_error:
4498               BFD_ASSERT (error_message != NULL);
4499               if (!((*info->callbacks->reloc_dangerous)
4500                     (info, error_message, input_bfd, input_section,
4501                      rel->r_offset)))
4502                 return FALSE;
4503               break;
4504             }
4505         }
4506     }
4507
4508   return TRUE;
4509 }
4510
4511 /* Set the right machine number.  */
4512
4513 static bfd_boolean
4514 elfNN_aarch64_object_p (bfd *abfd)
4515 {
4516 #if ARCH_SIZE == 32
4517   bfd_default_set_arch_mach (abfd, bfd_arch_aarch64, bfd_mach_aarch64_ilp32);
4518 #else
4519   bfd_default_set_arch_mach (abfd, bfd_arch_aarch64, bfd_mach_aarch64);
4520 #endif
4521   return TRUE;
4522 }
4523
4524 /* Function to keep AArch64 specific flags in the ELF header.  */
4525
4526 static bfd_boolean
4527 elfNN_aarch64_set_private_flags (bfd *abfd, flagword flags)
4528 {
4529   if (elf_flags_init (abfd) && elf_elfheader (abfd)->e_flags != flags)
4530     {
4531     }
4532   else
4533     {
4534       elf_elfheader (abfd)->e_flags = flags;
4535       elf_flags_init (abfd) = TRUE;
4536     }
4537
4538   return TRUE;
4539 }
4540
4541 /* Copy backend specific data from one object module to another.  */
4542
4543 static bfd_boolean
4544 elfNN_aarch64_copy_private_bfd_data (bfd *ibfd, bfd *obfd)
4545 {
4546   flagword in_flags;
4547
4548   if (!is_aarch64_elf (ibfd) || !is_aarch64_elf (obfd))
4549     return TRUE;
4550
4551   in_flags = elf_elfheader (ibfd)->e_flags;
4552
4553   elf_elfheader (obfd)->e_flags = in_flags;
4554   elf_flags_init (obfd) = TRUE;
4555
4556   /* Also copy the EI_OSABI field.  */
4557   elf_elfheader (obfd)->e_ident[EI_OSABI] =
4558     elf_elfheader (ibfd)->e_ident[EI_OSABI];
4559
4560   /* Copy object attributes.  */
4561   _bfd_elf_copy_obj_attributes (ibfd, obfd);
4562
4563   return TRUE;
4564 }
4565
4566 /* Merge backend specific data from an object file to the output
4567    object file when linking.  */
4568
4569 static bfd_boolean
4570 elfNN_aarch64_merge_private_bfd_data (bfd *ibfd, bfd *obfd)
4571 {
4572   flagword out_flags;
4573   flagword in_flags;
4574   bfd_boolean flags_compatible = TRUE;
4575   asection *sec;
4576
4577   /* Check if we have the same endianess.  */
4578   if (!_bfd_generic_verify_endian_match (ibfd, obfd))
4579     return FALSE;
4580
4581   if (!is_aarch64_elf (ibfd) || !is_aarch64_elf (obfd))
4582     return TRUE;
4583
4584   /* The input BFD must have had its flags initialised.  */
4585   /* The following seems bogus to me -- The flags are initialized in
4586      the assembler but I don't think an elf_flags_init field is
4587      written into the object.  */
4588   /* BFD_ASSERT (elf_flags_init (ibfd)); */
4589
4590   in_flags = elf_elfheader (ibfd)->e_flags;
4591   out_flags = elf_elfheader (obfd)->e_flags;
4592
4593   if (!elf_flags_init (obfd))
4594     {
4595       /* If the input is the default architecture and had the default
4596          flags then do not bother setting the flags for the output
4597          architecture, instead allow future merges to do this.  If no
4598          future merges ever set these flags then they will retain their
4599          uninitialised values, which surprise surprise, correspond
4600          to the default values.  */
4601       if (bfd_get_arch_info (ibfd)->the_default
4602           && elf_elfheader (ibfd)->e_flags == 0)
4603         return TRUE;
4604
4605       elf_flags_init (obfd) = TRUE;
4606       elf_elfheader (obfd)->e_flags = in_flags;
4607
4608       if (bfd_get_arch (obfd) == bfd_get_arch (ibfd)
4609           && bfd_get_arch_info (obfd)->the_default)
4610         return bfd_set_arch_mach (obfd, bfd_get_arch (ibfd),
4611                                   bfd_get_mach (ibfd));
4612
4613       return TRUE;
4614     }
4615
4616   /* Identical flags must be compatible.  */
4617   if (in_flags == out_flags)
4618     return TRUE;
4619
4620   /* Check to see if the input BFD actually contains any sections.  If
4621      not, its flags may not have been initialised either, but it
4622      cannot actually cause any incompatiblity.  Do not short-circuit
4623      dynamic objects; their section list may be emptied by
4624      elf_link_add_object_symbols.
4625
4626      Also check to see if there are no code sections in the input.
4627      In this case there is no need to check for code specific flags.
4628      XXX - do we need to worry about floating-point format compatability
4629      in data sections ?  */
4630   if (!(ibfd->flags & DYNAMIC))
4631     {
4632       bfd_boolean null_input_bfd = TRUE;
4633       bfd_boolean only_data_sections = TRUE;
4634
4635       for (sec = ibfd->sections; sec != NULL; sec = sec->next)
4636         {
4637           if ((bfd_get_section_flags (ibfd, sec)
4638                & (SEC_LOAD | SEC_CODE | SEC_HAS_CONTENTS))
4639               == (SEC_LOAD | SEC_CODE | SEC_HAS_CONTENTS))
4640             only_data_sections = FALSE;
4641
4642           null_input_bfd = FALSE;
4643           break;
4644         }
4645
4646       if (null_input_bfd || only_data_sections)
4647         return TRUE;
4648     }
4649
4650   return flags_compatible;
4651 }
4652
4653 /* Display the flags field.  */
4654
4655 static bfd_boolean
4656 elfNN_aarch64_print_private_bfd_data (bfd *abfd, void *ptr)
4657 {
4658   FILE *file = (FILE *) ptr;
4659   unsigned long flags;
4660
4661   BFD_ASSERT (abfd != NULL && ptr != NULL);
4662
4663   /* Print normal ELF private data.  */
4664   _bfd_elf_print_private_bfd_data (abfd, ptr);
4665
4666   flags = elf_elfheader (abfd)->e_flags;
4667   /* Ignore init flag - it may not be set, despite the flags field
4668      containing valid data.  */
4669
4670   /* xgettext:c-format */
4671   fprintf (file, _("private flags = %lx:"), elf_elfheader (abfd)->e_flags);
4672
4673   if (flags)
4674     fprintf (file, _("<Unrecognised flag bits set>"));
4675
4676   fputc ('\n', file);
4677
4678   return TRUE;
4679 }
4680
4681 /* Update the got entry reference counts for the section being removed.  */
4682
4683 static bfd_boolean
4684 elfNN_aarch64_gc_sweep_hook (bfd *abfd,
4685                              struct bfd_link_info *info,
4686                              asection *sec,
4687                              const Elf_Internal_Rela * relocs)
4688 {
4689   struct elf_aarch64_link_hash_table *htab;
4690   Elf_Internal_Shdr *symtab_hdr;
4691   struct elf_link_hash_entry **sym_hashes;
4692   struct elf_aarch64_local_symbol *locals;
4693   const Elf_Internal_Rela *rel, *relend;
4694
4695   if (info->relocatable)
4696     return TRUE;
4697
4698   htab = elf_aarch64_hash_table (info);
4699
4700   if (htab == NULL)
4701     return FALSE;
4702
4703   elf_section_data (sec)->local_dynrel = NULL;
4704
4705   symtab_hdr = &elf_symtab_hdr (abfd);
4706   sym_hashes = elf_sym_hashes (abfd);
4707
4708   locals = elf_aarch64_locals (abfd);
4709
4710   relend = relocs + sec->reloc_count;
4711   for (rel = relocs; rel < relend; rel++)
4712     {
4713       unsigned long r_symndx;
4714       unsigned int r_type;
4715       struct elf_link_hash_entry *h = NULL;
4716
4717       r_symndx = ELFNN_R_SYM (rel->r_info);
4718
4719       if (r_symndx >= symtab_hdr->sh_info)
4720         {
4721
4722           h = sym_hashes[r_symndx - symtab_hdr->sh_info];
4723           while (h->root.type == bfd_link_hash_indirect
4724                  || h->root.type == bfd_link_hash_warning)
4725             h = (struct elf_link_hash_entry *) h->root.u.i.link;
4726         }
4727       else
4728         {
4729           Elf_Internal_Sym *isym;
4730
4731           /* A local symbol.  */
4732           isym = bfd_sym_from_r_symndx (&htab->sym_cache,
4733                                         abfd, r_symndx);
4734
4735           /* Check relocation against local STT_GNU_IFUNC symbol.  */
4736           if (isym != NULL
4737               && ELF_ST_TYPE (isym->st_info) == STT_GNU_IFUNC)
4738             {
4739               h = elfNN_aarch64_get_local_sym_hash (htab, abfd, rel, FALSE);
4740               if (h == NULL)
4741                 abort ();
4742             }
4743         }
4744
4745       if (h)
4746         {
4747           struct elf_aarch64_link_hash_entry *eh;
4748           struct elf_dyn_relocs **pp;
4749           struct elf_dyn_relocs *p;
4750
4751           eh = (struct elf_aarch64_link_hash_entry *) h;
4752
4753           for (pp = &eh->dyn_relocs; (p = *pp) != NULL; pp = &p->next)
4754             if (p->sec == sec)
4755               {
4756                 /* Everything must go for SEC.  */
4757                 *pp = p->next;
4758                 break;
4759               }
4760         }
4761
4762       r_type = ELFNN_R_TYPE (rel->r_info);
4763       switch (aarch64_tls_transition (abfd,info, r_type, h ,r_symndx))
4764         {
4765         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
4766         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
4767         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
4768         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
4769         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4770         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
4771         case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
4772         case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
4773         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4774         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4775         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4776         case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
4777         case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
4778         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
4779         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
4780         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
4781         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
4782         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
4783         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
4784         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
4785         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
4786           if (h != NULL)
4787             {
4788               if (h->got.refcount > 0)
4789                 h->got.refcount -= 1;
4790
4791               if (h->type == STT_GNU_IFUNC)
4792                 {
4793                   if (h->plt.refcount > 0)
4794                     h->plt.refcount -= 1;
4795                 }
4796             }
4797           else if (locals != NULL)
4798             {
4799               if (locals[r_symndx].got_refcount > 0)
4800                 locals[r_symndx].got_refcount -= 1;
4801             }
4802           break;
4803
4804         case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
4805         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
4806         case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
4807           if (h != NULL && info->executable)
4808             {
4809               if (h->plt.refcount > 0)
4810                 h->plt.refcount -= 1;
4811             }
4812           break;
4813
4814         case BFD_RELOC_AARCH64_CALL26:
4815         case BFD_RELOC_AARCH64_JUMP26:
4816           /* If this is a local symbol then we resolve it
4817              directly without creating a PLT entry.  */
4818           if (h == NULL)
4819             continue;
4820
4821           if (h->plt.refcount > 0)
4822             h->plt.refcount -= 1;
4823           break;
4824
4825         case BFD_RELOC_AARCH64_NN:
4826           if (h != NULL && info->executable)
4827             {
4828               if (h->plt.refcount > 0)
4829                 h->plt.refcount -= 1;
4830             }
4831           break;
4832
4833         default:
4834           break;
4835         }
4836     }
4837
4838   return TRUE;
4839 }
4840
4841 /* Adjust a symbol defined by a dynamic object and referenced by a
4842    regular object.  The current definition is in some section of the
4843    dynamic object, but we're not including those sections.  We have to
4844    change the definition to something the rest of the link can
4845    understand.  */
4846
4847 static bfd_boolean
4848 elfNN_aarch64_adjust_dynamic_symbol (struct bfd_link_info *info,
4849                                      struct elf_link_hash_entry *h)
4850 {
4851   struct elf_aarch64_link_hash_table *htab;
4852   asection *s;
4853
4854   /* If this is a function, put it in the procedure linkage table.  We
4855      will fill in the contents of the procedure linkage table later,
4856      when we know the address of the .got section.  */
4857   if (h->type == STT_FUNC || h->type == STT_GNU_IFUNC || h->needs_plt)
4858     {
4859       if (h->plt.refcount <= 0
4860           || (h->type != STT_GNU_IFUNC
4861               && (SYMBOL_CALLS_LOCAL (info, h)
4862                   || (ELF_ST_VISIBILITY (h->other) != STV_DEFAULT
4863                       && h->root.type == bfd_link_hash_undefweak))))
4864         {
4865           /* This case can occur if we saw a CALL26 reloc in
4866              an input file, but the symbol wasn't referred to
4867              by a dynamic object or all references were
4868              garbage collected. In which case we can end up
4869              resolving.  */
4870           h->plt.offset = (bfd_vma) - 1;
4871           h->needs_plt = 0;
4872         }
4873
4874       return TRUE;
4875     }
4876   else
4877     /* It's possible that we incorrectly decided a .plt reloc was
4878        needed for an R_X86_64_PC32 reloc to a non-function sym in
4879        check_relocs.  We can't decide accurately between function and
4880        non-function syms in check-relocs;  Objects loaded later in
4881        the link may change h->type.  So fix it now.  */
4882     h->plt.offset = (bfd_vma) - 1;
4883
4884
4885   /* If this is a weak symbol, and there is a real definition, the
4886      processor independent code will have arranged for us to see the
4887      real definition first, and we can just use the same value.  */
4888   if (h->u.weakdef != NULL)
4889     {
4890       BFD_ASSERT (h->u.weakdef->root.type == bfd_link_hash_defined
4891                   || h->u.weakdef->root.type == bfd_link_hash_defweak);
4892       h->root.u.def.section = h->u.weakdef->root.u.def.section;
4893       h->root.u.def.value = h->u.weakdef->root.u.def.value;
4894       if (ELIMINATE_COPY_RELOCS || info->nocopyreloc)
4895         h->non_got_ref = h->u.weakdef->non_got_ref;
4896       return TRUE;
4897     }
4898
4899   /* If we are creating a shared library, we must presume that the
4900      only references to the symbol are via the global offset table.
4901      For such cases we need not do anything here; the relocations will
4902      be handled correctly by relocate_section.  */
4903   if (info->shared)
4904     return TRUE;
4905
4906   /* If there are no references to this symbol that do not use the
4907      GOT, we don't need to generate a copy reloc.  */
4908   if (!h->non_got_ref)
4909     return TRUE;
4910
4911   /* If -z nocopyreloc was given, we won't generate them either.  */
4912   if (info->nocopyreloc)
4913     {
4914       h->non_got_ref = 0;
4915       return TRUE;
4916     }
4917
4918   /* We must allocate the symbol in our .dynbss section, which will
4919      become part of the .bss section of the executable.  There will be
4920      an entry for this symbol in the .dynsym section.  The dynamic
4921      object will contain position independent code, so all references
4922      from the dynamic object to this symbol will go through the global
4923      offset table.  The dynamic linker will use the .dynsym entry to
4924      determine the address it must put in the global offset table, so
4925      both the dynamic object and the regular object will refer to the
4926      same memory location for the variable.  */
4927
4928   htab = elf_aarch64_hash_table (info);
4929
4930   /* We must generate a R_AARCH64_COPY reloc to tell the dynamic linker
4931      to copy the initial value out of the dynamic object and into the
4932      runtime process image.  */
4933   if ((h->root.u.def.section->flags & SEC_ALLOC) != 0 && h->size != 0)
4934     {
4935       htab->srelbss->size += RELOC_SIZE (htab);
4936       h->needs_copy = 1;
4937     }
4938
4939   s = htab->sdynbss;
4940
4941   return _bfd_elf_adjust_dynamic_copy (h, s);
4942
4943 }
4944
4945 static bfd_boolean
4946 elfNN_aarch64_allocate_local_symbols (bfd *abfd, unsigned number)
4947 {
4948   struct elf_aarch64_local_symbol *locals;
4949   locals = elf_aarch64_locals (abfd);
4950   if (locals == NULL)
4951     {
4952       locals = (struct elf_aarch64_local_symbol *)
4953         bfd_zalloc (abfd, number * sizeof (struct elf_aarch64_local_symbol));
4954       if (locals == NULL)
4955         return FALSE;
4956       elf_aarch64_locals (abfd) = locals;
4957     }
4958   return TRUE;
4959 }
4960
4961 /* Create the .got section to hold the global offset table.  */
4962
4963 static bfd_boolean
4964 aarch64_elf_create_got_section (bfd *abfd, struct bfd_link_info *info)
4965 {
4966   const struct elf_backend_data *bed = get_elf_backend_data (abfd);
4967   flagword flags;
4968   asection *s;
4969   struct elf_link_hash_entry *h;
4970   struct elf_link_hash_table *htab = elf_hash_table (info);
4971
4972   /* This function may be called more than once.  */
4973   s = bfd_get_linker_section (abfd, ".got");
4974   if (s != NULL)
4975     return TRUE;
4976
4977   flags = bed->dynamic_sec_flags;
4978
4979   s = bfd_make_section_anyway_with_flags (abfd,
4980                                           (bed->rela_plts_and_copies_p
4981                                            ? ".rela.got" : ".rel.got"),
4982                                           (bed->dynamic_sec_flags
4983                                            | SEC_READONLY));
4984   if (s == NULL
4985       || ! bfd_set_section_alignment (abfd, s, bed->s->log_file_align))
4986     return FALSE;
4987   htab->srelgot = s;
4988
4989   s = bfd_make_section_anyway_with_flags (abfd, ".got", flags);
4990   if (s == NULL
4991       || !bfd_set_section_alignment (abfd, s, bed->s->log_file_align))
4992     return FALSE;
4993   htab->sgot = s;
4994   htab->sgot->size += GOT_ENTRY_SIZE;
4995
4996   if (bed->want_got_sym)
4997     {
4998       /* Define the symbol _GLOBAL_OFFSET_TABLE_ at the start of the .got
4999          (or .got.plt) section.  We don't do this in the linker script
5000          because we don't want to define the symbol if we are not creating
5001          a global offset table.  */
5002       h = _bfd_elf_define_linkage_sym (abfd, info, s,
5003                                        "_GLOBAL_OFFSET_TABLE_");
5004       elf_hash_table (info)->hgot = h;
5005       if (h == NULL)
5006         return FALSE;
5007     }
5008
5009   if (bed->want_got_plt)
5010     {
5011       s = bfd_make_section_anyway_with_flags (abfd, ".got.plt", flags);
5012       if (s == NULL
5013           || !bfd_set_section_alignment (abfd, s,
5014                                          bed->s->log_file_align))
5015         return FALSE;
5016       htab->sgotplt = s;
5017     }
5018
5019   /* The first bit of the global offset table is the header.  */
5020   s->size += bed->got_header_size;
5021
5022   return TRUE;
5023 }
5024
5025 /* Look through the relocs for a section during the first phase.  */
5026
5027 static bfd_boolean
5028 elfNN_aarch64_check_relocs (bfd *abfd, struct bfd_link_info *info,
5029                             asection *sec, const Elf_Internal_Rela *relocs)
5030 {
5031   Elf_Internal_Shdr *symtab_hdr;
5032   struct elf_link_hash_entry **sym_hashes;
5033   const Elf_Internal_Rela *rel;
5034   const Elf_Internal_Rela *rel_end;
5035   asection *sreloc;
5036
5037   struct elf_aarch64_link_hash_table *htab;
5038
5039   if (info->relocatable)
5040     return TRUE;
5041
5042   BFD_ASSERT (is_aarch64_elf (abfd));
5043
5044   htab = elf_aarch64_hash_table (info);
5045   sreloc = NULL;
5046
5047   symtab_hdr = &elf_symtab_hdr (abfd);
5048   sym_hashes = elf_sym_hashes (abfd);
5049
5050   rel_end = relocs + sec->reloc_count;
5051   for (rel = relocs; rel < rel_end; rel++)
5052     {
5053       struct elf_link_hash_entry *h;
5054       unsigned long r_symndx;
5055       unsigned int r_type;
5056       bfd_reloc_code_real_type bfd_r_type;
5057       Elf_Internal_Sym *isym;
5058
5059       r_symndx = ELFNN_R_SYM (rel->r_info);
5060       r_type = ELFNN_R_TYPE (rel->r_info);
5061
5062       if (r_symndx >= NUM_SHDR_ENTRIES (symtab_hdr))
5063         {
5064           (*_bfd_error_handler) (_("%B: bad symbol index: %d"), abfd,
5065                                  r_symndx);
5066           return FALSE;
5067         }
5068
5069       if (r_symndx < symtab_hdr->sh_info)
5070         {
5071           /* A local symbol.  */
5072           isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5073                                         abfd, r_symndx);
5074           if (isym == NULL)
5075             return FALSE;
5076
5077           /* Check relocation against local STT_GNU_IFUNC symbol.  */
5078           if (ELF_ST_TYPE (isym->st_info) == STT_GNU_IFUNC)
5079             {
5080               h = elfNN_aarch64_get_local_sym_hash (htab, abfd, rel,
5081                                                     TRUE);
5082               if (h == NULL)
5083                 return FALSE;
5084
5085               /* Fake a STT_GNU_IFUNC symbol.  */
5086               h->type = STT_GNU_IFUNC;
5087               h->def_regular = 1;
5088               h->ref_regular = 1;
5089               h->forced_local = 1;
5090               h->root.type = bfd_link_hash_defined;
5091             }
5092           else
5093             h = NULL;
5094         }
5095       else
5096         {
5097           h = sym_hashes[r_symndx - symtab_hdr->sh_info];
5098           while (h->root.type == bfd_link_hash_indirect
5099                  || h->root.type == bfd_link_hash_warning)
5100             h = (struct elf_link_hash_entry *) h->root.u.i.link;
5101
5102           /* PR15323, ref flags aren't set for references in the same
5103              object.  */
5104           h->root.non_ir_ref = 1;
5105         }
5106
5107       /* Could be done earlier, if h were already available.  */
5108       bfd_r_type = aarch64_tls_transition (abfd, info, r_type, h, r_symndx);
5109
5110       if (h != NULL)
5111         {
5112           /* Create the ifunc sections for static executables.  If we
5113              never see an indirect function symbol nor we are building
5114              a static executable, those sections will be empty and
5115              won't appear in output.  */
5116           switch (bfd_r_type)
5117             {
5118             default:
5119               break;
5120
5121             case BFD_RELOC_AARCH64_NN:
5122             case BFD_RELOC_AARCH64_CALL26:
5123             case BFD_RELOC_AARCH64_JUMP26:
5124             case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5125             case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5126             case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5127             case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5128             case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5129             case BFD_RELOC_AARCH64_ADD_LO12:
5130               if (htab->root.dynobj == NULL)
5131                 htab->root.dynobj = abfd;
5132               if (!_bfd_elf_create_ifunc_sections (htab->root.dynobj, info))
5133                 return FALSE;
5134               break;
5135             }
5136
5137           /* It is referenced by a non-shared object. */
5138           h->ref_regular = 1;
5139           h->root.non_ir_ref = 1;
5140         }
5141
5142       switch (bfd_r_type)
5143         {
5144         case BFD_RELOC_AARCH64_NN:
5145
5146           /* We don't need to handle relocs into sections not going into
5147              the "real" output.  */
5148           if ((sec->flags & SEC_ALLOC) == 0)
5149             break;
5150
5151           if (h != NULL)
5152             {
5153               if (!info->shared)
5154                 h->non_got_ref = 1;
5155
5156               h->plt.refcount += 1;
5157               h->pointer_equality_needed = 1;
5158             }
5159
5160           /* No need to do anything if we're not creating a shared
5161              object.  */
5162           if (! info->shared)
5163             break;
5164
5165           {
5166             struct elf_dyn_relocs *p;
5167             struct elf_dyn_relocs **head;
5168
5169             /* We must copy these reloc types into the output file.
5170                Create a reloc section in dynobj and make room for
5171                this reloc.  */
5172             if (sreloc == NULL)
5173               {
5174                 if (htab->root.dynobj == NULL)
5175                   htab->root.dynobj = abfd;
5176
5177                 sreloc = _bfd_elf_make_dynamic_reloc_section
5178                   (sec, htab->root.dynobj, LOG_FILE_ALIGN, abfd, /*rela? */ TRUE);
5179
5180                 if (sreloc == NULL)
5181                   return FALSE;
5182               }
5183
5184             /* If this is a global symbol, we count the number of
5185                relocations we need for this symbol.  */
5186             if (h != NULL)
5187               {
5188                 struct elf_aarch64_link_hash_entry *eh;
5189                 eh = (struct elf_aarch64_link_hash_entry *) h;
5190                 head = &eh->dyn_relocs;
5191               }
5192             else
5193               {
5194                 /* Track dynamic relocs needed for local syms too.
5195                    We really need local syms available to do this
5196                    easily.  Oh well.  */
5197
5198                 asection *s;
5199                 void **vpp;
5200
5201                 isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5202                                               abfd, r_symndx);
5203                 if (isym == NULL)
5204                   return FALSE;
5205
5206                 s = bfd_section_from_elf_index (abfd, isym->st_shndx);
5207                 if (s == NULL)
5208                   s = sec;
5209
5210                 /* Beware of type punned pointers vs strict aliasing
5211                    rules.  */
5212                 vpp = &(elf_section_data (s)->local_dynrel);
5213                 head = (struct elf_dyn_relocs **) vpp;
5214               }
5215
5216             p = *head;
5217             if (p == NULL || p->sec != sec)
5218               {
5219                 bfd_size_type amt = sizeof *p;
5220                 p = ((struct elf_dyn_relocs *)
5221                      bfd_zalloc (htab->root.dynobj, amt));
5222                 if (p == NULL)
5223                   return FALSE;
5224                 p->next = *head;
5225                 *head = p;
5226                 p->sec = sec;
5227               }
5228
5229             p->count += 1;
5230
5231           }
5232           break;
5233
5234           /* RR: We probably want to keep a consistency check that
5235              there are no dangling GOT_PAGE relocs.  */
5236         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5237         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5238         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5239         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5240         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
5241         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
5242         case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
5243         case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
5244         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
5245         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
5246         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
5247         case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
5248         case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
5249         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
5250         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
5251         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
5252         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
5253         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
5254         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
5255         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
5256         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
5257           {
5258             unsigned got_type;
5259             unsigned old_got_type;
5260
5261             got_type = aarch64_reloc_got_type (bfd_r_type);
5262
5263             if (h)
5264               {
5265                 h->got.refcount += 1;
5266                 old_got_type = elf_aarch64_hash_entry (h)->got_type;
5267               }
5268             else
5269               {
5270                 struct elf_aarch64_local_symbol *locals;
5271
5272                 if (!elfNN_aarch64_allocate_local_symbols
5273                     (abfd, symtab_hdr->sh_info))
5274                   return FALSE;
5275
5276                 locals = elf_aarch64_locals (abfd);
5277                 BFD_ASSERT (r_symndx < symtab_hdr->sh_info);
5278                 locals[r_symndx].got_refcount += 1;
5279                 old_got_type = locals[r_symndx].got_type;
5280               }
5281
5282             /* If a variable is accessed with both general dynamic TLS
5283                methods, two slots may be created.  */
5284             if (GOT_TLS_GD_ANY_P (old_got_type) && GOT_TLS_GD_ANY_P (got_type))
5285               got_type |= old_got_type;
5286
5287             /* We will already have issued an error message if there
5288                is a TLS/non-TLS mismatch, based on the symbol type.
5289                So just combine any TLS types needed.  */
5290             if (old_got_type != GOT_UNKNOWN && old_got_type != GOT_NORMAL
5291                 && got_type != GOT_NORMAL)
5292               got_type |= old_got_type;
5293
5294             /* If the symbol is accessed by both IE and GD methods, we
5295                are able to relax.  Turn off the GD flag, without
5296                messing up with any other kind of TLS types that may be
5297                involved.  */
5298             if ((got_type & GOT_TLS_IE) && GOT_TLS_GD_ANY_P (got_type))
5299               got_type &= ~ (GOT_TLSDESC_GD | GOT_TLS_GD);
5300
5301             if (old_got_type != got_type)
5302               {
5303                 if (h != NULL)
5304                   elf_aarch64_hash_entry (h)->got_type = got_type;
5305                 else
5306                   {
5307                     struct elf_aarch64_local_symbol *locals;
5308                     locals = elf_aarch64_locals (abfd);
5309                     BFD_ASSERT (r_symndx < symtab_hdr->sh_info);
5310                     locals[r_symndx].got_type = got_type;
5311                   }
5312               }
5313
5314             if (htab->root.dynobj == NULL)
5315               htab->root.dynobj = abfd;
5316             if (! aarch64_elf_create_got_section (htab->root.dynobj, info))
5317               return FALSE;
5318             break;
5319           }
5320
5321         case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
5322         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5323         case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
5324           if (h != NULL && info->executable)
5325             {
5326               /* If this reloc is in a read-only section, we might
5327                  need a copy reloc.  We can't check reliably at this
5328                  stage whether the section is read-only, as input
5329                  sections have not yet been mapped to output sections.
5330                  Tentatively set the flag for now, and correct in
5331                  adjust_dynamic_symbol.  */
5332               h->non_got_ref = 1;
5333               h->plt.refcount += 1;
5334               h->pointer_equality_needed = 1;
5335             }
5336           /* FIXME:: RR need to handle these in shared libraries
5337              and essentially bomb out as these being non-PIC
5338              relocations in shared libraries.  */
5339           break;
5340
5341         case BFD_RELOC_AARCH64_CALL26:
5342         case BFD_RELOC_AARCH64_JUMP26:
5343           /* If this is a local symbol then we resolve it
5344              directly without creating a PLT entry.  */
5345           if (h == NULL)
5346             continue;
5347
5348           h->needs_plt = 1;
5349           if (h->plt.refcount <= 0)
5350             h->plt.refcount = 1;
5351           else
5352             h->plt.refcount += 1;
5353           break;
5354
5355         default:
5356           break;
5357         }
5358     }
5359
5360   return TRUE;
5361 }
5362
5363 /* Treat mapping symbols as special target symbols.  */
5364
5365 static bfd_boolean
5366 elfNN_aarch64_is_target_special_symbol (bfd *abfd ATTRIBUTE_UNUSED,
5367                                         asymbol *sym)
5368 {
5369   return bfd_is_aarch64_special_symbol_name (sym->name,
5370                                              BFD_AARCH64_SPECIAL_SYM_TYPE_ANY);
5371 }
5372
5373 /* This is a copy of elf_find_function () from elf.c except that
5374    AArch64 mapping symbols are ignored when looking for function names.  */
5375
5376 static bfd_boolean
5377 aarch64_elf_find_function (bfd *abfd ATTRIBUTE_UNUSED,
5378                            asection *section,
5379                            asymbol **symbols,
5380                            bfd_vma offset,
5381                            const char **filename_ptr,
5382                            const char **functionname_ptr)
5383 {
5384   const char *filename = NULL;
5385   asymbol *func = NULL;
5386   bfd_vma low_func = 0;
5387   asymbol **p;
5388
5389   for (p = symbols; *p != NULL; p++)
5390     {
5391       elf_symbol_type *q;
5392
5393       q = (elf_symbol_type *) * p;
5394
5395       switch (ELF_ST_TYPE (q->internal_elf_sym.st_info))
5396         {
5397         default:
5398           break;
5399         case STT_FILE:
5400           filename = bfd_asymbol_name (&q->symbol);
5401           break;
5402         case STT_FUNC:
5403         case STT_NOTYPE:
5404           /* Skip mapping symbols.  */
5405           if ((q->symbol.flags & BSF_LOCAL)
5406               && (bfd_is_aarch64_special_symbol_name
5407                   (q->symbol.name, BFD_AARCH64_SPECIAL_SYM_TYPE_ANY)))
5408             continue;
5409           /* Fall through.  */
5410           if (bfd_get_section (&q->symbol) == section
5411               && q->symbol.value >= low_func && q->symbol.value <= offset)
5412             {
5413               func = (asymbol *) q;
5414               low_func = q->symbol.value;
5415             }
5416           break;
5417         }
5418     }
5419
5420   if (func == NULL)
5421     return FALSE;
5422
5423   if (filename_ptr)
5424     *filename_ptr = filename;
5425   if (functionname_ptr)
5426     *functionname_ptr = bfd_asymbol_name (func);
5427
5428   return TRUE;
5429 }
5430
5431
5432 /* Find the nearest line to a particular section and offset, for error
5433    reporting.   This code is a duplicate of the code in elf.c, except
5434    that it uses aarch64_elf_find_function.  */
5435
5436 static bfd_boolean
5437 elfNN_aarch64_find_nearest_line (bfd *abfd,
5438                                  asection *section,
5439                                  asymbol **symbols,
5440                                  bfd_vma offset,
5441                                  const char **filename_ptr,
5442                                  const char **functionname_ptr,
5443                                  unsigned int *line_ptr)
5444 {
5445   bfd_boolean found = FALSE;
5446
5447   /* We skip _bfd_dwarf1_find_nearest_line since no known AArch64
5448      toolchain uses it.  */
5449
5450   if (_bfd_dwarf2_find_nearest_line (abfd, dwarf_debug_sections,
5451                                      section, symbols, offset,
5452                                      filename_ptr, functionname_ptr,
5453                                      line_ptr, NULL, 0,
5454                                      &elf_tdata (abfd)->dwarf2_find_line_info))
5455     {
5456       if (!*functionname_ptr)
5457         aarch64_elf_find_function (abfd, section, symbols, offset,
5458                                    *filename_ptr ? NULL : filename_ptr,
5459                                    functionname_ptr);
5460
5461       return TRUE;
5462     }
5463
5464   if (!_bfd_stab_section_find_nearest_line (abfd, symbols, section, offset,
5465                                             &found, filename_ptr,
5466                                             functionname_ptr, line_ptr,
5467                                             &elf_tdata (abfd)->line_info))
5468     return FALSE;
5469
5470   if (found && (*functionname_ptr || *line_ptr))
5471     return TRUE;
5472
5473   if (symbols == NULL)
5474     return FALSE;
5475
5476   if (!aarch64_elf_find_function (abfd, section, symbols, offset,
5477                                   filename_ptr, functionname_ptr))
5478     return FALSE;
5479
5480   *line_ptr = 0;
5481   return TRUE;
5482 }
5483
5484 static bfd_boolean
5485 elfNN_aarch64_find_inliner_info (bfd *abfd,
5486                                  const char **filename_ptr,
5487                                  const char **functionname_ptr,
5488                                  unsigned int *line_ptr)
5489 {
5490   bfd_boolean found;
5491   found = _bfd_dwarf2_find_inliner_info
5492     (abfd, filename_ptr,
5493      functionname_ptr, line_ptr, &elf_tdata (abfd)->dwarf2_find_line_info);
5494   return found;
5495 }
5496
5497
5498 static void
5499 elfNN_aarch64_post_process_headers (bfd *abfd,
5500                                     struct bfd_link_info *link_info)
5501 {
5502   Elf_Internal_Ehdr *i_ehdrp;   /* ELF file header, internal form.  */
5503
5504   i_ehdrp = elf_elfheader (abfd);
5505   i_ehdrp->e_ident[EI_ABIVERSION] = AARCH64_ELF_ABI_VERSION;
5506
5507   _bfd_elf_set_osabi (abfd, link_info);
5508 }
5509
5510 static enum elf_reloc_type_class
5511 elfNN_aarch64_reloc_type_class (const struct bfd_link_info *info ATTRIBUTE_UNUSED,
5512                                 const asection *rel_sec ATTRIBUTE_UNUSED,
5513                                 const Elf_Internal_Rela *rela)
5514 {
5515   switch ((int) ELFNN_R_TYPE (rela->r_info))
5516     {
5517     case AARCH64_R (RELATIVE):
5518       return reloc_class_relative;
5519     case AARCH64_R (JUMP_SLOT):
5520       return reloc_class_plt;
5521     case AARCH64_R (COPY):
5522       return reloc_class_copy;
5523     default:
5524       return reloc_class_normal;
5525     }
5526 }
5527
5528 /* Set the right machine number for an AArch64 ELF file.  */
5529
5530 static bfd_boolean
5531 elfNN_aarch64_section_flags (flagword *flags, const Elf_Internal_Shdr *hdr)
5532 {
5533   if (hdr->sh_type == SHT_NOTE)
5534     *flags |= SEC_LINK_ONCE | SEC_LINK_DUPLICATES_SAME_CONTENTS;
5535
5536   return TRUE;
5537 }
5538
5539 /* Handle an AArch64 specific section when reading an object file.  This is
5540    called when bfd_section_from_shdr finds a section with an unknown
5541    type.  */
5542
5543 static bfd_boolean
5544 elfNN_aarch64_section_from_shdr (bfd *abfd,
5545                                  Elf_Internal_Shdr *hdr,
5546                                  const char *name, int shindex)
5547 {
5548   /* There ought to be a place to keep ELF backend specific flags, but
5549      at the moment there isn't one.  We just keep track of the
5550      sections by their name, instead.  Fortunately, the ABI gives
5551      names for all the AArch64 specific sections, so we will probably get
5552      away with this.  */
5553   switch (hdr->sh_type)
5554     {
5555     case SHT_AARCH64_ATTRIBUTES:
5556       break;
5557
5558     default:
5559       return FALSE;
5560     }
5561
5562   if (!_bfd_elf_make_section_from_shdr (abfd, hdr, name, shindex))
5563     return FALSE;
5564
5565   return TRUE;
5566 }
5567
5568 /* A structure used to record a list of sections, independently
5569    of the next and prev fields in the asection structure.  */
5570 typedef struct section_list
5571 {
5572   asection *sec;
5573   struct section_list *next;
5574   struct section_list *prev;
5575 }
5576 section_list;
5577
5578 /* Unfortunately we need to keep a list of sections for which
5579    an _aarch64_elf_section_data structure has been allocated.  This
5580    is because it is possible for functions like elfNN_aarch64_write_section
5581    to be called on a section which has had an elf_data_structure
5582    allocated for it (and so the used_by_bfd field is valid) but
5583    for which the AArch64 extended version of this structure - the
5584    _aarch64_elf_section_data structure - has not been allocated.  */
5585 static section_list *sections_with_aarch64_elf_section_data = NULL;
5586
5587 static void
5588 record_section_with_aarch64_elf_section_data (asection *sec)
5589 {
5590   struct section_list *entry;
5591
5592   entry = bfd_malloc (sizeof (*entry));
5593   if (entry == NULL)
5594     return;
5595   entry->sec = sec;
5596   entry->next = sections_with_aarch64_elf_section_data;
5597   entry->prev = NULL;
5598   if (entry->next != NULL)
5599     entry->next->prev = entry;
5600   sections_with_aarch64_elf_section_data = entry;
5601 }
5602
5603 static struct section_list *
5604 find_aarch64_elf_section_entry (asection *sec)
5605 {
5606   struct section_list *entry;
5607   static struct section_list *last_entry = NULL;
5608
5609   /* This is a short cut for the typical case where the sections are added
5610      to the sections_with_aarch64_elf_section_data list in forward order and
5611      then looked up here in backwards order.  This makes a real difference
5612      to the ld-srec/sec64k.exp linker test.  */
5613   entry = sections_with_aarch64_elf_section_data;
5614   if (last_entry != NULL)
5615     {
5616       if (last_entry->sec == sec)
5617         entry = last_entry;
5618       else if (last_entry->next != NULL && last_entry->next->sec == sec)
5619         entry = last_entry->next;
5620     }
5621
5622   for (; entry; entry = entry->next)
5623     if (entry->sec == sec)
5624       break;
5625
5626   if (entry)
5627     /* Record the entry prior to this one - it is the entry we are
5628        most likely to want to locate next time.  Also this way if we
5629        have been called from
5630        unrecord_section_with_aarch64_elf_section_data () we will not
5631        be caching a pointer that is about to be freed.  */
5632     last_entry = entry->prev;
5633
5634   return entry;
5635 }
5636
5637 static void
5638 unrecord_section_with_aarch64_elf_section_data (asection *sec)
5639 {
5640   struct section_list *entry;
5641
5642   entry = find_aarch64_elf_section_entry (sec);
5643
5644   if (entry)
5645     {
5646       if (entry->prev != NULL)
5647         entry->prev->next = entry->next;
5648       if (entry->next != NULL)
5649         entry->next->prev = entry->prev;
5650       if (entry == sections_with_aarch64_elf_section_data)
5651         sections_with_aarch64_elf_section_data = entry->next;
5652       free (entry);
5653     }
5654 }
5655
5656
5657 typedef struct
5658 {
5659   void *finfo;
5660   struct bfd_link_info *info;
5661   asection *sec;
5662   int sec_shndx;
5663   int (*func) (void *, const char *, Elf_Internal_Sym *,
5664                asection *, struct elf_link_hash_entry *);
5665 } output_arch_syminfo;
5666
5667 enum map_symbol_type
5668 {
5669   AARCH64_MAP_INSN,
5670   AARCH64_MAP_DATA
5671 };
5672
5673
5674 /* Output a single mapping symbol.  */
5675
5676 static bfd_boolean
5677 elfNN_aarch64_output_map_sym (output_arch_syminfo *osi,
5678                               enum map_symbol_type type, bfd_vma offset)
5679 {
5680   static const char *names[2] = { "$x", "$d" };
5681   Elf_Internal_Sym sym;
5682
5683   sym.st_value = (osi->sec->output_section->vma
5684                   + osi->sec->output_offset + offset);
5685   sym.st_size = 0;
5686   sym.st_other = 0;
5687   sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_NOTYPE);
5688   sym.st_shndx = osi->sec_shndx;
5689   return osi->func (osi->finfo, names[type], &sym, osi->sec, NULL) == 1;
5690 }
5691
5692
5693
5694 /* Output mapping symbols for PLT entries associated with H.  */
5695
5696 static bfd_boolean
5697 elfNN_aarch64_output_plt_map (struct elf_link_hash_entry *h, void *inf)
5698 {
5699   output_arch_syminfo *osi = (output_arch_syminfo *) inf;
5700   bfd_vma addr;
5701
5702   if (h->root.type == bfd_link_hash_indirect)
5703     return TRUE;
5704
5705   if (h->root.type == bfd_link_hash_warning)
5706     /* When warning symbols are created, they **replace** the "real"
5707        entry in the hash table, thus we never get to see the real
5708        symbol in a hash traversal.  So look at it now.  */
5709     h = (struct elf_link_hash_entry *) h->root.u.i.link;
5710
5711   if (h->plt.offset == (bfd_vma) - 1)
5712     return TRUE;
5713
5714   addr = h->plt.offset;
5715   if (addr == 32)
5716     {
5717       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
5718         return FALSE;
5719     }
5720   return TRUE;
5721 }
5722
5723
5724 /* Output a single local symbol for a generated stub.  */
5725
5726 static bfd_boolean
5727 elfNN_aarch64_output_stub_sym (output_arch_syminfo *osi, const char *name,
5728                                bfd_vma offset, bfd_vma size)
5729 {
5730   Elf_Internal_Sym sym;
5731
5732   sym.st_value = (osi->sec->output_section->vma
5733                   + osi->sec->output_offset + offset);
5734   sym.st_size = size;
5735   sym.st_other = 0;
5736   sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_FUNC);
5737   sym.st_shndx = osi->sec_shndx;
5738   return osi->func (osi->finfo, name, &sym, osi->sec, NULL) == 1;
5739 }
5740
5741 static bfd_boolean
5742 aarch64_map_one_stub (struct bfd_hash_entry *gen_entry, void *in_arg)
5743 {
5744   struct elf_aarch64_stub_hash_entry *stub_entry;
5745   asection *stub_sec;
5746   bfd_vma addr;
5747   char *stub_name;
5748   output_arch_syminfo *osi;
5749
5750   /* Massage our args to the form they really have.  */
5751   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
5752   osi = (output_arch_syminfo *) in_arg;
5753
5754   stub_sec = stub_entry->stub_sec;
5755
5756   /* Ensure this stub is attached to the current section being
5757      processed.  */
5758   if (stub_sec != osi->sec)
5759     return TRUE;
5760
5761   addr = (bfd_vma) stub_entry->stub_offset;
5762
5763   stub_name = stub_entry->output_name;
5764
5765   switch (stub_entry->stub_type)
5766     {
5767     case aarch64_stub_adrp_branch:
5768       if (!elfNN_aarch64_output_stub_sym (osi, stub_name, addr,
5769                                           sizeof (aarch64_adrp_branch_stub)))
5770         return FALSE;
5771       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
5772         return FALSE;
5773       break;
5774     case aarch64_stub_long_branch:
5775       if (!elfNN_aarch64_output_stub_sym
5776           (osi, stub_name, addr, sizeof (aarch64_long_branch_stub)))
5777         return FALSE;
5778       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
5779         return FALSE;
5780       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_DATA, addr + 16))
5781         return FALSE;
5782       break;
5783     default:
5784       BFD_FAIL ();
5785     }
5786
5787   return TRUE;
5788 }
5789
5790 /* Output mapping symbols for linker generated sections.  */
5791
5792 static bfd_boolean
5793 elfNN_aarch64_output_arch_local_syms (bfd *output_bfd,
5794                                       struct bfd_link_info *info,
5795                                       void *finfo,
5796                                       int (*func) (void *, const char *,
5797                                                    Elf_Internal_Sym *,
5798                                                    asection *,
5799                                                    struct elf_link_hash_entry
5800                                                    *))
5801 {
5802   output_arch_syminfo osi;
5803   struct elf_aarch64_link_hash_table *htab;
5804
5805   htab = elf_aarch64_hash_table (info);
5806
5807   osi.finfo = finfo;
5808   osi.info = info;
5809   osi.func = func;
5810
5811   /* Long calls stubs.  */
5812   if (htab->stub_bfd && htab->stub_bfd->sections)
5813     {
5814       asection *stub_sec;
5815
5816       for (stub_sec = htab->stub_bfd->sections;
5817            stub_sec != NULL; stub_sec = stub_sec->next)
5818         {
5819           /* Ignore non-stub sections.  */
5820           if (!strstr (stub_sec->name, STUB_SUFFIX))
5821             continue;
5822
5823           osi.sec = stub_sec;
5824
5825           osi.sec_shndx = _bfd_elf_section_from_bfd_section
5826             (output_bfd, osi.sec->output_section);
5827
5828           bfd_hash_traverse (&htab->stub_hash_table, aarch64_map_one_stub,
5829                              &osi);
5830         }
5831     }
5832
5833   /* Finally, output mapping symbols for the PLT.  */
5834   if (!htab->root.splt || htab->root.splt->size == 0)
5835     return TRUE;
5836
5837   /* For now live without mapping symbols for the plt.  */
5838   osi.sec_shndx = _bfd_elf_section_from_bfd_section
5839     (output_bfd, htab->root.splt->output_section);
5840   osi.sec = htab->root.splt;
5841
5842   elf_link_hash_traverse (&htab->root, elfNN_aarch64_output_plt_map,
5843                           (void *) &osi);
5844
5845   return TRUE;
5846
5847 }
5848
5849 /* Allocate target specific section data.  */
5850
5851 static bfd_boolean
5852 elfNN_aarch64_new_section_hook (bfd *abfd, asection *sec)
5853 {
5854   if (!sec->used_by_bfd)
5855     {
5856       _aarch64_elf_section_data *sdata;
5857       bfd_size_type amt = sizeof (*sdata);
5858
5859       sdata = bfd_zalloc (abfd, amt);
5860       if (sdata == NULL)
5861         return FALSE;
5862       sec->used_by_bfd = sdata;
5863     }
5864
5865   record_section_with_aarch64_elf_section_data (sec);
5866
5867   return _bfd_elf_new_section_hook (abfd, sec);
5868 }
5869
5870
5871 static void
5872 unrecord_section_via_map_over_sections (bfd *abfd ATTRIBUTE_UNUSED,
5873                                         asection *sec,
5874                                         void *ignore ATTRIBUTE_UNUSED)
5875 {
5876   unrecord_section_with_aarch64_elf_section_data (sec);
5877 }
5878
5879 static bfd_boolean
5880 elfNN_aarch64_close_and_cleanup (bfd *abfd)
5881 {
5882   if (abfd->sections)
5883     bfd_map_over_sections (abfd,
5884                            unrecord_section_via_map_over_sections, NULL);
5885
5886   return _bfd_elf_close_and_cleanup (abfd);
5887 }
5888
5889 static bfd_boolean
5890 elfNN_aarch64_bfd_free_cached_info (bfd *abfd)
5891 {
5892   if (abfd->sections)
5893     bfd_map_over_sections (abfd,
5894                            unrecord_section_via_map_over_sections, NULL);
5895
5896   return _bfd_free_cached_info (abfd);
5897 }
5898
5899 /* Create dynamic sections. This is different from the ARM backend in that
5900    the got, plt, gotplt and their relocation sections are all created in the
5901    standard part of the bfd elf backend.  */
5902
5903 static bfd_boolean
5904 elfNN_aarch64_create_dynamic_sections (bfd *dynobj,
5905                                        struct bfd_link_info *info)
5906 {
5907   struct elf_aarch64_link_hash_table *htab;
5908
5909   /* We need to create .got section.  */
5910   if (!aarch64_elf_create_got_section (dynobj, info))
5911     return FALSE;
5912
5913   if (!_bfd_elf_create_dynamic_sections (dynobj, info))
5914     return FALSE;
5915
5916   htab = elf_aarch64_hash_table (info);
5917   htab->sdynbss = bfd_get_linker_section (dynobj, ".dynbss");
5918   if (!info->shared)
5919     htab->srelbss = bfd_get_linker_section (dynobj, ".rela.bss");
5920
5921   if (!htab->sdynbss || (!info->shared && !htab->srelbss))
5922     abort ();
5923
5924   return TRUE;
5925 }
5926
5927
5928 /* Allocate space in .plt, .got and associated reloc sections for
5929    dynamic relocs.  */
5930
5931 static bfd_boolean
5932 elfNN_aarch64_allocate_dynrelocs (struct elf_link_hash_entry *h, void *inf)
5933 {
5934   struct bfd_link_info *info;
5935   struct elf_aarch64_link_hash_table *htab;
5936   struct elf_aarch64_link_hash_entry *eh;
5937   struct elf_dyn_relocs *p;
5938
5939   /* An example of a bfd_link_hash_indirect symbol is versioned
5940      symbol. For example: __gxx_personality_v0(bfd_link_hash_indirect)
5941      -> __gxx_personality_v0(bfd_link_hash_defined)
5942
5943      There is no need to process bfd_link_hash_indirect symbols here
5944      because we will also be presented with the concrete instance of
5945      the symbol and elfNN_aarch64_copy_indirect_symbol () will have been
5946      called to copy all relevant data from the generic to the concrete
5947      symbol instance.
5948    */
5949   if (h->root.type == bfd_link_hash_indirect)
5950     return TRUE;
5951
5952   if (h->root.type == bfd_link_hash_warning)
5953     h = (struct elf_link_hash_entry *) h->root.u.i.link;
5954
5955   info = (struct bfd_link_info *) inf;
5956   htab = elf_aarch64_hash_table (info);
5957
5958   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle it
5959      here if it is defined and referenced in a non-shared object.  */
5960   if (h->type == STT_GNU_IFUNC
5961       && h->def_regular)
5962     return TRUE;
5963   else if (htab->root.dynamic_sections_created && h->plt.refcount > 0)
5964     {
5965       /* Make sure this symbol is output as a dynamic symbol.
5966          Undefined weak syms won't yet be marked as dynamic.  */
5967       if (h->dynindx == -1 && !h->forced_local)
5968         {
5969           if (!bfd_elf_link_record_dynamic_symbol (info, h))
5970             return FALSE;
5971         }
5972
5973       if (info->shared || WILL_CALL_FINISH_DYNAMIC_SYMBOL (1, 0, h))
5974         {
5975           asection *s = htab->root.splt;
5976
5977           /* If this is the first .plt entry, make room for the special
5978              first entry.  */
5979           if (s->size == 0)
5980             s->size += htab->plt_header_size;
5981
5982           h->plt.offset = s->size;
5983
5984           /* If this symbol is not defined in a regular file, and we are
5985              not generating a shared library, then set the symbol to this
5986              location in the .plt.  This is required to make function
5987              pointers compare as equal between the normal executable and
5988              the shared library.  */
5989           if (!info->shared && !h->def_regular)
5990             {
5991               h->root.u.def.section = s;
5992               h->root.u.def.value = h->plt.offset;
5993             }
5994
5995           /* Make room for this entry. For now we only create the
5996              small model PLT entries. We later need to find a way
5997              of relaxing into these from the large model PLT entries.  */
5998           s->size += PLT_SMALL_ENTRY_SIZE;
5999
6000           /* We also need to make an entry in the .got.plt section, which
6001              will be placed in the .got section by the linker script.  */
6002           htab->root.sgotplt->size += GOT_ENTRY_SIZE;
6003
6004           /* We also need to make an entry in the .rela.plt section.  */
6005           htab->root.srelplt->size += RELOC_SIZE (htab);
6006
6007           /* We need to ensure that all GOT entries that serve the PLT
6008              are consecutive with the special GOT slots [0] [1] and
6009              [2]. Any addtional relocations, such as
6010              R_AARCH64_TLSDESC, must be placed after the PLT related
6011              entries.  We abuse the reloc_count such that during
6012              sizing we adjust reloc_count to indicate the number of
6013              PLT related reserved entries.  In subsequent phases when
6014              filling in the contents of the reloc entries, PLT related
6015              entries are placed by computing their PLT index (0
6016              .. reloc_count). While other none PLT relocs are placed
6017              at the slot indicated by reloc_count and reloc_count is
6018              updated.  */
6019
6020           htab->root.srelplt->reloc_count++;
6021         }
6022       else
6023         {
6024           h->plt.offset = (bfd_vma) - 1;
6025           h->needs_plt = 0;
6026         }
6027     }
6028   else
6029     {
6030       h->plt.offset = (bfd_vma) - 1;
6031       h->needs_plt = 0;
6032     }
6033
6034   eh = (struct elf_aarch64_link_hash_entry *) h;
6035   eh->tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
6036
6037   if (h->got.refcount > 0)
6038     {
6039       bfd_boolean dyn;
6040       unsigned got_type = elf_aarch64_hash_entry (h)->got_type;
6041
6042       h->got.offset = (bfd_vma) - 1;
6043
6044       dyn = htab->root.dynamic_sections_created;
6045
6046       /* Make sure this symbol is output as a dynamic symbol.
6047          Undefined weak syms won't yet be marked as dynamic.  */
6048       if (dyn && h->dynindx == -1 && !h->forced_local)
6049         {
6050           if (!bfd_elf_link_record_dynamic_symbol (info, h))
6051             return FALSE;
6052         }
6053
6054       if (got_type == GOT_UNKNOWN)
6055         {
6056         }
6057       else if (got_type == GOT_NORMAL)
6058         {
6059           h->got.offset = htab->root.sgot->size;
6060           htab->root.sgot->size += GOT_ENTRY_SIZE;
6061           if ((ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
6062                || h->root.type != bfd_link_hash_undefweak)
6063               && (info->shared
6064                   || WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, 0, h)))
6065             {
6066               htab->root.srelgot->size += RELOC_SIZE (htab);
6067             }
6068         }
6069       else
6070         {
6071           int indx;
6072           if (got_type & GOT_TLSDESC_GD)
6073             {
6074               eh->tlsdesc_got_jump_table_offset =
6075                 (htab->root.sgotplt->size
6076                  - aarch64_compute_jump_table_size (htab));
6077               htab->root.sgotplt->size += GOT_ENTRY_SIZE * 2;
6078               h->got.offset = (bfd_vma) - 2;
6079             }
6080
6081           if (got_type & GOT_TLS_GD)
6082             {
6083               h->got.offset = htab->root.sgot->size;
6084               htab->root.sgot->size += GOT_ENTRY_SIZE * 2;
6085             }
6086
6087           if (got_type & GOT_TLS_IE)
6088             {
6089               h->got.offset = htab->root.sgot->size;
6090               htab->root.sgot->size += GOT_ENTRY_SIZE;
6091             }
6092
6093           indx = h && h->dynindx != -1 ? h->dynindx : 0;
6094           if ((ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
6095                || h->root.type != bfd_link_hash_undefweak)
6096               && (info->shared
6097                   || indx != 0
6098                   || WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, 0, h)))
6099             {
6100               if (got_type & GOT_TLSDESC_GD)
6101                 {
6102                   htab->root.srelplt->size += RELOC_SIZE (htab);
6103                   /* Note reloc_count not incremented here!  We have
6104                      already adjusted reloc_count for this relocation
6105                      type.  */
6106
6107                   /* TLSDESC PLT is now needed, but not yet determined.  */
6108                   htab->tlsdesc_plt = (bfd_vma) - 1;
6109                 }
6110
6111               if (got_type & GOT_TLS_GD)
6112                 htab->root.srelgot->size += RELOC_SIZE (htab) * 2;
6113
6114               if (got_type & GOT_TLS_IE)
6115                 htab->root.srelgot->size += RELOC_SIZE (htab);
6116             }
6117         }
6118     }
6119   else
6120     {
6121       h->got.offset = (bfd_vma) - 1;
6122     }
6123
6124   if (eh->dyn_relocs == NULL)
6125     return TRUE;
6126
6127   /* In the shared -Bsymbolic case, discard space allocated for
6128      dynamic pc-relative relocs against symbols which turn out to be
6129      defined in regular objects.  For the normal shared case, discard
6130      space for pc-relative relocs that have become local due to symbol
6131      visibility changes.  */
6132
6133   if (info->shared)
6134     {
6135       /* Relocs that use pc_count are those that appear on a call
6136          insn, or certain REL relocs that can generated via assembly.
6137          We want calls to protected symbols to resolve directly to the
6138          function rather than going via the plt.  If people want
6139          function pointer comparisons to work as expected then they
6140          should avoid writing weird assembly.  */
6141       if (SYMBOL_CALLS_LOCAL (info, h))
6142         {
6143           struct elf_dyn_relocs **pp;
6144
6145           for (pp = &eh->dyn_relocs; (p = *pp) != NULL;)
6146             {
6147               p->count -= p->pc_count;
6148               p->pc_count = 0;
6149               if (p->count == 0)
6150                 *pp = p->next;
6151               else
6152                 pp = &p->next;
6153             }
6154         }
6155
6156       /* Also discard relocs on undefined weak syms with non-default
6157          visibility.  */
6158       if (eh->dyn_relocs != NULL && h->root.type == bfd_link_hash_undefweak)
6159         {
6160           if (ELF_ST_VISIBILITY (h->other) != STV_DEFAULT)
6161             eh->dyn_relocs = NULL;
6162
6163           /* Make sure undefined weak symbols are output as a dynamic
6164              symbol in PIEs.  */
6165           else if (h->dynindx == -1
6166                    && !h->forced_local
6167                    && !bfd_elf_link_record_dynamic_symbol (info, h))
6168             return FALSE;
6169         }
6170
6171     }
6172   else if (ELIMINATE_COPY_RELOCS)
6173     {
6174       /* For the non-shared case, discard space for relocs against
6175          symbols which turn out to need copy relocs or are not
6176          dynamic.  */
6177
6178       if (!h->non_got_ref
6179           && ((h->def_dynamic
6180                && !h->def_regular)
6181               || (htab->root.dynamic_sections_created
6182                   && (h->root.type == bfd_link_hash_undefweak
6183                       || h->root.type == bfd_link_hash_undefined))))
6184         {
6185           /* Make sure this symbol is output as a dynamic symbol.
6186              Undefined weak syms won't yet be marked as dynamic.  */
6187           if (h->dynindx == -1
6188               && !h->forced_local
6189               && !bfd_elf_link_record_dynamic_symbol (info, h))
6190             return FALSE;
6191
6192           /* If that succeeded, we know we'll be keeping all the
6193              relocs.  */
6194           if (h->dynindx != -1)
6195             goto keep;
6196         }
6197
6198       eh->dyn_relocs = NULL;
6199
6200     keep:;
6201     }
6202
6203   /* Finally, allocate space.  */
6204   for (p = eh->dyn_relocs; p != NULL; p = p->next)
6205     {
6206       asection *sreloc;
6207
6208       sreloc = elf_section_data (p->sec)->sreloc;
6209
6210       BFD_ASSERT (sreloc != NULL);
6211
6212       sreloc->size += p->count * RELOC_SIZE (htab);
6213     }
6214
6215   return TRUE;
6216 }
6217
6218 /* Allocate space in .plt, .got and associated reloc sections for
6219    ifunc dynamic relocs.  */
6220
6221 static bfd_boolean
6222 elfNN_aarch64_allocate_ifunc_dynrelocs (struct elf_link_hash_entry *h,
6223                                         void *inf)
6224 {
6225   struct bfd_link_info *info;
6226   struct elf_aarch64_link_hash_table *htab;
6227   struct elf_aarch64_link_hash_entry *eh;
6228
6229   /* An example of a bfd_link_hash_indirect symbol is versioned
6230      symbol. For example: __gxx_personality_v0(bfd_link_hash_indirect)
6231      -> __gxx_personality_v0(bfd_link_hash_defined)
6232
6233      There is no need to process bfd_link_hash_indirect symbols here
6234      because we will also be presented with the concrete instance of
6235      the symbol and elfNN_aarch64_copy_indirect_symbol () will have been
6236      called to copy all relevant data from the generic to the concrete
6237      symbol instance.
6238    */
6239   if (h->root.type == bfd_link_hash_indirect)
6240     return TRUE;
6241
6242   if (h->root.type == bfd_link_hash_warning)
6243     h = (struct elf_link_hash_entry *) h->root.u.i.link;
6244
6245   info = (struct bfd_link_info *) inf;
6246   htab = elf_aarch64_hash_table (info);
6247
6248   eh = (struct elf_aarch64_link_hash_entry *) h;
6249
6250   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle it
6251      here if it is defined and referenced in a non-shared object.  */
6252   if (h->type == STT_GNU_IFUNC
6253       && h->def_regular)
6254     return _bfd_elf_allocate_ifunc_dyn_relocs (info, h,
6255                                                &eh->dyn_relocs,
6256                                                htab->plt_entry_size,
6257                                                htab->plt_header_size,
6258                                                GOT_ENTRY_SIZE);
6259   return TRUE;
6260 }
6261
6262 /* Allocate space in .plt, .got and associated reloc sections for
6263    local dynamic relocs.  */
6264
6265 static bfd_boolean
6266 elfNN_aarch64_allocate_local_dynrelocs (void **slot, void *inf)
6267 {
6268   struct elf_link_hash_entry *h
6269     = (struct elf_link_hash_entry *) *slot;
6270
6271   if (h->type != STT_GNU_IFUNC
6272       || !h->def_regular
6273       || !h->ref_regular
6274       || !h->forced_local
6275       || h->root.type != bfd_link_hash_defined)
6276     abort ();
6277
6278   return elfNN_aarch64_allocate_dynrelocs (h, inf);
6279 }
6280
6281 /* Allocate space in .plt, .got and associated reloc sections for
6282    local ifunc dynamic relocs.  */
6283
6284 static bfd_boolean
6285 elfNN_aarch64_allocate_local_ifunc_dynrelocs (void **slot, void *inf)
6286 {
6287   struct elf_link_hash_entry *h
6288     = (struct elf_link_hash_entry *) *slot;
6289
6290   if (h->type != STT_GNU_IFUNC
6291       || !h->def_regular
6292       || !h->ref_regular
6293       || !h->forced_local
6294       || h->root.type != bfd_link_hash_defined)
6295     abort ();
6296
6297   return elfNN_aarch64_allocate_ifunc_dynrelocs (h, inf);
6298 }
6299
6300 /* This is the most important function of all . Innocuosly named
6301    though !  */
6302 static bfd_boolean
6303 elfNN_aarch64_size_dynamic_sections (bfd *output_bfd ATTRIBUTE_UNUSED,
6304                                      struct bfd_link_info *info)
6305 {
6306   struct elf_aarch64_link_hash_table *htab;
6307   bfd *dynobj;
6308   asection *s;
6309   bfd_boolean relocs;
6310   bfd *ibfd;
6311
6312   htab = elf_aarch64_hash_table ((info));
6313   dynobj = htab->root.dynobj;
6314
6315   BFD_ASSERT (dynobj != NULL);
6316
6317   if (htab->root.dynamic_sections_created)
6318     {
6319       if (info->executable)
6320         {
6321           s = bfd_get_linker_section (dynobj, ".interp");
6322           if (s == NULL)
6323             abort ();
6324           s->size = sizeof ELF_DYNAMIC_INTERPRETER;
6325           s->contents = (unsigned char *) ELF_DYNAMIC_INTERPRETER;
6326         }
6327     }
6328
6329   /* Set up .got offsets for local syms, and space for local dynamic
6330      relocs.  */
6331   for (ibfd = info->input_bfds; ibfd != NULL; ibfd = ibfd->link_next)
6332     {
6333       struct elf_aarch64_local_symbol *locals = NULL;
6334       Elf_Internal_Shdr *symtab_hdr;
6335       asection *srel;
6336       unsigned int i;
6337
6338       if (!is_aarch64_elf (ibfd))
6339         continue;
6340
6341       for (s = ibfd->sections; s != NULL; s = s->next)
6342         {
6343           struct elf_dyn_relocs *p;
6344
6345           for (p = (struct elf_dyn_relocs *)
6346                (elf_section_data (s)->local_dynrel); p != NULL; p = p->next)
6347             {
6348               if (!bfd_is_abs_section (p->sec)
6349                   && bfd_is_abs_section (p->sec->output_section))
6350                 {
6351                   /* Input section has been discarded, either because
6352                      it is a copy of a linkonce section or due to
6353                      linker script /DISCARD/, so we'll be discarding
6354                      the relocs too.  */
6355                 }
6356               else if (p->count != 0)
6357                 {
6358                   srel = elf_section_data (p->sec)->sreloc;
6359                   srel->size += p->count * RELOC_SIZE (htab);
6360                   if ((p->sec->output_section->flags & SEC_READONLY) != 0)
6361                     info->flags |= DF_TEXTREL;
6362                 }
6363             }
6364         }
6365
6366       locals = elf_aarch64_locals (ibfd);
6367       if (!locals)
6368         continue;
6369
6370       symtab_hdr = &elf_symtab_hdr (ibfd);
6371       srel = htab->root.srelgot;
6372       for (i = 0; i < symtab_hdr->sh_info; i++)
6373         {
6374           locals[i].got_offset = (bfd_vma) - 1;
6375           locals[i].tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
6376           if (locals[i].got_refcount > 0)
6377             {
6378               unsigned got_type = locals[i].got_type;
6379               if (got_type & GOT_TLSDESC_GD)
6380                 {
6381                   locals[i].tlsdesc_got_jump_table_offset =
6382                     (htab->root.sgotplt->size
6383                      - aarch64_compute_jump_table_size (htab));
6384                   htab->root.sgotplt->size += GOT_ENTRY_SIZE * 2;
6385                   locals[i].got_offset = (bfd_vma) - 2;
6386                 }
6387
6388               if (got_type & GOT_TLS_GD)
6389                 {
6390                   locals[i].got_offset = htab->root.sgot->size;
6391                   htab->root.sgot->size += GOT_ENTRY_SIZE * 2;
6392                 }
6393
6394               if (got_type & GOT_TLS_IE)
6395                 {
6396                   locals[i].got_offset = htab->root.sgot->size;
6397                   htab->root.sgot->size += GOT_ENTRY_SIZE;
6398                 }
6399
6400               if (got_type == GOT_UNKNOWN)
6401                 {
6402                 }
6403
6404               if (got_type == GOT_NORMAL)
6405                 {
6406                 }
6407
6408               if (info->shared)
6409                 {
6410                   if (got_type & GOT_TLSDESC_GD)
6411                     {
6412                       htab->root.srelplt->size += RELOC_SIZE (htab);
6413                       /* Note RELOC_COUNT not incremented here! */
6414                       htab->tlsdesc_plt = (bfd_vma) - 1;
6415                     }
6416
6417                   if (got_type & GOT_TLS_GD)
6418                     htab->root.srelgot->size += RELOC_SIZE (htab) * 2;
6419
6420                   if (got_type & GOT_TLS_IE)
6421                     htab->root.srelgot->size += RELOC_SIZE (htab);
6422                 }
6423             }
6424           else
6425             {
6426               locals[i].got_refcount = (bfd_vma) - 1;
6427             }
6428         }
6429     }
6430
6431
6432   /* Allocate global sym .plt and .got entries, and space for global
6433      sym dynamic relocs.  */
6434   elf_link_hash_traverse (&htab->root, elfNN_aarch64_allocate_dynrelocs,
6435                           info);
6436
6437   /* Allocate global ifunc sym .plt and .got entries, and space for global
6438      ifunc sym dynamic relocs.  */
6439   elf_link_hash_traverse (&htab->root, elfNN_aarch64_allocate_ifunc_dynrelocs,
6440                           info);
6441
6442   /* Allocate .plt and .got entries, and space for local symbols.  */
6443   htab_traverse (htab->loc_hash_table,
6444                  elfNN_aarch64_allocate_local_dynrelocs,
6445                  info);
6446
6447   /* Allocate .plt and .got entries, and space for local ifunc symbols.  */
6448   htab_traverse (htab->loc_hash_table,
6449                  elfNN_aarch64_allocate_local_ifunc_dynrelocs,
6450                  info);
6451
6452   /* For every jump slot reserved in the sgotplt, reloc_count is
6453      incremented.  However, when we reserve space for TLS descriptors,
6454      it's not incremented, so in order to compute the space reserved
6455      for them, it suffices to multiply the reloc count by the jump
6456      slot size.  */
6457
6458   if (htab->root.srelplt)
6459     htab->sgotplt_jump_table_size = aarch64_compute_jump_table_size (htab);
6460
6461   if (htab->tlsdesc_plt)
6462     {
6463       if (htab->root.splt->size == 0)
6464         htab->root.splt->size += PLT_ENTRY_SIZE;
6465
6466       htab->tlsdesc_plt = htab->root.splt->size;
6467       htab->root.splt->size += PLT_TLSDESC_ENTRY_SIZE;
6468
6469       /* If we're not using lazy TLS relocations, don't generate the
6470          GOT entry required.  */
6471       if (!(info->flags & DF_BIND_NOW))
6472         {
6473           htab->dt_tlsdesc_got = htab->root.sgot->size;
6474           htab->root.sgot->size += GOT_ENTRY_SIZE;
6475         }
6476     }
6477
6478   /* We now have determined the sizes of the various dynamic sections.
6479      Allocate memory for them.  */
6480   relocs = FALSE;
6481   for (s = dynobj->sections; s != NULL; s = s->next)
6482     {
6483       if ((s->flags & SEC_LINKER_CREATED) == 0)
6484         continue;
6485
6486       if (s == htab->root.splt
6487           || s == htab->root.sgot
6488           || s == htab->root.sgotplt
6489           || s == htab->root.iplt
6490           || s == htab->root.igotplt || s == htab->sdynbss)
6491         {
6492           /* Strip this section if we don't need it; see the
6493              comment below.  */
6494         }
6495       else if (CONST_STRNEQ (bfd_get_section_name (dynobj, s), ".rela"))
6496         {
6497           if (s->size != 0 && s != htab->root.srelplt)
6498             relocs = TRUE;
6499
6500           /* We use the reloc_count field as a counter if we need
6501              to copy relocs into the output file.  */
6502           if (s != htab->root.srelplt)
6503             s->reloc_count = 0;
6504         }
6505       else
6506         {
6507           /* It's not one of our sections, so don't allocate space.  */
6508           continue;
6509         }
6510
6511       if (s->size == 0)
6512         {
6513           /* If we don't need this section, strip it from the
6514              output file.  This is mostly to handle .rela.bss and
6515              .rela.plt.  We must create both sections in
6516              create_dynamic_sections, because they must be created
6517              before the linker maps input sections to output
6518              sections.  The linker does that before
6519              adjust_dynamic_symbol is called, and it is that
6520              function which decides whether anything needs to go
6521              into these sections.  */
6522
6523           s->flags |= SEC_EXCLUDE;
6524           continue;
6525         }
6526
6527       if ((s->flags & SEC_HAS_CONTENTS) == 0)
6528         continue;
6529
6530       /* Allocate memory for the section contents.  We use bfd_zalloc
6531          here in case unused entries are not reclaimed before the
6532          section's contents are written out.  This should not happen,
6533          but this way if it does, we get a R_AARCH64_NONE reloc instead
6534          of garbage.  */
6535       s->contents = (bfd_byte *) bfd_zalloc (dynobj, s->size);
6536       if (s->contents == NULL)
6537         return FALSE;
6538     }
6539
6540   if (htab->root.dynamic_sections_created)
6541     {
6542       /* Add some entries to the .dynamic section.  We fill in the
6543          values later, in elfNN_aarch64_finish_dynamic_sections, but we
6544          must add the entries now so that we get the correct size for
6545          the .dynamic section.  The DT_DEBUG entry is filled in by the
6546          dynamic linker and used by the debugger.  */
6547 #define add_dynamic_entry(TAG, VAL)                     \
6548       _bfd_elf_add_dynamic_entry (info, TAG, VAL)
6549
6550       if (info->executable)
6551         {
6552           if (!add_dynamic_entry (DT_DEBUG, 0))
6553             return FALSE;
6554         }
6555
6556       if (htab->root.splt->size != 0)
6557         {
6558           if (!add_dynamic_entry (DT_PLTGOT, 0)
6559               || !add_dynamic_entry (DT_PLTRELSZ, 0)
6560               || !add_dynamic_entry (DT_PLTREL, DT_RELA)
6561               || !add_dynamic_entry (DT_JMPREL, 0))
6562             return FALSE;
6563
6564           if (htab->tlsdesc_plt
6565               && (!add_dynamic_entry (DT_TLSDESC_PLT, 0)
6566                   || !add_dynamic_entry (DT_TLSDESC_GOT, 0)))
6567             return FALSE;
6568         }
6569
6570       if (relocs)
6571         {
6572           if (!add_dynamic_entry (DT_RELA, 0)
6573               || !add_dynamic_entry (DT_RELASZ, 0)
6574               || !add_dynamic_entry (DT_RELAENT, RELOC_SIZE (htab)))
6575             return FALSE;
6576
6577           /* If any dynamic relocs apply to a read-only section,
6578              then we need a DT_TEXTREL entry.  */
6579           if ((info->flags & DF_TEXTREL) != 0)
6580             {
6581               if (!add_dynamic_entry (DT_TEXTREL, 0))
6582                 return FALSE;
6583             }
6584         }
6585     }
6586 #undef add_dynamic_entry
6587
6588   return TRUE;
6589 }
6590
6591 static inline void
6592 elf_aarch64_update_plt_entry (bfd *output_bfd,
6593                               bfd_reloc_code_real_type r_type,
6594                               bfd_byte *plt_entry, bfd_vma value)
6595 {
6596   reloc_howto_type *howto = elfNN_aarch64_howto_from_bfd_reloc (r_type);
6597
6598   _bfd_aarch64_elf_put_addend (output_bfd, plt_entry, r_type, howto, value);
6599 }
6600
6601 static void
6602 elfNN_aarch64_create_small_pltn_entry (struct elf_link_hash_entry *h,
6603                                        struct elf_aarch64_link_hash_table
6604                                        *htab, bfd *output_bfd,
6605                                        struct bfd_link_info *info)
6606 {
6607   bfd_byte *plt_entry;
6608   bfd_vma plt_index;
6609   bfd_vma got_offset;
6610   bfd_vma gotplt_entry_address;
6611   bfd_vma plt_entry_address;
6612   Elf_Internal_Rela rela;
6613   bfd_byte *loc;
6614   asection *plt, *gotplt, *relplt;
6615
6616   /* When building a static executable, use .iplt, .igot.plt and
6617      .rela.iplt sections for STT_GNU_IFUNC symbols.  */
6618   if (htab->root.splt != NULL)
6619     {
6620       plt = htab->root.splt;
6621       gotplt = htab->root.sgotplt;
6622       relplt = htab->root.srelplt;
6623     }
6624   else
6625     {
6626       plt = htab->root.iplt;
6627       gotplt = htab->root.igotplt;
6628       relplt = htab->root.irelplt;
6629     }
6630
6631   /* Get the index in the procedure linkage table which
6632      corresponds to this symbol.  This is the index of this symbol
6633      in all the symbols for which we are making plt entries.  The
6634      first entry in the procedure linkage table is reserved.
6635
6636      Get the offset into the .got table of the entry that
6637      corresponds to this function.      Each .got entry is GOT_ENTRY_SIZE
6638      bytes. The first three are reserved for the dynamic linker.
6639
6640      For static executables, we don't reserve anything.  */
6641
6642   if (plt == htab->root.splt)
6643     {
6644       plt_index = (h->plt.offset - htab->plt_header_size) / htab->plt_entry_size;
6645       got_offset = (plt_index + 3) * GOT_ENTRY_SIZE;
6646     }
6647   else
6648     {
6649       plt_index = h->plt.offset / htab->plt_entry_size;
6650       got_offset = plt_index * GOT_ENTRY_SIZE;
6651     }
6652
6653   plt_entry = plt->contents + h->plt.offset;
6654   plt_entry_address = plt->output_section->vma
6655     + plt->output_section->output_offset + h->plt.offset;
6656   gotplt_entry_address = gotplt->output_section->vma +
6657     gotplt->output_offset + got_offset;
6658
6659   /* Copy in the boiler-plate for the PLTn entry.  */
6660   memcpy (plt_entry, elfNN_aarch64_small_plt_entry, PLT_SMALL_ENTRY_SIZE);
6661
6662   /* Fill in the top 21 bits for this: ADRP x16, PLT_GOT + n * 8.
6663      ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
6664   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADR_HI21_PCREL,
6665                                 plt_entry,
6666                                 PG (gotplt_entry_address) -
6667                                 PG (plt_entry_address));
6668
6669   /* Fill in the lo12 bits for the load from the pltgot.  */
6670   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_LDSTNN_LO12,
6671                                 plt_entry + 4,
6672                                 PG_OFFSET (gotplt_entry_address));
6673
6674   /* Fill in the lo12 bits for the add from the pltgot entry.  */
6675   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADD_LO12,
6676                                 plt_entry + 8,
6677                                 PG_OFFSET (gotplt_entry_address));
6678
6679   /* All the GOTPLT Entries are essentially initialized to PLT0.  */
6680   bfd_put_NN (output_bfd,
6681               plt->output_section->vma + plt->output_offset,
6682               gotplt->contents + got_offset);
6683
6684   rela.r_offset = gotplt_entry_address;
6685
6686   if (h->dynindx == -1
6687       || ((info->executable
6688            || ELF_ST_VISIBILITY (h->other) != STV_DEFAULT)
6689           && h->def_regular
6690           && h->type == STT_GNU_IFUNC))
6691     {
6692       /* If an STT_GNU_IFUNC symbol is locally defined, generate
6693          R_AARCH64_IRELATIVE instead of R_AARCH64_JUMP_SLOT.  */
6694       rela.r_info = ELFNN_R_INFO (0, AARCH64_R (IRELATIVE));
6695       rela.r_addend = (h->root.u.def.value
6696                        + h->root.u.def.section->output_section->vma
6697                        + h->root.u.def.section->output_offset);
6698     }
6699   else
6700     {
6701       /* Fill in the entry in the .rela.plt section.  */
6702       rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (JUMP_SLOT));
6703       rela.r_addend = 0;
6704     }
6705
6706   /* Compute the relocation entry to used based on PLT index and do
6707      not adjust reloc_count. The reloc_count has already been adjusted
6708      to account for this entry.  */
6709   loc = relplt->contents + plt_index * RELOC_SIZE (htab);
6710   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
6711 }
6712
6713 /* Size sections even though they're not dynamic.  We use it to setup
6714    _TLS_MODULE_BASE_, if needed.  */
6715
6716 static bfd_boolean
6717 elfNN_aarch64_always_size_sections (bfd *output_bfd,
6718                                     struct bfd_link_info *info)
6719 {
6720   asection *tls_sec;
6721
6722   if (info->relocatable)
6723     return TRUE;
6724
6725   tls_sec = elf_hash_table (info)->tls_sec;
6726
6727   if (tls_sec)
6728     {
6729       struct elf_link_hash_entry *tlsbase;
6730
6731       tlsbase = elf_link_hash_lookup (elf_hash_table (info),
6732                                       "_TLS_MODULE_BASE_", TRUE, TRUE, FALSE);
6733
6734       if (tlsbase)
6735         {
6736           struct bfd_link_hash_entry *h = NULL;
6737           const struct elf_backend_data *bed =
6738             get_elf_backend_data (output_bfd);
6739
6740           if (!(_bfd_generic_link_add_one_symbol
6741                 (info, output_bfd, "_TLS_MODULE_BASE_", BSF_LOCAL,
6742                  tls_sec, 0, NULL, FALSE, bed->collect, &h)))
6743             return FALSE;
6744
6745           tlsbase->type = STT_TLS;
6746           tlsbase = (struct elf_link_hash_entry *) h;
6747           tlsbase->def_regular = 1;
6748           tlsbase->other = STV_HIDDEN;
6749           (*bed->elf_backend_hide_symbol) (info, tlsbase, TRUE);
6750         }
6751     }
6752
6753   return TRUE;
6754 }
6755
6756 /* Finish up dynamic symbol handling.  We set the contents of various
6757    dynamic sections here.  */
6758 static bfd_boolean
6759 elfNN_aarch64_finish_dynamic_symbol (bfd *output_bfd,
6760                                      struct bfd_link_info *info,
6761                                      struct elf_link_hash_entry *h,
6762                                      Elf_Internal_Sym *sym)
6763 {
6764   struct elf_aarch64_link_hash_table *htab;
6765   htab = elf_aarch64_hash_table (info);
6766
6767   if (h->plt.offset != (bfd_vma) - 1)
6768     {
6769       asection *plt, *gotplt, *relplt;
6770
6771       /* This symbol has an entry in the procedure linkage table.  Set
6772          it up.  */
6773
6774       /* When building a static executable, use .iplt, .igot.plt and
6775          .rela.iplt sections for STT_GNU_IFUNC symbols.  */
6776       if (htab->root.splt != NULL)
6777         {
6778           plt = htab->root.splt;
6779           gotplt = htab->root.sgotplt;
6780           relplt = htab->root.srelplt;
6781         }
6782       else
6783         {
6784           plt = htab->root.iplt;
6785           gotplt = htab->root.igotplt;
6786           relplt = htab->root.irelplt;
6787         }
6788
6789       /* This symbol has an entry in the procedure linkage table.  Set
6790          it up.  */
6791       if ((h->dynindx == -1
6792            && !((h->forced_local || info->executable)
6793                 && h->def_regular
6794                 && h->type == STT_GNU_IFUNC))
6795           || plt == NULL
6796           || gotplt == NULL
6797           || relplt == NULL)
6798         abort ();
6799
6800       elfNN_aarch64_create_small_pltn_entry (h, htab, output_bfd, info);
6801       if (!h->def_regular)
6802         {
6803           /* Mark the symbol as undefined, rather than as defined in
6804              the .plt section.  Leave the value alone.  This is a clue
6805              for the dynamic linker, to make function pointer
6806              comparisons work between an application and shared
6807              library.  */
6808           sym->st_shndx = SHN_UNDEF;
6809         }
6810     }
6811
6812   if (h->got.offset != (bfd_vma) - 1
6813       && elf_aarch64_hash_entry (h)->got_type == GOT_NORMAL)
6814     {
6815       Elf_Internal_Rela rela;
6816       bfd_byte *loc;
6817
6818       /* This symbol has an entry in the global offset table.  Set it
6819          up.  */
6820       if (htab->root.sgot == NULL || htab->root.srelgot == NULL)
6821         abort ();
6822
6823       rela.r_offset = (htab->root.sgot->output_section->vma
6824                        + htab->root.sgot->output_offset
6825                        + (h->got.offset & ~(bfd_vma) 1));
6826
6827       if (info->shared && SYMBOL_REFERENCES_LOCAL (info, h))
6828         {
6829           if (!h->def_regular)
6830             return FALSE;
6831
6832           BFD_ASSERT ((h->got.offset & 1) != 0);
6833           rela.r_info = ELFNN_R_INFO (0, AARCH64_R (RELATIVE));
6834           rela.r_addend = (h->root.u.def.value
6835                            + h->root.u.def.section->output_section->vma
6836                            + h->root.u.def.section->output_offset);
6837         }
6838       else
6839         {
6840           BFD_ASSERT ((h->got.offset & 1) == 0);
6841           bfd_put_NN (output_bfd, (bfd_vma) 0,
6842                       htab->root.sgot->contents + h->got.offset);
6843           rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (GLOB_DAT));
6844           rela.r_addend = 0;
6845         }
6846
6847       loc = htab->root.srelgot->contents;
6848       loc += htab->root.srelgot->reloc_count++ * RELOC_SIZE (htab);
6849       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
6850     }
6851
6852   if (h->needs_copy)
6853     {
6854       Elf_Internal_Rela rela;
6855       bfd_byte *loc;
6856
6857       /* This symbol needs a copy reloc.  Set it up.  */
6858
6859       if (h->dynindx == -1
6860           || (h->root.type != bfd_link_hash_defined
6861               && h->root.type != bfd_link_hash_defweak)
6862           || htab->srelbss == NULL)
6863         abort ();
6864
6865       rela.r_offset = (h->root.u.def.value
6866                        + h->root.u.def.section->output_section->vma
6867                        + h->root.u.def.section->output_offset);
6868       rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (COPY));
6869       rela.r_addend = 0;
6870       loc = htab->srelbss->contents;
6871       loc += htab->srelbss->reloc_count++ * RELOC_SIZE (htab);
6872       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
6873     }
6874
6875   /* Mark _DYNAMIC and _GLOBAL_OFFSET_TABLE_ as absolute.  SYM may
6876      be NULL for local symbols.  */
6877   if (sym != NULL
6878       && (h == elf_hash_table (info)->hdynamic
6879           || h == elf_hash_table (info)->hgot))
6880     sym->st_shndx = SHN_ABS;
6881
6882   return TRUE;
6883 }
6884
6885 /* Finish up local dynamic symbol handling.  We set the contents of
6886    various dynamic sections here.  */
6887
6888 static bfd_boolean
6889 elfNN_aarch64_finish_local_dynamic_symbol (void **slot, void *inf)
6890 {
6891   struct elf_link_hash_entry *h
6892     = (struct elf_link_hash_entry *) *slot;
6893   struct bfd_link_info *info
6894     = (struct bfd_link_info *) inf;
6895
6896   return elfNN_aarch64_finish_dynamic_symbol (info->output_bfd,
6897                                               info, h, NULL);
6898 }
6899
6900 static void
6901 elfNN_aarch64_init_small_plt0_entry (bfd *output_bfd ATTRIBUTE_UNUSED,
6902                                      struct elf_aarch64_link_hash_table
6903                                      *htab)
6904 {
6905   /* Fill in PLT0. Fixme:RR Note this doesn't distinguish between
6906      small and large plts and at the minute just generates
6907      the small PLT.  */
6908
6909   /* PLT0 of the small PLT looks like this in ELF64 -
6910      stp x16, x30, [sp, #-16]!          // Save the reloc and lr on stack.
6911      adrp x16, PLT_GOT + 16             // Get the page base of the GOTPLT
6912      ldr  x17, [x16, #:lo12:PLT_GOT+16] // Load the address of the
6913                                         // symbol resolver
6914      add  x16, x16, #:lo12:PLT_GOT+16   // Load the lo12 bits of the
6915                                         // GOTPLT entry for this.
6916      br   x17
6917      PLT0 will be slightly different in ELF32 due to different got entry
6918      size.
6919    */
6920   bfd_vma plt_got_2nd_ent;      /* Address of GOT[2].  */
6921   bfd_vma plt_base;
6922
6923
6924   memcpy (htab->root.splt->contents, elfNN_aarch64_small_plt0_entry,
6925           PLT_ENTRY_SIZE);
6926   elf_section_data (htab->root.splt->output_section)->this_hdr.sh_entsize =
6927     PLT_ENTRY_SIZE;
6928
6929   plt_got_2nd_ent = (htab->root.sgotplt->output_section->vma
6930                   + htab->root.sgotplt->output_offset
6931                   + GOT_ENTRY_SIZE * 2);
6932
6933   plt_base = htab->root.splt->output_section->vma +
6934     htab->root.splt->output_section->output_offset;
6935
6936   /* Fill in the top 21 bits for this: ADRP x16, PLT_GOT + n * 8.
6937      ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
6938   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADR_HI21_PCREL,
6939                                 htab->root.splt->contents + 4,
6940                                 PG (plt_got_2nd_ent) - PG (plt_base + 4));
6941
6942   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_LDSTNN_LO12,
6943                                 htab->root.splt->contents + 8,
6944                                 PG_OFFSET (plt_got_2nd_ent));
6945
6946   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADD_LO12,
6947                                 htab->root.splt->contents + 12,
6948                                 PG_OFFSET (plt_got_2nd_ent));
6949 }
6950
6951 static bfd_boolean
6952 elfNN_aarch64_finish_dynamic_sections (bfd *output_bfd,
6953                                        struct bfd_link_info *info)
6954 {
6955   struct elf_aarch64_link_hash_table *htab;
6956   bfd *dynobj;
6957   asection *sdyn;
6958
6959   htab = elf_aarch64_hash_table (info);
6960   dynobj = htab->root.dynobj;
6961   sdyn = bfd_get_linker_section (dynobj, ".dynamic");
6962
6963   if (htab->root.dynamic_sections_created)
6964     {
6965       ElfNN_External_Dyn *dyncon, *dynconend;
6966
6967       if (sdyn == NULL || htab->root.sgot == NULL)
6968         abort ();
6969
6970       dyncon = (ElfNN_External_Dyn *) sdyn->contents;
6971       dynconend = (ElfNN_External_Dyn *) (sdyn->contents + sdyn->size);
6972       for (; dyncon < dynconend; dyncon++)
6973         {
6974           Elf_Internal_Dyn dyn;
6975           asection *s;
6976
6977           bfd_elfNN_swap_dyn_in (dynobj, dyncon, &dyn);
6978
6979           switch (dyn.d_tag)
6980             {
6981             default:
6982               continue;
6983
6984             case DT_PLTGOT:
6985               s = htab->root.sgotplt;
6986               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset;
6987               break;
6988
6989             case DT_JMPREL:
6990               dyn.d_un.d_ptr = htab->root.srelplt->output_section->vma;
6991               break;
6992
6993             case DT_PLTRELSZ:
6994               s = htab->root.srelplt->output_section;
6995               dyn.d_un.d_val = s->size;
6996               break;
6997
6998             case DT_RELASZ:
6999               /* The procedure linkage table relocs (DT_JMPREL) should
7000                  not be included in the overall relocs (DT_RELA).
7001                  Therefore, we override the DT_RELASZ entry here to
7002                  make it not include the JMPREL relocs.  Since the
7003                  linker script arranges for .rela.plt to follow all
7004                  other relocation sections, we don't have to worry
7005                  about changing the DT_RELA entry.  */
7006               if (htab->root.srelplt != NULL)
7007                 {
7008                   s = htab->root.srelplt->output_section;
7009                   dyn.d_un.d_val -= s->size;
7010                 }
7011               break;
7012
7013             case DT_TLSDESC_PLT:
7014               s = htab->root.splt;
7015               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset
7016                 + htab->tlsdesc_plt;
7017               break;
7018
7019             case DT_TLSDESC_GOT:
7020               s = htab->root.sgot;
7021               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset
7022                 + htab->dt_tlsdesc_got;
7023               break;
7024             }
7025
7026           bfd_elfNN_swap_dyn_out (output_bfd, &dyn, dyncon);
7027         }
7028
7029     }
7030
7031   /* Fill in the special first entry in the procedure linkage table.  */
7032   if (htab->root.splt && htab->root.splt->size > 0)
7033     {
7034       elfNN_aarch64_init_small_plt0_entry (output_bfd, htab);
7035
7036       elf_section_data (htab->root.splt->output_section)->
7037         this_hdr.sh_entsize = htab->plt_entry_size;
7038
7039
7040       if (htab->tlsdesc_plt)
7041         {
7042           bfd_put_NN (output_bfd, (bfd_vma) 0,
7043                       htab->root.sgot->contents + htab->dt_tlsdesc_got);
7044
7045           memcpy (htab->root.splt->contents + htab->tlsdesc_plt,
7046                   elfNN_aarch64_tlsdesc_small_plt_entry,
7047                   sizeof (elfNN_aarch64_tlsdesc_small_plt_entry));
7048
7049           {
7050             bfd_vma adrp1_addr =
7051               htab->root.splt->output_section->vma
7052               + htab->root.splt->output_offset + htab->tlsdesc_plt + 4;
7053
7054             bfd_vma adrp2_addr = adrp1_addr + 4;
7055
7056             bfd_vma got_addr =
7057               htab->root.sgot->output_section->vma
7058               + htab->root.sgot->output_offset;
7059
7060             bfd_vma pltgot_addr =
7061               htab->root.sgotplt->output_section->vma
7062               + htab->root.sgotplt->output_offset;
7063
7064             bfd_vma dt_tlsdesc_got = got_addr + htab->dt_tlsdesc_got;
7065
7066             bfd_byte *plt_entry =
7067               htab->root.splt->contents + htab->tlsdesc_plt;
7068
7069             /* adrp x2, DT_TLSDESC_GOT */
7070             elf_aarch64_update_plt_entry (output_bfd,
7071                                           BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7072                                           plt_entry + 4,
7073                                           (PG (dt_tlsdesc_got)
7074                                            - PG (adrp1_addr)));
7075
7076             /* adrp x3, 0 */
7077             elf_aarch64_update_plt_entry (output_bfd,
7078                                           BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7079                                           plt_entry + 8,
7080                                           (PG (pltgot_addr)
7081                                            - PG (adrp2_addr)));
7082
7083             /* ldr x2, [x2, #0] */
7084             elf_aarch64_update_plt_entry (output_bfd,
7085                                           BFD_RELOC_AARCH64_LDSTNN_LO12,
7086                                           plt_entry + 12,
7087                                           PG_OFFSET (dt_tlsdesc_got));
7088
7089             /* add x3, x3, 0 */
7090             elf_aarch64_update_plt_entry (output_bfd,
7091                                           BFD_RELOC_AARCH64_ADD_LO12,
7092                                           plt_entry + 16,
7093                                           PG_OFFSET (pltgot_addr));
7094           }
7095         }
7096     }
7097
7098   if (htab->root.sgotplt)
7099     {
7100       if (bfd_is_abs_section (htab->root.sgotplt->output_section))
7101         {
7102           (*_bfd_error_handler)
7103             (_("discarded output section: `%A'"), htab->root.sgotplt);
7104           return FALSE;
7105         }
7106
7107       /* Fill in the first three entries in the global offset table.  */
7108       if (htab->root.sgotplt->size > 0)
7109         {
7110           bfd_put_NN (output_bfd, (bfd_vma) 0, htab->root.sgotplt->contents);
7111
7112           /* Write GOT[1] and GOT[2], needed for the dynamic linker.  */
7113           bfd_put_NN (output_bfd,
7114                       (bfd_vma) 0,
7115                       htab->root.sgotplt->contents + GOT_ENTRY_SIZE);
7116           bfd_put_NN (output_bfd,
7117                       (bfd_vma) 0,
7118                       htab->root.sgotplt->contents + GOT_ENTRY_SIZE * 2);
7119         }
7120
7121       if (htab->root.sgot)
7122         {
7123           if (htab->root.sgot->size > 0)
7124             {
7125               bfd_vma addr =
7126                 sdyn ? sdyn->output_section->vma + sdyn->output_offset : 0;
7127               bfd_put_NN (output_bfd, addr, htab->root.sgot->contents);
7128             }
7129         }
7130
7131       elf_section_data (htab->root.sgotplt->output_section)->
7132         this_hdr.sh_entsize = GOT_ENTRY_SIZE;
7133     }
7134
7135   if (htab->root.sgot && htab->root.sgot->size > 0)
7136     elf_section_data (htab->root.sgot->output_section)->this_hdr.sh_entsize
7137       = GOT_ENTRY_SIZE;
7138
7139   /* Fill PLT and GOT entries for local STT_GNU_IFUNC symbols.  */
7140   htab_traverse (htab->loc_hash_table,
7141                  elfNN_aarch64_finish_local_dynamic_symbol,
7142                  info);
7143
7144   return TRUE;
7145 }
7146
7147 /* Return address for Ith PLT stub in section PLT, for relocation REL
7148    or (bfd_vma) -1 if it should not be included.  */
7149
7150 static bfd_vma
7151 elfNN_aarch64_plt_sym_val (bfd_vma i, const asection *plt,
7152                            const arelent *rel ATTRIBUTE_UNUSED)
7153 {
7154   return plt->vma + PLT_ENTRY_SIZE + i * PLT_SMALL_ENTRY_SIZE;
7155 }
7156
7157
7158 /* We use this so we can override certain functions
7159    (though currently we don't).  */
7160
7161 const struct elf_size_info elfNN_aarch64_size_info =
7162 {
7163   sizeof (ElfNN_External_Ehdr),
7164   sizeof (ElfNN_External_Phdr),
7165   sizeof (ElfNN_External_Shdr),
7166   sizeof (ElfNN_External_Rel),
7167   sizeof (ElfNN_External_Rela),
7168   sizeof (ElfNN_External_Sym),
7169   sizeof (ElfNN_External_Dyn),
7170   sizeof (Elf_External_Note),
7171   4,                            /* Hash table entry size.  */
7172   1,                            /* Internal relocs per external relocs.  */
7173   ARCH_SIZE,                    /* Arch size.  */
7174   LOG_FILE_ALIGN,               /* Log_file_align.  */
7175   ELFCLASSNN, EV_CURRENT,
7176   bfd_elfNN_write_out_phdrs,
7177   bfd_elfNN_write_shdrs_and_ehdr,
7178   bfd_elfNN_checksum_contents,
7179   bfd_elfNN_write_relocs,
7180   bfd_elfNN_swap_symbol_in,
7181   bfd_elfNN_swap_symbol_out,
7182   bfd_elfNN_slurp_reloc_table,
7183   bfd_elfNN_slurp_symbol_table,
7184   bfd_elfNN_swap_dyn_in,
7185   bfd_elfNN_swap_dyn_out,
7186   bfd_elfNN_swap_reloc_in,
7187   bfd_elfNN_swap_reloc_out,
7188   bfd_elfNN_swap_reloca_in,
7189   bfd_elfNN_swap_reloca_out
7190 };
7191
7192 #define ELF_ARCH                        bfd_arch_aarch64
7193 #define ELF_MACHINE_CODE                EM_AARCH64
7194 #define ELF_MAXPAGESIZE                 0x10000
7195 #define ELF_MINPAGESIZE                 0x1000
7196 #define ELF_COMMONPAGESIZE              0x1000
7197
7198 #define bfd_elfNN_close_and_cleanup             \
7199   elfNN_aarch64_close_and_cleanup
7200
7201 #define bfd_elfNN_bfd_copy_private_bfd_data     \
7202   elfNN_aarch64_copy_private_bfd_data
7203
7204 #define bfd_elfNN_bfd_free_cached_info          \
7205   elfNN_aarch64_bfd_free_cached_info
7206
7207 #define bfd_elfNN_bfd_is_target_special_symbol  \
7208   elfNN_aarch64_is_target_special_symbol
7209
7210 #define bfd_elfNN_bfd_link_hash_table_create    \
7211   elfNN_aarch64_link_hash_table_create
7212
7213 #define bfd_elfNN_bfd_link_hash_table_free      \
7214   elfNN_aarch64_hash_table_free
7215
7216 #define bfd_elfNN_bfd_merge_private_bfd_data    \
7217   elfNN_aarch64_merge_private_bfd_data
7218
7219 #define bfd_elfNN_bfd_print_private_bfd_data    \
7220   elfNN_aarch64_print_private_bfd_data
7221
7222 #define bfd_elfNN_bfd_reloc_type_lookup         \
7223   elfNN_aarch64_reloc_type_lookup
7224
7225 #define bfd_elfNN_bfd_reloc_name_lookup         \
7226   elfNN_aarch64_reloc_name_lookup
7227
7228 #define bfd_elfNN_bfd_set_private_flags         \
7229   elfNN_aarch64_set_private_flags
7230
7231 #define bfd_elfNN_find_inliner_info             \
7232   elfNN_aarch64_find_inliner_info
7233
7234 #define bfd_elfNN_find_nearest_line             \
7235   elfNN_aarch64_find_nearest_line
7236
7237 #define bfd_elfNN_mkobject                      \
7238   elfNN_aarch64_mkobject
7239
7240 #define bfd_elfNN_new_section_hook              \
7241   elfNN_aarch64_new_section_hook
7242
7243 #define elf_backend_adjust_dynamic_symbol       \
7244   elfNN_aarch64_adjust_dynamic_symbol
7245
7246 #define elf_backend_always_size_sections        \
7247   elfNN_aarch64_always_size_sections
7248
7249 #define elf_backend_check_relocs                \
7250   elfNN_aarch64_check_relocs
7251
7252 #define elf_backend_copy_indirect_symbol        \
7253   elfNN_aarch64_copy_indirect_symbol
7254
7255 /* Create .dynbss, and .rela.bss sections in DYNOBJ, and set up shortcuts
7256    to them in our hash.  */
7257 #define elf_backend_create_dynamic_sections     \
7258   elfNN_aarch64_create_dynamic_sections
7259
7260 #define elf_backend_init_index_section          \
7261   _bfd_elf_init_2_index_sections
7262
7263 #define elf_backend_finish_dynamic_sections     \
7264   elfNN_aarch64_finish_dynamic_sections
7265
7266 #define elf_backend_finish_dynamic_symbol       \
7267   elfNN_aarch64_finish_dynamic_symbol
7268
7269 #define elf_backend_gc_sweep_hook               \
7270   elfNN_aarch64_gc_sweep_hook
7271
7272 #define elf_backend_object_p                    \
7273   elfNN_aarch64_object_p
7274
7275 #define elf_backend_output_arch_local_syms      \
7276   elfNN_aarch64_output_arch_local_syms
7277
7278 #define elf_backend_plt_sym_val                 \
7279   elfNN_aarch64_plt_sym_val
7280
7281 #define elf_backend_post_process_headers        \
7282   elfNN_aarch64_post_process_headers
7283
7284 #define elf_backend_relocate_section            \
7285   elfNN_aarch64_relocate_section
7286
7287 #define elf_backend_reloc_type_class            \
7288   elfNN_aarch64_reloc_type_class
7289
7290 #define elf_backend_section_flags               \
7291   elfNN_aarch64_section_flags
7292
7293 #define elf_backend_section_from_shdr           \
7294   elfNN_aarch64_section_from_shdr
7295
7296 #define elf_backend_size_dynamic_sections       \
7297   elfNN_aarch64_size_dynamic_sections
7298
7299 #define elf_backend_size_info                   \
7300   elfNN_aarch64_size_info
7301
7302 #define elf_backend_can_refcount       1
7303 #define elf_backend_can_gc_sections    1
7304 #define elf_backend_plt_readonly       1
7305 #define elf_backend_want_got_plt       1
7306 #define elf_backend_want_plt_sym       0
7307 #define elf_backend_may_use_rel_p      0
7308 #define elf_backend_may_use_rela_p     1
7309 #define elf_backend_default_use_rela_p 1
7310 #define elf_backend_got_header_size (GOT_ENTRY_SIZE * 3)
7311 #define elf_backend_default_execstack  0
7312
7313 #undef  elf_backend_obj_attrs_section
7314 #define elf_backend_obj_attrs_section           ".ARM.attributes"
7315
7316 #include "elfNN-target.h"