Backport "="-ldscript-path-prefix changes from master.
[platform/upstream/binutils.git] / bfd / elfnn-aarch64.c
1 /* AArch64-specific support for NN-bit ELF.
2    Copyright (C) 2009-2014 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               aarch64_elfNN_le_vec
1552 #define TARGET_LITTLE_NAME              "elfNN-littleaarch64"
1553 #define TARGET_BIG_SYM                  aarch64_elfNN_be_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 /* Destroy an AArch64 elf linker hash table.  */
2059
2060 static void
2061 elfNN_aarch64_link_hash_table_free (bfd *obfd)
2062 {
2063   struct elf_aarch64_link_hash_table *ret
2064     = (struct elf_aarch64_link_hash_table *) obfd->link.hash;
2065
2066   if (ret->loc_hash_table)
2067     htab_delete (ret->loc_hash_table);
2068   if (ret->loc_hash_memory)
2069     objalloc_free ((struct objalloc *) ret->loc_hash_memory);
2070
2071   bfd_hash_table_free (&ret->stub_hash_table);
2072   _bfd_elf_link_hash_table_free (obfd);
2073 }
2074
2075 /* Create an AArch64 elf linker hash table.  */
2076
2077 static struct bfd_link_hash_table *
2078 elfNN_aarch64_link_hash_table_create (bfd *abfd)
2079 {
2080   struct elf_aarch64_link_hash_table *ret;
2081   bfd_size_type amt = sizeof (struct elf_aarch64_link_hash_table);
2082
2083   ret = bfd_zmalloc (amt);
2084   if (ret == NULL)
2085     return NULL;
2086
2087   if (!_bfd_elf_link_hash_table_init
2088       (&ret->root, abfd, elfNN_aarch64_link_hash_newfunc,
2089        sizeof (struct elf_aarch64_link_hash_entry), AARCH64_ELF_DATA))
2090     {
2091       free (ret);
2092       return NULL;
2093     }
2094
2095   ret->plt_header_size = PLT_ENTRY_SIZE;
2096   ret->plt_entry_size = PLT_SMALL_ENTRY_SIZE;
2097   ret->obfd = abfd;
2098   ret->dt_tlsdesc_got = (bfd_vma) - 1;
2099
2100   if (!bfd_hash_table_init (&ret->stub_hash_table, stub_hash_newfunc,
2101                             sizeof (struct elf_aarch64_stub_hash_entry)))
2102     {
2103       _bfd_elf_link_hash_table_free (abfd);
2104       return NULL;
2105     }
2106
2107   ret->loc_hash_table = htab_try_create (1024,
2108                                          elfNN_aarch64_local_htab_hash,
2109                                          elfNN_aarch64_local_htab_eq,
2110                                          NULL);
2111   ret->loc_hash_memory = objalloc_create ();
2112   if (!ret->loc_hash_table || !ret->loc_hash_memory)
2113     {
2114       elfNN_aarch64_link_hash_table_free (abfd);
2115       return NULL;
2116     }
2117   ret->root.root.hash_table_free = elfNN_aarch64_link_hash_table_free;
2118
2119   return &ret->root.root;
2120 }
2121
2122 static bfd_boolean
2123 aarch64_relocate (unsigned int r_type, bfd *input_bfd, asection *input_section,
2124                   bfd_vma offset, bfd_vma value)
2125 {
2126   reloc_howto_type *howto;
2127   bfd_vma place;
2128
2129   howto = elfNN_aarch64_howto_from_type (r_type);
2130   place = (input_section->output_section->vma + input_section->output_offset
2131            + offset);
2132
2133   r_type = elfNN_aarch64_bfd_reloc_from_type (r_type);
2134   value = _bfd_aarch64_elf_resolve_relocation (r_type, place, value, 0, FALSE);
2135   return _bfd_aarch64_elf_put_addend (input_bfd,
2136                                       input_section->contents + offset, r_type,
2137                                       howto, value);
2138 }
2139
2140 static enum elf_aarch64_stub_type
2141 aarch64_select_branch_stub (bfd_vma value, bfd_vma place)
2142 {
2143   if (aarch64_valid_for_adrp_p (value, place))
2144     return aarch64_stub_adrp_branch;
2145   return aarch64_stub_long_branch;
2146 }
2147
2148 /* Determine the type of stub needed, if any, for a call.  */
2149
2150 static enum elf_aarch64_stub_type
2151 aarch64_type_of_stub (struct bfd_link_info *info,
2152                       asection *input_sec,
2153                       const Elf_Internal_Rela *rel,
2154                       unsigned char st_type,
2155                       struct elf_aarch64_link_hash_entry *hash,
2156                       bfd_vma destination)
2157 {
2158   bfd_vma location;
2159   bfd_signed_vma branch_offset;
2160   unsigned int r_type;
2161   struct elf_aarch64_link_hash_table *globals;
2162   enum elf_aarch64_stub_type stub_type = aarch64_stub_none;
2163   bfd_boolean via_plt_p;
2164
2165   if (st_type != STT_FUNC)
2166     return stub_type;
2167
2168   globals = elf_aarch64_hash_table (info);
2169   via_plt_p = (globals->root.splt != NULL && hash != NULL
2170                && hash->root.plt.offset != (bfd_vma) - 1);
2171
2172   if (via_plt_p)
2173     return stub_type;
2174
2175   /* Determine where the call point is.  */
2176   location = (input_sec->output_offset
2177               + input_sec->output_section->vma + rel->r_offset);
2178
2179   branch_offset = (bfd_signed_vma) (destination - location);
2180
2181   r_type = ELFNN_R_TYPE (rel->r_info);
2182
2183   /* We don't want to redirect any old unconditional jump in this way,
2184      only one which is being used for a sibcall, where it is
2185      acceptable for the IP0 and IP1 registers to be clobbered.  */
2186   if ((r_type == AARCH64_R (CALL26) || r_type == AARCH64_R (JUMP26))
2187       && (branch_offset > AARCH64_MAX_FWD_BRANCH_OFFSET
2188           || branch_offset < AARCH64_MAX_BWD_BRANCH_OFFSET))
2189     {
2190       stub_type = aarch64_stub_long_branch;
2191     }
2192
2193   return stub_type;
2194 }
2195
2196 /* Build a name for an entry in the stub hash table.  */
2197
2198 static char *
2199 elfNN_aarch64_stub_name (const asection *input_section,
2200                          const asection *sym_sec,
2201                          const struct elf_aarch64_link_hash_entry *hash,
2202                          const Elf_Internal_Rela *rel)
2203 {
2204   char *stub_name;
2205   bfd_size_type len;
2206
2207   if (hash)
2208     {
2209       len = 8 + 1 + strlen (hash->root.root.root.string) + 1 + 16 + 1;
2210       stub_name = bfd_malloc (len);
2211       if (stub_name != NULL)
2212         snprintf (stub_name, len, "%08x_%s+%" BFD_VMA_FMT "x",
2213                   (unsigned int) input_section->id,
2214                   hash->root.root.root.string,
2215                   rel->r_addend);
2216     }
2217   else
2218     {
2219       len = 8 + 1 + 8 + 1 + 8 + 1 + 16 + 1;
2220       stub_name = bfd_malloc (len);
2221       if (stub_name != NULL)
2222         snprintf (stub_name, len, "%08x_%x:%x+%" BFD_VMA_FMT "x",
2223                   (unsigned int) input_section->id,
2224                   (unsigned int) sym_sec->id,
2225                   (unsigned int) ELFNN_R_SYM (rel->r_info),
2226                   rel->r_addend);
2227     }
2228
2229   return stub_name;
2230 }
2231
2232 /* Look up an entry in the stub hash.  Stub entries are cached because
2233    creating the stub name takes a bit of time.  */
2234
2235 static struct elf_aarch64_stub_hash_entry *
2236 elfNN_aarch64_get_stub_entry (const asection *input_section,
2237                               const asection *sym_sec,
2238                               struct elf_link_hash_entry *hash,
2239                               const Elf_Internal_Rela *rel,
2240                               struct elf_aarch64_link_hash_table *htab)
2241 {
2242   struct elf_aarch64_stub_hash_entry *stub_entry;
2243   struct elf_aarch64_link_hash_entry *h =
2244     (struct elf_aarch64_link_hash_entry *) hash;
2245   const asection *id_sec;
2246
2247   if ((input_section->flags & SEC_CODE) == 0)
2248     return NULL;
2249
2250   /* If this input section is part of a group of sections sharing one
2251      stub section, then use the id of the first section in the group.
2252      Stub names need to include a section id, as there may well be
2253      more than one stub used to reach say, printf, and we need to
2254      distinguish between them.  */
2255   id_sec = htab->stub_group[input_section->id].link_sec;
2256
2257   if (h != NULL && h->stub_cache != NULL
2258       && h->stub_cache->h == h && h->stub_cache->id_sec == id_sec)
2259     {
2260       stub_entry = h->stub_cache;
2261     }
2262   else
2263     {
2264       char *stub_name;
2265
2266       stub_name = elfNN_aarch64_stub_name (id_sec, sym_sec, h, rel);
2267       if (stub_name == NULL)
2268         return NULL;
2269
2270       stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table,
2271                                              stub_name, FALSE, FALSE);
2272       if (h != NULL)
2273         h->stub_cache = stub_entry;
2274
2275       free (stub_name);
2276     }
2277
2278   return stub_entry;
2279 }
2280
2281 /* Add a new stub entry to the stub hash.  Not all fields of the new
2282    stub entry are initialised.  */
2283
2284 static struct elf_aarch64_stub_hash_entry *
2285 elfNN_aarch64_add_stub (const char *stub_name,
2286                         asection *section,
2287                         struct elf_aarch64_link_hash_table *htab)
2288 {
2289   asection *link_sec;
2290   asection *stub_sec;
2291   struct elf_aarch64_stub_hash_entry *stub_entry;
2292
2293   link_sec = htab->stub_group[section->id].link_sec;
2294   stub_sec = htab->stub_group[section->id].stub_sec;
2295   if (stub_sec == NULL)
2296     {
2297       stub_sec = htab->stub_group[link_sec->id].stub_sec;
2298       if (stub_sec == NULL)
2299         {
2300           size_t namelen;
2301           bfd_size_type len;
2302           char *s_name;
2303
2304           namelen = strlen (link_sec->name);
2305           len = namelen + sizeof (STUB_SUFFIX);
2306           s_name = bfd_alloc (htab->stub_bfd, len);
2307           if (s_name == NULL)
2308             return NULL;
2309
2310           memcpy (s_name, link_sec->name, namelen);
2311           memcpy (s_name + namelen, STUB_SUFFIX, sizeof (STUB_SUFFIX));
2312           stub_sec = (*htab->add_stub_section) (s_name, link_sec);
2313           if (stub_sec == NULL)
2314             return NULL;
2315           htab->stub_group[link_sec->id].stub_sec = stub_sec;
2316         }
2317       htab->stub_group[section->id].stub_sec = stub_sec;
2318     }
2319
2320   /* Enter this entry into the linker stub hash table.  */
2321   stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table, stub_name,
2322                                          TRUE, FALSE);
2323   if (stub_entry == NULL)
2324     {
2325       (*_bfd_error_handler) (_("%s: cannot create stub entry %s"),
2326                              section->owner, stub_name);
2327       return NULL;
2328     }
2329
2330   stub_entry->stub_sec = stub_sec;
2331   stub_entry->stub_offset = 0;
2332   stub_entry->id_sec = link_sec;
2333
2334   return stub_entry;
2335 }
2336
2337 static bfd_boolean
2338 aarch64_build_one_stub (struct bfd_hash_entry *gen_entry,
2339                         void *in_arg ATTRIBUTE_UNUSED)
2340 {
2341   struct elf_aarch64_stub_hash_entry *stub_entry;
2342   asection *stub_sec;
2343   bfd *stub_bfd;
2344   bfd_byte *loc;
2345   bfd_vma sym_value;
2346   unsigned int template_size;
2347   const uint32_t *template;
2348   unsigned int i;
2349
2350   /* Massage our args to the form they really have.  */
2351   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
2352
2353   stub_sec = stub_entry->stub_sec;
2354
2355   /* Make a note of the offset within the stubs for this entry.  */
2356   stub_entry->stub_offset = stub_sec->size;
2357   loc = stub_sec->contents + stub_entry->stub_offset;
2358
2359   stub_bfd = stub_sec->owner;
2360
2361   /* This is the address of the stub destination.  */
2362   sym_value = (stub_entry->target_value
2363                + stub_entry->target_section->output_offset
2364                + stub_entry->target_section->output_section->vma);
2365
2366   if (stub_entry->stub_type == aarch64_stub_long_branch)
2367     {
2368       bfd_vma place = (stub_entry->stub_offset + stub_sec->output_section->vma
2369                        + stub_sec->output_offset);
2370
2371       /* See if we can relax the stub.  */
2372       if (aarch64_valid_for_adrp_p (sym_value, place))
2373         stub_entry->stub_type = aarch64_select_branch_stub (sym_value, place);
2374     }
2375
2376   switch (stub_entry->stub_type)
2377     {
2378     case aarch64_stub_adrp_branch:
2379       template = aarch64_adrp_branch_stub;
2380       template_size = sizeof (aarch64_adrp_branch_stub);
2381       break;
2382     case aarch64_stub_long_branch:
2383       template = aarch64_long_branch_stub;
2384       template_size = sizeof (aarch64_long_branch_stub);
2385       break;
2386     default:
2387       BFD_FAIL ();
2388       return FALSE;
2389     }
2390
2391   for (i = 0; i < (template_size / sizeof template[0]); i++)
2392     {
2393       bfd_putl32 (template[i], loc);
2394       loc += 4;
2395     }
2396
2397   template_size = (template_size + 7) & ~7;
2398   stub_sec->size += template_size;
2399
2400   switch (stub_entry->stub_type)
2401     {
2402     case aarch64_stub_adrp_branch:
2403       if (aarch64_relocate (AARCH64_R (ADR_PREL_PG_HI21), stub_bfd, stub_sec,
2404                             stub_entry->stub_offset, sym_value))
2405         /* The stub would not have been relaxed if the offset was out
2406            of range.  */
2407         BFD_FAIL ();
2408
2409       _bfd_final_link_relocate
2410         (elfNN_aarch64_howto_from_type (AARCH64_R (ADD_ABS_LO12_NC)),
2411          stub_bfd,
2412          stub_sec,
2413          stub_sec->contents,
2414          stub_entry->stub_offset + 4,
2415          sym_value,
2416          0);
2417       break;
2418
2419     case aarch64_stub_long_branch:
2420       /* We want the value relative to the address 12 bytes back from the
2421          value itself.  */
2422       _bfd_final_link_relocate (elfNN_aarch64_howto_from_type
2423                                 (AARCH64_R (PRELNN)), stub_bfd, stub_sec,
2424                                 stub_sec->contents,
2425                                 stub_entry->stub_offset + 16,
2426                                 sym_value + 12, 0);
2427       break;
2428     default:
2429       break;
2430     }
2431
2432   return TRUE;
2433 }
2434
2435 /* As above, but don't actually build the stub.  Just bump offset so
2436    we know stub section sizes.  */
2437
2438 static bfd_boolean
2439 aarch64_size_one_stub (struct bfd_hash_entry *gen_entry,
2440                        void *in_arg ATTRIBUTE_UNUSED)
2441 {
2442   struct elf_aarch64_stub_hash_entry *stub_entry;
2443   int size;
2444
2445   /* Massage our args to the form they really have.  */
2446   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
2447
2448   switch (stub_entry->stub_type)
2449     {
2450     case aarch64_stub_adrp_branch:
2451       size = sizeof (aarch64_adrp_branch_stub);
2452       break;
2453     case aarch64_stub_long_branch:
2454       size = sizeof (aarch64_long_branch_stub);
2455       break;
2456     default:
2457       BFD_FAIL ();
2458       return FALSE;
2459       break;
2460     }
2461
2462   size = (size + 7) & ~7;
2463   stub_entry->stub_sec->size += size;
2464   return TRUE;
2465 }
2466
2467 /* External entry points for sizing and building linker stubs.  */
2468
2469 /* Set up various things so that we can make a list of input sections
2470    for each output section included in the link.  Returns -1 on error,
2471    0 when no stubs will be needed, and 1 on success.  */
2472
2473 int
2474 elfNN_aarch64_setup_section_lists (bfd *output_bfd,
2475                                    struct bfd_link_info *info)
2476 {
2477   bfd *input_bfd;
2478   unsigned int bfd_count;
2479   int top_id, top_index;
2480   asection *section;
2481   asection **input_list, **list;
2482   bfd_size_type amt;
2483   struct elf_aarch64_link_hash_table *htab =
2484     elf_aarch64_hash_table (info);
2485
2486   if (!is_elf_hash_table (htab))
2487     return 0;
2488
2489   /* Count the number of input BFDs and find the top input section id.  */
2490   for (input_bfd = info->input_bfds, bfd_count = 0, top_id = 0;
2491        input_bfd != NULL; input_bfd = input_bfd->link.next)
2492     {
2493       bfd_count += 1;
2494       for (section = input_bfd->sections;
2495            section != NULL; section = section->next)
2496         {
2497           if (top_id < section->id)
2498             top_id = section->id;
2499         }
2500     }
2501   htab->bfd_count = bfd_count;
2502
2503   amt = sizeof (struct map_stub) * (top_id + 1);
2504   htab->stub_group = bfd_zmalloc (amt);
2505   if (htab->stub_group == NULL)
2506     return -1;
2507
2508   /* We can't use output_bfd->section_count here to find the top output
2509      section index as some sections may have been removed, and
2510      _bfd_strip_section_from_output doesn't renumber the indices.  */
2511   for (section = output_bfd->sections, top_index = 0;
2512        section != NULL; section = section->next)
2513     {
2514       if (top_index < section->index)
2515         top_index = section->index;
2516     }
2517
2518   htab->top_index = top_index;
2519   amt = sizeof (asection *) * (top_index + 1);
2520   input_list = bfd_malloc (amt);
2521   htab->input_list = input_list;
2522   if (input_list == NULL)
2523     return -1;
2524
2525   /* For sections we aren't interested in, mark their entries with a
2526      value we can check later.  */
2527   list = input_list + top_index;
2528   do
2529     *list = bfd_abs_section_ptr;
2530   while (list-- != input_list);
2531
2532   for (section = output_bfd->sections;
2533        section != NULL; section = section->next)
2534     {
2535       if ((section->flags & SEC_CODE) != 0)
2536         input_list[section->index] = NULL;
2537     }
2538
2539   return 1;
2540 }
2541
2542 /* Used by elfNN_aarch64_next_input_section and group_sections.  */
2543 #define PREV_SEC(sec) (htab->stub_group[(sec)->id].link_sec)
2544
2545 /* The linker repeatedly calls this function for each input section,
2546    in the order that input sections are linked into output sections.
2547    Build lists of input sections to determine groupings between which
2548    we may insert linker stubs.  */
2549
2550 void
2551 elfNN_aarch64_next_input_section (struct bfd_link_info *info, asection *isec)
2552 {
2553   struct elf_aarch64_link_hash_table *htab =
2554     elf_aarch64_hash_table (info);
2555
2556   if (isec->output_section->index <= htab->top_index)
2557     {
2558       asection **list = htab->input_list + isec->output_section->index;
2559
2560       if (*list != bfd_abs_section_ptr)
2561         {
2562           /* Steal the link_sec pointer for our list.  */
2563           /* This happens to make the list in reverse order,
2564              which is what we want.  */
2565           PREV_SEC (isec) = *list;
2566           *list = isec;
2567         }
2568     }
2569 }
2570
2571 /* See whether we can group stub sections together.  Grouping stub
2572    sections may result in fewer stubs.  More importantly, we need to
2573    put all .init* and .fini* stubs at the beginning of the .init or
2574    .fini output sections respectively, because glibc splits the
2575    _init and _fini functions into multiple parts.  Putting a stub in
2576    the middle of a function is not a good idea.  */
2577
2578 static void
2579 group_sections (struct elf_aarch64_link_hash_table *htab,
2580                 bfd_size_type stub_group_size,
2581                 bfd_boolean stubs_always_before_branch)
2582 {
2583   asection **list = htab->input_list + htab->top_index;
2584
2585   do
2586     {
2587       asection *tail = *list;
2588
2589       if (tail == bfd_abs_section_ptr)
2590         continue;
2591
2592       while (tail != NULL)
2593         {
2594           asection *curr;
2595           asection *prev;
2596           bfd_size_type total;
2597
2598           curr = tail;
2599           total = tail->size;
2600           while ((prev = PREV_SEC (curr)) != NULL
2601                  && ((total += curr->output_offset - prev->output_offset)
2602                      < stub_group_size))
2603             curr = prev;
2604
2605           /* OK, the size from the start of CURR to the end is less
2606              than stub_group_size and thus can be handled by one stub
2607              section.  (Or the tail section is itself larger than
2608              stub_group_size, in which case we may be toast.)
2609              We should really be keeping track of the total size of
2610              stubs added here, as stubs contribute to the final output
2611              section size.  */
2612           do
2613             {
2614               prev = PREV_SEC (tail);
2615               /* Set up this stub group.  */
2616               htab->stub_group[tail->id].link_sec = curr;
2617             }
2618           while (tail != curr && (tail = prev) != NULL);
2619
2620           /* But wait, there's more!  Input sections up to stub_group_size
2621              bytes before the stub section can be handled by it too.  */
2622           if (!stubs_always_before_branch)
2623             {
2624               total = 0;
2625               while (prev != NULL
2626                      && ((total += tail->output_offset - prev->output_offset)
2627                          < stub_group_size))
2628                 {
2629                   tail = prev;
2630                   prev = PREV_SEC (tail);
2631                   htab->stub_group[tail->id].link_sec = curr;
2632                 }
2633             }
2634           tail = prev;
2635         }
2636     }
2637   while (list-- != htab->input_list);
2638
2639   free (htab->input_list);
2640 }
2641
2642 #undef PREV_SEC
2643
2644 /* Determine and set the size of the stub section for a final link.
2645
2646    The basic idea here is to examine all the relocations looking for
2647    PC-relative calls to a target that is unreachable with a "bl"
2648    instruction.  */
2649
2650 bfd_boolean
2651 elfNN_aarch64_size_stubs (bfd *output_bfd,
2652                           bfd *stub_bfd,
2653                           struct bfd_link_info *info,
2654                           bfd_signed_vma group_size,
2655                           asection * (*add_stub_section) (const char *,
2656                                                           asection *),
2657                           void (*layout_sections_again) (void))
2658 {
2659   bfd_size_type stub_group_size;
2660   bfd_boolean stubs_always_before_branch;
2661   bfd_boolean stub_changed = 0;
2662   struct elf_aarch64_link_hash_table *htab = elf_aarch64_hash_table (info);
2663
2664   /* Propagate mach to stub bfd, because it may not have been
2665      finalized when we created stub_bfd.  */
2666   bfd_set_arch_mach (stub_bfd, bfd_get_arch (output_bfd),
2667                      bfd_get_mach (output_bfd));
2668
2669   /* Stash our params away.  */
2670   htab->stub_bfd = stub_bfd;
2671   htab->add_stub_section = add_stub_section;
2672   htab->layout_sections_again = layout_sections_again;
2673   stubs_always_before_branch = group_size < 0;
2674   if (group_size < 0)
2675     stub_group_size = -group_size;
2676   else
2677     stub_group_size = group_size;
2678
2679   if (stub_group_size == 1)
2680     {
2681       /* Default values.  */
2682       /* AArch64 branch range is +-128MB. The value used is 1MB less.  */
2683       stub_group_size = 127 * 1024 * 1024;
2684     }
2685
2686   group_sections (htab, stub_group_size, stubs_always_before_branch);
2687
2688   while (1)
2689     {
2690       bfd *input_bfd;
2691       unsigned int bfd_indx;
2692       asection *stub_sec;
2693
2694       for (input_bfd = info->input_bfds, bfd_indx = 0;
2695            input_bfd != NULL; input_bfd = input_bfd->link.next, bfd_indx++)
2696         {
2697           Elf_Internal_Shdr *symtab_hdr;
2698           asection *section;
2699           Elf_Internal_Sym *local_syms = NULL;
2700
2701           /* We'll need the symbol table in a second.  */
2702           symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
2703           if (symtab_hdr->sh_info == 0)
2704             continue;
2705
2706           /* Walk over each section attached to the input bfd.  */
2707           for (section = input_bfd->sections;
2708                section != NULL; section = section->next)
2709             {
2710               Elf_Internal_Rela *internal_relocs, *irelaend, *irela;
2711
2712               /* If there aren't any relocs, then there's nothing more
2713                  to do.  */
2714               if ((section->flags & SEC_RELOC) == 0
2715                   || section->reloc_count == 0
2716                   || (section->flags & SEC_CODE) == 0)
2717                 continue;
2718
2719               /* If this section is a link-once section that will be
2720                  discarded, then don't create any stubs.  */
2721               if (section->output_section == NULL
2722                   || section->output_section->owner != output_bfd)
2723                 continue;
2724
2725               /* Get the relocs.  */
2726               internal_relocs
2727                 = _bfd_elf_link_read_relocs (input_bfd, section, NULL,
2728                                              NULL, info->keep_memory);
2729               if (internal_relocs == NULL)
2730                 goto error_ret_free_local;
2731
2732               /* Now examine each relocation.  */
2733               irela = internal_relocs;
2734               irelaend = irela + section->reloc_count;
2735               for (; irela < irelaend; irela++)
2736                 {
2737                   unsigned int r_type, r_indx;
2738                   enum elf_aarch64_stub_type stub_type;
2739                   struct elf_aarch64_stub_hash_entry *stub_entry;
2740                   asection *sym_sec;
2741                   bfd_vma sym_value;
2742                   bfd_vma destination;
2743                   struct elf_aarch64_link_hash_entry *hash;
2744                   const char *sym_name;
2745                   char *stub_name;
2746                   const asection *id_sec;
2747                   unsigned char st_type;
2748                   bfd_size_type len;
2749
2750                   r_type = ELFNN_R_TYPE (irela->r_info);
2751                   r_indx = ELFNN_R_SYM (irela->r_info);
2752
2753                   if (r_type >= (unsigned int) R_AARCH64_end)
2754                     {
2755                       bfd_set_error (bfd_error_bad_value);
2756                     error_ret_free_internal:
2757                       if (elf_section_data (section)->relocs == NULL)
2758                         free (internal_relocs);
2759                       goto error_ret_free_local;
2760                     }
2761
2762                   /* Only look for stubs on unconditional branch and
2763                      branch and link instructions.  */
2764                   if (r_type != (unsigned int) AARCH64_R (CALL26)
2765                       && r_type != (unsigned int) AARCH64_R (JUMP26))
2766                     continue;
2767
2768                   /* Now determine the call target, its name, value,
2769                      section.  */
2770                   sym_sec = NULL;
2771                   sym_value = 0;
2772                   destination = 0;
2773                   hash = NULL;
2774                   sym_name = NULL;
2775                   if (r_indx < symtab_hdr->sh_info)
2776                     {
2777                       /* It's a local symbol.  */
2778                       Elf_Internal_Sym *sym;
2779                       Elf_Internal_Shdr *hdr;
2780
2781                       if (local_syms == NULL)
2782                         {
2783                           local_syms
2784                             = (Elf_Internal_Sym *) symtab_hdr->contents;
2785                           if (local_syms == NULL)
2786                             local_syms
2787                               = bfd_elf_get_elf_syms (input_bfd, symtab_hdr,
2788                                                       symtab_hdr->sh_info, 0,
2789                                                       NULL, NULL, NULL);
2790                           if (local_syms == NULL)
2791                             goto error_ret_free_internal;
2792                         }
2793
2794                       sym = local_syms + r_indx;
2795                       hdr = elf_elfsections (input_bfd)[sym->st_shndx];
2796                       sym_sec = hdr->bfd_section;
2797                       if (!sym_sec)
2798                         /* This is an undefined symbol.  It can never
2799                            be resolved.  */
2800                         continue;
2801
2802                       if (ELF_ST_TYPE (sym->st_info) != STT_SECTION)
2803                         sym_value = sym->st_value;
2804                       destination = (sym_value + irela->r_addend
2805                                      + sym_sec->output_offset
2806                                      + sym_sec->output_section->vma);
2807                       st_type = ELF_ST_TYPE (sym->st_info);
2808                       sym_name
2809                         = bfd_elf_string_from_elf_section (input_bfd,
2810                                                            symtab_hdr->sh_link,
2811                                                            sym->st_name);
2812                     }
2813                   else
2814                     {
2815                       int e_indx;
2816
2817                       e_indx = r_indx - symtab_hdr->sh_info;
2818                       hash = ((struct elf_aarch64_link_hash_entry *)
2819                               elf_sym_hashes (input_bfd)[e_indx]);
2820
2821                       while (hash->root.root.type == bfd_link_hash_indirect
2822                              || hash->root.root.type == bfd_link_hash_warning)
2823                         hash = ((struct elf_aarch64_link_hash_entry *)
2824                                 hash->root.root.u.i.link);
2825
2826                       if (hash->root.root.type == bfd_link_hash_defined
2827                           || hash->root.root.type == bfd_link_hash_defweak)
2828                         {
2829                           struct elf_aarch64_link_hash_table *globals =
2830                             elf_aarch64_hash_table (info);
2831                           sym_sec = hash->root.root.u.def.section;
2832                           sym_value = hash->root.root.u.def.value;
2833                           /* For a destination in a shared library,
2834                              use the PLT stub as target address to
2835                              decide whether a branch stub is
2836                              needed.  */
2837                           if (globals->root.splt != NULL && hash != NULL
2838                               && hash->root.plt.offset != (bfd_vma) - 1)
2839                             {
2840                               sym_sec = globals->root.splt;
2841                               sym_value = hash->root.plt.offset;
2842                               if (sym_sec->output_section != NULL)
2843                                 destination = (sym_value
2844                                                + sym_sec->output_offset
2845                                                +
2846                                                sym_sec->output_section->vma);
2847                             }
2848                           else if (sym_sec->output_section != NULL)
2849                             destination = (sym_value + irela->r_addend
2850                                            + sym_sec->output_offset
2851                                            + sym_sec->output_section->vma);
2852                         }
2853                       else if (hash->root.root.type == bfd_link_hash_undefined
2854                                || (hash->root.root.type
2855                                    == bfd_link_hash_undefweak))
2856                         {
2857                           /* For a shared library, use the PLT stub as
2858                              target address to decide whether a long
2859                              branch stub is needed.
2860                              For absolute code, they cannot be handled.  */
2861                           struct elf_aarch64_link_hash_table *globals =
2862                             elf_aarch64_hash_table (info);
2863
2864                           if (globals->root.splt != NULL && hash != NULL
2865                               && hash->root.plt.offset != (bfd_vma) - 1)
2866                             {
2867                               sym_sec = globals->root.splt;
2868                               sym_value = hash->root.plt.offset;
2869                               if (sym_sec->output_section != NULL)
2870                                 destination = (sym_value
2871                                                + sym_sec->output_offset
2872                                                +
2873                                                sym_sec->output_section->vma);
2874                             }
2875                           else
2876                             continue;
2877                         }
2878                       else
2879                         {
2880                           bfd_set_error (bfd_error_bad_value);
2881                           goto error_ret_free_internal;
2882                         }
2883                       st_type = ELF_ST_TYPE (hash->root.type);
2884                       sym_name = hash->root.root.root.string;
2885                     }
2886
2887                   /* Determine what (if any) linker stub is needed.  */
2888                   stub_type = aarch64_type_of_stub
2889                     (info, section, irela, st_type, hash, destination);
2890                   if (stub_type == aarch64_stub_none)
2891                     continue;
2892
2893                   /* Support for grouping stub sections.  */
2894                   id_sec = htab->stub_group[section->id].link_sec;
2895
2896                   /* Get the name of this stub.  */
2897                   stub_name = elfNN_aarch64_stub_name (id_sec, sym_sec, hash,
2898                                                        irela);
2899                   if (!stub_name)
2900                     goto error_ret_free_internal;
2901
2902                   stub_entry =
2903                     aarch64_stub_hash_lookup (&htab->stub_hash_table,
2904                                               stub_name, FALSE, FALSE);
2905                   if (stub_entry != NULL)
2906                     {
2907                       /* The proper stub has already been created.  */
2908                       free (stub_name);
2909                       continue;
2910                     }
2911
2912                   stub_entry = elfNN_aarch64_add_stub (stub_name, section,
2913                                                        htab);
2914                   if (stub_entry == NULL)
2915                     {
2916                       free (stub_name);
2917                       goto error_ret_free_internal;
2918                     }
2919
2920                   stub_entry->target_value = sym_value;
2921                   stub_entry->target_section = sym_sec;
2922                   stub_entry->stub_type = stub_type;
2923                   stub_entry->h = hash;
2924                   stub_entry->st_type = st_type;
2925
2926                   if (sym_name == NULL)
2927                     sym_name = "unnamed";
2928                   len = sizeof (STUB_ENTRY_NAME) + strlen (sym_name);
2929                   stub_entry->output_name = bfd_alloc (htab->stub_bfd, len);
2930                   if (stub_entry->output_name == NULL)
2931                     {
2932                       free (stub_name);
2933                       goto error_ret_free_internal;
2934                     }
2935
2936                   snprintf (stub_entry->output_name, len, STUB_ENTRY_NAME,
2937                             sym_name);
2938
2939                   stub_changed = TRUE;
2940                 }
2941
2942               /* We're done with the internal relocs, free them.  */
2943               if (elf_section_data (section)->relocs == NULL)
2944                 free (internal_relocs);
2945             }
2946         }
2947
2948       if (!stub_changed)
2949         break;
2950
2951       /* OK, we've added some stubs.  Find out the new size of the
2952          stub sections.  */
2953       for (stub_sec = htab->stub_bfd->sections;
2954            stub_sec != NULL; stub_sec = stub_sec->next)
2955         stub_sec->size = 0;
2956
2957       bfd_hash_traverse (&htab->stub_hash_table, aarch64_size_one_stub, htab);
2958
2959       /* Ask the linker to do its stuff.  */
2960       (*htab->layout_sections_again) ();
2961       stub_changed = FALSE;
2962     }
2963
2964   return TRUE;
2965
2966 error_ret_free_local:
2967   return FALSE;
2968 }
2969
2970 /* Build all the stubs associated with the current output file.  The
2971    stubs are kept in a hash table attached to the main linker hash
2972    table.  We also set up the .plt entries for statically linked PIC
2973    functions here.  This function is called via aarch64_elf_finish in the
2974    linker.  */
2975
2976 bfd_boolean
2977 elfNN_aarch64_build_stubs (struct bfd_link_info *info)
2978 {
2979   asection *stub_sec;
2980   struct bfd_hash_table *table;
2981   struct elf_aarch64_link_hash_table *htab;
2982
2983   htab = elf_aarch64_hash_table (info);
2984
2985   for (stub_sec = htab->stub_bfd->sections;
2986        stub_sec != NULL; stub_sec = stub_sec->next)
2987     {
2988       bfd_size_type size;
2989
2990       /* Ignore non-stub sections.  */
2991       if (!strstr (stub_sec->name, STUB_SUFFIX))
2992         continue;
2993
2994       /* Allocate memory to hold the linker stubs.  */
2995       size = stub_sec->size;
2996       stub_sec->contents = bfd_zalloc (htab->stub_bfd, size);
2997       if (stub_sec->contents == NULL && size != 0)
2998         return FALSE;
2999       stub_sec->size = 0;
3000     }
3001
3002   /* Build the stubs as directed by the stub hash table.  */
3003   table = &htab->stub_hash_table;
3004   bfd_hash_traverse (table, aarch64_build_one_stub, info);
3005
3006   return TRUE;
3007 }
3008
3009
3010 /* Add an entry to the code/data map for section SEC.  */
3011
3012 static void
3013 elfNN_aarch64_section_map_add (asection *sec, char type, bfd_vma vma)
3014 {
3015   struct _aarch64_elf_section_data *sec_data =
3016     elf_aarch64_section_data (sec);
3017   unsigned int newidx;
3018
3019   if (sec_data->map == NULL)
3020     {
3021       sec_data->map = bfd_malloc (sizeof (elf_aarch64_section_map));
3022       sec_data->mapcount = 0;
3023       sec_data->mapsize = 1;
3024     }
3025
3026   newidx = sec_data->mapcount++;
3027
3028   if (sec_data->mapcount > sec_data->mapsize)
3029     {
3030       sec_data->mapsize *= 2;
3031       sec_data->map = bfd_realloc_or_free
3032         (sec_data->map, sec_data->mapsize * sizeof (elf_aarch64_section_map));
3033     }
3034
3035   if (sec_data->map)
3036     {
3037       sec_data->map[newidx].vma = vma;
3038       sec_data->map[newidx].type = type;
3039     }
3040 }
3041
3042
3043 /* Initialise maps of insn/data for input BFDs.  */
3044 void
3045 bfd_elfNN_aarch64_init_maps (bfd *abfd)
3046 {
3047   Elf_Internal_Sym *isymbuf;
3048   Elf_Internal_Shdr *hdr;
3049   unsigned int i, localsyms;
3050
3051   /* Make sure that we are dealing with an AArch64 elf binary.  */
3052   if (!is_aarch64_elf (abfd))
3053     return;
3054
3055   if ((abfd->flags & DYNAMIC) != 0)
3056     return;
3057
3058   hdr = &elf_symtab_hdr (abfd);
3059   localsyms = hdr->sh_info;
3060
3061   /* Obtain a buffer full of symbols for this BFD. The hdr->sh_info field
3062      should contain the number of local symbols, which should come before any
3063      global symbols.  Mapping symbols are always local.  */
3064   isymbuf = bfd_elf_get_elf_syms (abfd, hdr, localsyms, 0, NULL, NULL, NULL);
3065
3066   /* No internal symbols read?  Skip this BFD.  */
3067   if (isymbuf == NULL)
3068     return;
3069
3070   for (i = 0; i < localsyms; i++)
3071     {
3072       Elf_Internal_Sym *isym = &isymbuf[i];
3073       asection *sec = bfd_section_from_elf_index (abfd, isym->st_shndx);
3074       const char *name;
3075
3076       if (sec != NULL && ELF_ST_BIND (isym->st_info) == STB_LOCAL)
3077         {
3078           name = bfd_elf_string_from_elf_section (abfd,
3079                                                   hdr->sh_link,
3080                                                   isym->st_name);
3081
3082           if (bfd_is_aarch64_special_symbol_name
3083               (name, BFD_AARCH64_SPECIAL_SYM_TYPE_MAP))
3084             elfNN_aarch64_section_map_add (sec, name[1], isym->st_value);
3085         }
3086     }
3087 }
3088
3089 /* Set option values needed during linking.  */
3090 void
3091 bfd_elfNN_aarch64_set_options (struct bfd *output_bfd,
3092                                struct bfd_link_info *link_info,
3093                                int no_enum_warn,
3094                                int no_wchar_warn, int pic_veneer)
3095 {
3096   struct elf_aarch64_link_hash_table *globals;
3097
3098   globals = elf_aarch64_hash_table (link_info);
3099   globals->pic_veneer = pic_veneer;
3100
3101   BFD_ASSERT (is_aarch64_elf (output_bfd));
3102   elf_aarch64_tdata (output_bfd)->no_enum_size_warning = no_enum_warn;
3103   elf_aarch64_tdata (output_bfd)->no_wchar_size_warning = no_wchar_warn;
3104 }
3105
3106 static bfd_vma
3107 aarch64_calculate_got_entry_vma (struct elf_link_hash_entry *h,
3108                                  struct elf_aarch64_link_hash_table
3109                                  *globals, struct bfd_link_info *info,
3110                                  bfd_vma value, bfd *output_bfd,
3111                                  bfd_boolean *unresolved_reloc_p)
3112 {
3113   bfd_vma off = (bfd_vma) - 1;
3114   asection *basegot = globals->root.sgot;
3115   bfd_boolean dyn = globals->root.dynamic_sections_created;
3116
3117   if (h != NULL)
3118     {
3119       BFD_ASSERT (basegot != NULL);
3120       off = h->got.offset;
3121       BFD_ASSERT (off != (bfd_vma) - 1);
3122       if (!WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, info->shared, h)
3123           || (info->shared
3124               && SYMBOL_REFERENCES_LOCAL (info, h))
3125           || (ELF_ST_VISIBILITY (h->other)
3126               && h->root.type == bfd_link_hash_undefweak))
3127         {
3128           /* This is actually a static link, or it is a -Bsymbolic link
3129              and the symbol is defined locally.  We must initialize this
3130              entry in the global offset table.  Since the offset must
3131              always be a multiple of 8 (4 in the case of ILP32), we use
3132              the least significant bit to record whether we have
3133              initialized it already.
3134              When doing a dynamic link, we create a .rel(a).got relocation
3135              entry to initialize the value.  This is done in the
3136              finish_dynamic_symbol routine.  */
3137           if ((off & 1) != 0)
3138             off &= ~1;
3139           else
3140             {
3141               bfd_put_NN (output_bfd, value, basegot->contents + off);
3142               h->got.offset |= 1;
3143             }
3144         }
3145       else
3146         *unresolved_reloc_p = FALSE;
3147
3148       off = off + basegot->output_section->vma + basegot->output_offset;
3149     }
3150
3151   return off;
3152 }
3153
3154 /* Change R_TYPE to a more efficient access model where possible,
3155    return the new reloc type.  */
3156
3157 static bfd_reloc_code_real_type
3158 aarch64_tls_transition_without_check (bfd_reloc_code_real_type r_type,
3159                                       struct elf_link_hash_entry *h)
3160 {
3161   bfd_boolean is_local = h == NULL;
3162
3163   switch (r_type)
3164     {
3165     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3166     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3167       return (is_local
3168               ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1
3169               : BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21);
3170
3171     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3172     case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
3173       return (is_local
3174               ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC
3175               : BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC);
3176
3177     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3178       return is_local ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1 : r_type;
3179
3180     case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
3181       return is_local ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC : r_type;
3182
3183     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3184     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3185       /* Instructions with these relocations will become NOPs.  */
3186       return BFD_RELOC_AARCH64_NONE;
3187
3188     default:
3189       break;
3190     }
3191
3192   return r_type;
3193 }
3194
3195 static unsigned int
3196 aarch64_reloc_got_type (bfd_reloc_code_real_type r_type)
3197 {
3198   switch (r_type)
3199     {
3200     case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
3201     case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
3202     case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
3203     case BFD_RELOC_AARCH64_GOT_LD_PREL19:
3204       return GOT_NORMAL;
3205
3206     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3207     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3208       return GOT_TLS_GD;
3209
3210     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3211     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3212     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3213     case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
3214     case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
3215       return GOT_TLSDESC_GD;
3216
3217     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3218     case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
3219     case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
3220       return GOT_TLS_IE;
3221
3222     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
3223     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
3224     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
3225     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
3226     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
3227     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
3228     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
3229     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
3230       return GOT_UNKNOWN;
3231
3232     default:
3233       break;
3234     }
3235   return GOT_UNKNOWN;
3236 }
3237
3238 static bfd_boolean
3239 aarch64_can_relax_tls (bfd *input_bfd,
3240                        struct bfd_link_info *info,
3241                        bfd_reloc_code_real_type r_type,
3242                        struct elf_link_hash_entry *h,
3243                        unsigned long r_symndx)
3244 {
3245   unsigned int symbol_got_type;
3246   unsigned int reloc_got_type;
3247
3248   if (! IS_AARCH64_TLS_RELOC (r_type))
3249     return FALSE;
3250
3251   symbol_got_type = elfNN_aarch64_symbol_got_type (h, input_bfd, r_symndx);
3252   reloc_got_type = aarch64_reloc_got_type (r_type);
3253
3254   if (symbol_got_type == GOT_TLS_IE && GOT_TLS_GD_ANY_P (reloc_got_type))
3255     return TRUE;
3256
3257   if (info->shared)
3258     return FALSE;
3259
3260   if  (h && h->root.type == bfd_link_hash_undefweak)
3261     return FALSE;
3262
3263   return TRUE;
3264 }
3265
3266 /* Given the relocation code R_TYPE, return the relaxed bfd reloc
3267    enumerator.  */
3268
3269 static bfd_reloc_code_real_type
3270 aarch64_tls_transition (bfd *input_bfd,
3271                         struct bfd_link_info *info,
3272                         unsigned int r_type,
3273                         struct elf_link_hash_entry *h,
3274                         unsigned long r_symndx)
3275 {
3276   bfd_reloc_code_real_type bfd_r_type
3277     = elfNN_aarch64_bfd_reloc_from_type (r_type);
3278
3279   if (! aarch64_can_relax_tls (input_bfd, info, bfd_r_type, h, r_symndx))
3280     return bfd_r_type;
3281
3282   return aarch64_tls_transition_without_check (bfd_r_type, h);
3283 }
3284
3285 /* Return the base VMA address which should be subtracted from real addresses
3286    when resolving R_AARCH64_TLS_DTPREL relocation.  */
3287
3288 static bfd_vma
3289 dtpoff_base (struct bfd_link_info *info)
3290 {
3291   /* If tls_sec is NULL, we should have signalled an error already.  */
3292   BFD_ASSERT (elf_hash_table (info)->tls_sec != NULL);
3293   return elf_hash_table (info)->tls_sec->vma;
3294 }
3295
3296 /* Return the base VMA address which should be subtracted from real addresses
3297    when resolving R_AARCH64_TLS_GOTTPREL64 relocations.  */
3298
3299 static bfd_vma
3300 tpoff_base (struct bfd_link_info *info)
3301 {
3302   struct elf_link_hash_table *htab = elf_hash_table (info);
3303
3304   /* If tls_sec is NULL, we should have signalled an error already.  */
3305   BFD_ASSERT (htab->tls_sec != NULL);
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_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       value = (symbol_tlsdesc_got_offset (input_bfd, h, r_symndx)
3877                + globals->root.sgotplt->output_section->vma
3878                + globals->root.sgotplt->output_offset
3879                + globals->sgotplt_jump_table_size);
3880
3881       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
3882                                                    0, weak_undef_p);
3883       *unresolved_reloc_p = FALSE;
3884       break;
3885
3886     default:
3887       return bfd_reloc_notsupported;
3888     }
3889
3890   if (saved_addend)
3891     *saved_addend = value;
3892
3893   /* Only apply the final relocation in a sequence.  */
3894   if (save_addend)
3895     return bfd_reloc_continue;
3896
3897   return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type,
3898                                       howto, value);
3899 }
3900
3901 /* Handle TLS relaxations.  Relaxing is possible for symbols that use
3902    R_AARCH64_TLSDESC_ADR_{PAGE, LD64_LO12_NC, ADD_LO12_NC} during a static
3903    link.
3904
3905    Return bfd_reloc_ok if we're done, bfd_reloc_continue if the caller
3906    is to then call final_link_relocate.  Return other values in the
3907    case of error.  */
3908
3909 static bfd_reloc_status_type
3910 elfNN_aarch64_tls_relax (struct elf_aarch64_link_hash_table *globals,
3911                          bfd *input_bfd, bfd_byte *contents,
3912                          Elf_Internal_Rela *rel, struct elf_link_hash_entry *h)
3913 {
3914   bfd_boolean is_local = h == NULL;
3915   unsigned int r_type = ELFNN_R_TYPE (rel->r_info);
3916   unsigned long insn;
3917
3918   BFD_ASSERT (globals && input_bfd && contents && rel);
3919
3920   switch (elfNN_aarch64_bfd_reloc_from_type (r_type))
3921     {
3922     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3923     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3924       if (is_local)
3925         {
3926           /* GD->LE relaxation:
3927              adrp x0, :tlsgd:var     =>   movz x0, :tprel_g1:var
3928              or
3929              adrp x0, :tlsdesc:var   =>   movz x0, :tprel_g1:var
3930            */
3931           bfd_putl32 (0xd2a00000, contents + rel->r_offset);
3932           return bfd_reloc_continue;
3933         }
3934       else
3935         {
3936           /* GD->IE relaxation:
3937              adrp x0, :tlsgd:var     =>   adrp x0, :gottprel:var
3938              or
3939              adrp x0, :tlsdesc:var   =>   adrp x0, :gottprel:var
3940            */
3941           return bfd_reloc_continue;
3942         }
3943
3944     case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
3945       if (is_local)
3946         {
3947           /* GD->LE relaxation:
3948              ldr xd, [x0, #:tlsdesc_lo12:var]   =>   movk x0, :tprel_g0_nc:var
3949            */
3950           bfd_putl32 (0xf2800000, contents + rel->r_offset);
3951           return bfd_reloc_continue;
3952         }
3953       else
3954         {
3955           /* GD->IE relaxation:
3956              ldr xd, [x0, #:tlsdesc_lo12:var] => ldr x0, [x0, #:gottprel_lo12:var]
3957            */
3958           insn = bfd_getl32 (contents + rel->r_offset);
3959           insn &= 0xffffffe0;
3960           bfd_putl32 (insn, contents + rel->r_offset);
3961           return bfd_reloc_continue;
3962         }
3963
3964     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3965       if (is_local)
3966         {
3967           /* GD->LE relaxation
3968              add  x0, #:tlsgd_lo12:var  => movk x0, :tprel_g0_nc:var
3969              bl   __tls_get_addr        => mrs  x1, tpidr_el0
3970              nop                        => add  x0, x1, x0
3971            */
3972
3973           /* First kill the tls_get_addr reloc on the bl instruction.  */
3974           BFD_ASSERT (rel->r_offset + 4 == rel[1].r_offset);
3975           rel[1].r_info = ELFNN_R_INFO (STN_UNDEF, R_AARCH64_NONE);
3976
3977           bfd_putl32 (0xf2800000, contents + rel->r_offset);
3978           bfd_putl32 (0xd53bd041, contents + rel->r_offset + 4);
3979           bfd_putl32 (0x8b000020, contents + rel->r_offset + 8);
3980           return bfd_reloc_continue;
3981         }
3982       else
3983         {
3984           /* GD->IE relaxation
3985              ADD  x0, #:tlsgd_lo12:var  => ldr  x0, [x0, #:gottprel_lo12:var]
3986              BL   __tls_get_addr        => mrs  x1, tpidr_el0
3987                R_AARCH64_CALL26
3988              NOP                        => add  x0, x1, x0
3989            */
3990
3991           BFD_ASSERT (ELFNN_R_TYPE (rel[1].r_info) == AARCH64_R (CALL26));
3992
3993           /* Remove the relocation on the BL instruction.  */
3994           rel[1].r_info = ELFNN_R_INFO (STN_UNDEF, R_AARCH64_NONE);
3995
3996           bfd_putl32 (0xf9400000, contents + rel->r_offset);
3997
3998           /* We choose to fixup the BL and NOP instructions using the
3999              offset from the second relocation to allow flexibility in
4000              scheduling instructions between the ADD and BL.  */
4001           bfd_putl32 (0xd53bd041, contents + rel[1].r_offset);
4002           bfd_putl32 (0x8b000020, contents + rel[1].r_offset + 4);
4003           return bfd_reloc_continue;
4004         }
4005
4006     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4007     case BFD_RELOC_AARCH64_TLSDESC_CALL:
4008       /* GD->IE/LE relaxation:
4009          add x0, x0, #:tlsdesc_lo12:var   =>   nop
4010          blr xd                           =>   nop
4011        */
4012       bfd_putl32 (INSN_NOP, contents + rel->r_offset);
4013       return bfd_reloc_ok;
4014
4015     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4016       /* IE->LE relaxation:
4017          adrp xd, :gottprel:var   =>   movz xd, :tprel_g1:var
4018        */
4019       if (is_local)
4020         {
4021           insn = bfd_getl32 (contents + rel->r_offset);
4022           bfd_putl32 (0xd2a00000 | (insn & 0x1f), contents + rel->r_offset);
4023         }
4024       return bfd_reloc_continue;
4025
4026     case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
4027       /* IE->LE relaxation:
4028          ldr  xd, [xm, #:gottprel_lo12:var]   =>   movk xd, :tprel_g0_nc:var
4029        */
4030       if (is_local)
4031         {
4032           insn = bfd_getl32 (contents + rel->r_offset);
4033           bfd_putl32 (0xf2800000 | (insn & 0x1f), contents + rel->r_offset);
4034         }
4035       return bfd_reloc_continue;
4036
4037     default:
4038       return bfd_reloc_continue;
4039     }
4040
4041   return bfd_reloc_ok;
4042 }
4043
4044 /* Relocate an AArch64 ELF section.  */
4045
4046 static bfd_boolean
4047 elfNN_aarch64_relocate_section (bfd *output_bfd,
4048                                 struct bfd_link_info *info,
4049                                 bfd *input_bfd,
4050                                 asection *input_section,
4051                                 bfd_byte *contents,
4052                                 Elf_Internal_Rela *relocs,
4053                                 Elf_Internal_Sym *local_syms,
4054                                 asection **local_sections)
4055 {
4056   Elf_Internal_Shdr *symtab_hdr;
4057   struct elf_link_hash_entry **sym_hashes;
4058   Elf_Internal_Rela *rel;
4059   Elf_Internal_Rela *relend;
4060   const char *name;
4061   struct elf_aarch64_link_hash_table *globals;
4062   bfd_boolean save_addend = FALSE;
4063   bfd_vma addend = 0;
4064
4065   globals = elf_aarch64_hash_table (info);
4066
4067   symtab_hdr = &elf_symtab_hdr (input_bfd);
4068   sym_hashes = elf_sym_hashes (input_bfd);
4069
4070   rel = relocs;
4071   relend = relocs + input_section->reloc_count;
4072   for (; rel < relend; rel++)
4073     {
4074       unsigned int r_type;
4075       bfd_reloc_code_real_type bfd_r_type;
4076       bfd_reloc_code_real_type relaxed_bfd_r_type;
4077       reloc_howto_type *howto;
4078       unsigned long r_symndx;
4079       Elf_Internal_Sym *sym;
4080       asection *sec;
4081       struct elf_link_hash_entry *h;
4082       bfd_vma relocation;
4083       bfd_reloc_status_type r;
4084       arelent bfd_reloc;
4085       char sym_type;
4086       bfd_boolean unresolved_reloc = FALSE;
4087       char *error_message = NULL;
4088
4089       r_symndx = ELFNN_R_SYM (rel->r_info);
4090       r_type = ELFNN_R_TYPE (rel->r_info);
4091
4092       bfd_reloc.howto = elfNN_aarch64_howto_from_type (r_type);
4093       howto = bfd_reloc.howto;
4094
4095       if (howto == NULL)
4096         {
4097           (*_bfd_error_handler)
4098             (_("%B: unrecognized relocation (0x%x) in section `%A'"),
4099              input_bfd, input_section, r_type);
4100           return FALSE;
4101         }
4102       bfd_r_type = elfNN_aarch64_bfd_reloc_from_howto (howto);
4103
4104       h = NULL;
4105       sym = NULL;
4106       sec = NULL;
4107
4108       if (r_symndx < symtab_hdr->sh_info)
4109         {
4110           sym = local_syms + r_symndx;
4111           sym_type = ELFNN_ST_TYPE (sym->st_info);
4112           sec = local_sections[r_symndx];
4113
4114           /* An object file might have a reference to a local
4115              undefined symbol.  This is a daft object file, but we
4116              should at least do something about it.  */
4117           if (r_type != R_AARCH64_NONE && r_type != R_AARCH64_NULL
4118               && bfd_is_und_section (sec)
4119               && ELF_ST_BIND (sym->st_info) != STB_WEAK)
4120             {
4121               if (!info->callbacks->undefined_symbol
4122                   (info, bfd_elf_string_from_elf_section
4123                    (input_bfd, symtab_hdr->sh_link, sym->st_name),
4124                    input_bfd, input_section, rel->r_offset, TRUE))
4125                 return FALSE;
4126             }
4127
4128           relocation = _bfd_elf_rela_local_sym (output_bfd, sym, &sec, rel);
4129
4130           /* Relocate against local STT_GNU_IFUNC symbol.  */
4131           if (!info->relocatable
4132               && ELF_ST_TYPE (sym->st_info) == STT_GNU_IFUNC)
4133             {
4134               h = elfNN_aarch64_get_local_sym_hash (globals, input_bfd,
4135                                                     rel, FALSE);
4136               if (h == NULL)
4137                 abort ();
4138
4139               /* Set STT_GNU_IFUNC symbol value.  */
4140               h->root.u.def.value = sym->st_value;
4141               h->root.u.def.section = sec;
4142             }
4143         }
4144       else
4145         {
4146           bfd_boolean warned, ignored;
4147
4148           RELOC_FOR_GLOBAL_SYMBOL (info, input_bfd, input_section, rel,
4149                                    r_symndx, symtab_hdr, sym_hashes,
4150                                    h, sec, relocation,
4151                                    unresolved_reloc, warned, ignored);
4152
4153           sym_type = h->type;
4154         }
4155
4156       if (sec != NULL && discarded_section (sec))
4157         RELOC_AGAINST_DISCARDED_SECTION (info, input_bfd, input_section,
4158                                          rel, 1, relend, howto, 0, contents);
4159
4160       if (info->relocatable)
4161         continue;
4162
4163       if (h != NULL)
4164         name = h->root.root.string;
4165       else
4166         {
4167           name = (bfd_elf_string_from_elf_section
4168                   (input_bfd, symtab_hdr->sh_link, sym->st_name));
4169           if (name == NULL || *name == '\0')
4170             name = bfd_section_name (input_bfd, sec);
4171         }
4172
4173       if (r_symndx != 0
4174           && r_type != R_AARCH64_NONE
4175           && r_type != R_AARCH64_NULL
4176           && (h == NULL
4177               || h->root.type == bfd_link_hash_defined
4178               || h->root.type == bfd_link_hash_defweak)
4179           && IS_AARCH64_TLS_RELOC (bfd_r_type) != (sym_type == STT_TLS))
4180         {
4181           (*_bfd_error_handler)
4182             ((sym_type == STT_TLS
4183               ? _("%B(%A+0x%lx): %s used with TLS symbol %s")
4184               : _("%B(%A+0x%lx): %s used with non-TLS symbol %s")),
4185              input_bfd,
4186              input_section, (long) rel->r_offset, howto->name, name);
4187         }
4188
4189       /* We relax only if we can see that there can be a valid transition
4190          from a reloc type to another.
4191          We call elfNN_aarch64_final_link_relocate unless we're completely
4192          done, i.e., the relaxation produced the final output we want.  */
4193
4194       relaxed_bfd_r_type = aarch64_tls_transition (input_bfd, info, r_type,
4195                                                    h, r_symndx);
4196       if (relaxed_bfd_r_type != bfd_r_type)
4197         {
4198           bfd_r_type = relaxed_bfd_r_type;
4199           howto = elfNN_aarch64_howto_from_bfd_reloc (bfd_r_type);
4200           BFD_ASSERT (howto != NULL);
4201           r_type = howto->type;
4202           r = elfNN_aarch64_tls_relax (globals, input_bfd, contents, rel, h);
4203           unresolved_reloc = 0;
4204         }
4205       else
4206         r = bfd_reloc_continue;
4207
4208       /* There may be multiple consecutive relocations for the
4209          same offset.  In that case we are supposed to treat the
4210          output of each relocation as the addend for the next.  */
4211       if (rel + 1 < relend
4212           && rel->r_offset == rel[1].r_offset
4213           && ELFNN_R_TYPE (rel[1].r_info) != R_AARCH64_NONE
4214           && ELFNN_R_TYPE (rel[1].r_info) != R_AARCH64_NULL)
4215         save_addend = TRUE;
4216       else
4217         save_addend = FALSE;
4218
4219       if (r == bfd_reloc_continue)
4220         r = elfNN_aarch64_final_link_relocate (howto, input_bfd, output_bfd,
4221                                                input_section, contents, rel,
4222                                                relocation, info, sec,
4223                                                h, &unresolved_reloc,
4224                                                save_addend, &addend, sym);
4225
4226       switch (elfNN_aarch64_bfd_reloc_from_type (r_type))
4227         {
4228         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4229         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4230           if (! symbol_got_offset_mark_p (input_bfd, h, r_symndx))
4231             {
4232               bfd_boolean need_relocs = FALSE;
4233               bfd_byte *loc;
4234               int indx;
4235               bfd_vma off;
4236
4237               off = symbol_got_offset (input_bfd, h, r_symndx);
4238               indx = h && h->dynindx != -1 ? h->dynindx : 0;
4239
4240               need_relocs =
4241                 (info->shared || indx != 0) &&
4242                 (h == NULL
4243                  || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4244                  || h->root.type != bfd_link_hash_undefweak);
4245
4246               BFD_ASSERT (globals->root.srelgot != NULL);
4247
4248               if (need_relocs)
4249                 {
4250                   Elf_Internal_Rela rela;
4251                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLS_DTPMOD));
4252                   rela.r_addend = 0;
4253                   rela.r_offset = globals->root.sgot->output_section->vma +
4254                     globals->root.sgot->output_offset + off;
4255
4256
4257                   loc = globals->root.srelgot->contents;
4258                   loc += globals->root.srelgot->reloc_count++
4259                     * RELOC_SIZE (htab);
4260                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4261
4262                   if (indx == 0)
4263                     {
4264                       bfd_put_NN (output_bfd,
4265                                   relocation - dtpoff_base (info),
4266                                   globals->root.sgot->contents + off
4267                                   + GOT_ENTRY_SIZE);
4268                     }
4269                   else
4270                     {
4271                       /* This TLS symbol is global. We emit a
4272                          relocation to fixup the tls offset at load
4273                          time.  */
4274                       rela.r_info =
4275                         ELFNN_R_INFO (indx, AARCH64_R (TLS_DTPREL));
4276                       rela.r_addend = 0;
4277                       rela.r_offset =
4278                         (globals->root.sgot->output_section->vma
4279                          + globals->root.sgot->output_offset + off
4280                          + GOT_ENTRY_SIZE);
4281
4282                       loc = globals->root.srelgot->contents;
4283                       loc += globals->root.srelgot->reloc_count++
4284                         * RELOC_SIZE (globals);
4285                       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4286                       bfd_put_NN (output_bfd, (bfd_vma) 0,
4287                                   globals->root.sgot->contents + off
4288                                   + GOT_ENTRY_SIZE);
4289                     }
4290                 }
4291               else
4292                 {
4293                   bfd_put_NN (output_bfd, (bfd_vma) 1,
4294                               globals->root.sgot->contents + off);
4295                   bfd_put_NN (output_bfd,
4296                               relocation - dtpoff_base (info),
4297                               globals->root.sgot->contents + off
4298                               + GOT_ENTRY_SIZE);
4299                 }
4300
4301               symbol_got_offset_mark (input_bfd, h, r_symndx);
4302             }
4303           break;
4304
4305         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4306         case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
4307           if (! symbol_got_offset_mark_p (input_bfd, h, r_symndx))
4308             {
4309               bfd_boolean need_relocs = FALSE;
4310               bfd_byte *loc;
4311               int indx;
4312               bfd_vma off;
4313
4314               off = symbol_got_offset (input_bfd, h, r_symndx);
4315
4316               indx = h && h->dynindx != -1 ? h->dynindx : 0;
4317
4318               need_relocs =
4319                 (info->shared || indx != 0) &&
4320                 (h == NULL
4321                  || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4322                  || h->root.type != bfd_link_hash_undefweak);
4323
4324               BFD_ASSERT (globals->root.srelgot != NULL);
4325
4326               if (need_relocs)
4327                 {
4328                   Elf_Internal_Rela rela;
4329
4330                   if (indx == 0)
4331                     rela.r_addend = relocation - dtpoff_base (info);
4332                   else
4333                     rela.r_addend = 0;
4334
4335                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLS_TPREL));
4336                   rela.r_offset = globals->root.sgot->output_section->vma +
4337                     globals->root.sgot->output_offset + off;
4338
4339                   loc = globals->root.srelgot->contents;
4340                   loc += globals->root.srelgot->reloc_count++
4341                     * RELOC_SIZE (htab);
4342
4343                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4344
4345                   bfd_put_NN (output_bfd, rela.r_addend,
4346                               globals->root.sgot->contents + off);
4347                 }
4348               else
4349                 bfd_put_NN (output_bfd, relocation - tpoff_base (info),
4350                             globals->root.sgot->contents + off);
4351
4352               symbol_got_offset_mark (input_bfd, h, r_symndx);
4353             }
4354           break;
4355
4356         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
4357         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
4358         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
4359         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
4360         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
4361         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
4362         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
4363         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
4364           break;
4365
4366         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4367         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
4368         case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
4369           if (! symbol_tlsdesc_got_offset_mark_p (input_bfd, h, r_symndx))
4370             {
4371               bfd_boolean need_relocs = FALSE;
4372               int indx = h && h->dynindx != -1 ? h->dynindx : 0;
4373               bfd_vma off = symbol_tlsdesc_got_offset (input_bfd, h, r_symndx);
4374
4375               need_relocs = (h == NULL
4376                              || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4377                              || h->root.type != bfd_link_hash_undefweak);
4378
4379               BFD_ASSERT (globals->root.srelgot != NULL);
4380               BFD_ASSERT (globals->root.sgot != NULL);
4381
4382               if (need_relocs)
4383                 {
4384                   bfd_byte *loc;
4385                   Elf_Internal_Rela rela;
4386                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLSDESC));
4387
4388                   rela.r_addend = 0;
4389                   rela.r_offset = (globals->root.sgotplt->output_section->vma
4390                                    + globals->root.sgotplt->output_offset
4391                                    + off + globals->sgotplt_jump_table_size);
4392
4393                   if (indx == 0)
4394                     rela.r_addend = relocation - dtpoff_base (info);
4395
4396                   /* Allocate the next available slot in the PLT reloc
4397                      section to hold our R_AARCH64_TLSDESC, the next
4398                      available slot is determined from reloc_count,
4399                      which we step. But note, reloc_count was
4400                      artifically moved down while allocating slots for
4401                      real PLT relocs such that all of the PLT relocs
4402                      will fit above the initial reloc_count and the
4403                      extra stuff will fit below.  */
4404                   loc = globals->root.srelplt->contents;
4405                   loc += globals->root.srelplt->reloc_count++
4406                     * RELOC_SIZE (globals);
4407
4408                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4409
4410                   bfd_put_NN (output_bfd, (bfd_vma) 0,
4411                               globals->root.sgotplt->contents + off +
4412                               globals->sgotplt_jump_table_size);
4413                   bfd_put_NN (output_bfd, (bfd_vma) 0,
4414                               globals->root.sgotplt->contents + off +
4415                               globals->sgotplt_jump_table_size +
4416                               GOT_ENTRY_SIZE);
4417                 }
4418
4419               symbol_tlsdesc_got_offset_mark (input_bfd, h, r_symndx);
4420             }
4421           break;
4422         default:
4423           break;
4424         }
4425
4426       if (!save_addend)
4427         addend = 0;
4428
4429
4430       /* Dynamic relocs are not propagated for SEC_DEBUGGING sections
4431          because such sections are not SEC_ALLOC and thus ld.so will
4432          not process them.  */
4433       if (unresolved_reloc
4434           && !((input_section->flags & SEC_DEBUGGING) != 0
4435                && h->def_dynamic)
4436           && _bfd_elf_section_offset (output_bfd, info, input_section,
4437                                       +rel->r_offset) != (bfd_vma) - 1)
4438         {
4439           (*_bfd_error_handler)
4440             (_
4441              ("%B(%A+0x%lx): unresolvable %s relocation against symbol `%s'"),
4442              input_bfd, input_section, (long) rel->r_offset, howto->name,
4443              h->root.root.string);
4444           return FALSE;
4445         }
4446
4447       if (r != bfd_reloc_ok && r != bfd_reloc_continue)
4448         {
4449           switch (r)
4450             {
4451             case bfd_reloc_overflow:
4452               /* If the overflowing reloc was to an undefined symbol,
4453                  we have already printed one error message and there
4454                  is no point complaining again.  */
4455               if ((!h ||
4456                    h->root.type != bfd_link_hash_undefined)
4457                   && (!((*info->callbacks->reloc_overflow)
4458                         (info, (h ? &h->root : NULL), name, howto->name,
4459                          (bfd_vma) 0, input_bfd, input_section,
4460                          rel->r_offset))))
4461                 return FALSE;
4462               break;
4463
4464             case bfd_reloc_undefined:
4465               if (!((*info->callbacks->undefined_symbol)
4466                     (info, name, input_bfd, input_section,
4467                      rel->r_offset, TRUE)))
4468                 return FALSE;
4469               break;
4470
4471             case bfd_reloc_outofrange:
4472               error_message = _("out of range");
4473               goto common_error;
4474
4475             case bfd_reloc_notsupported:
4476               error_message = _("unsupported relocation");
4477               goto common_error;
4478
4479             case bfd_reloc_dangerous:
4480               /* error_message should already be set.  */
4481               goto common_error;
4482
4483             default:
4484               error_message = _("unknown error");
4485               /* Fall through.  */
4486
4487             common_error:
4488               BFD_ASSERT (error_message != NULL);
4489               if (!((*info->callbacks->reloc_dangerous)
4490                     (info, error_message, input_bfd, input_section,
4491                      rel->r_offset)))
4492                 return FALSE;
4493               break;
4494             }
4495         }
4496     }
4497
4498   return TRUE;
4499 }
4500
4501 /* Set the right machine number.  */
4502
4503 static bfd_boolean
4504 elfNN_aarch64_object_p (bfd *abfd)
4505 {
4506 #if ARCH_SIZE == 32
4507   bfd_default_set_arch_mach (abfd, bfd_arch_aarch64, bfd_mach_aarch64_ilp32);
4508 #else
4509   bfd_default_set_arch_mach (abfd, bfd_arch_aarch64, bfd_mach_aarch64);
4510 #endif
4511   return TRUE;
4512 }
4513
4514 /* Function to keep AArch64 specific flags in the ELF header.  */
4515
4516 static bfd_boolean
4517 elfNN_aarch64_set_private_flags (bfd *abfd, flagword flags)
4518 {
4519   if (elf_flags_init (abfd) && elf_elfheader (abfd)->e_flags != flags)
4520     {
4521     }
4522   else
4523     {
4524       elf_elfheader (abfd)->e_flags = flags;
4525       elf_flags_init (abfd) = TRUE;
4526     }
4527
4528   return TRUE;
4529 }
4530
4531 /* Merge backend specific data from an object file to the output
4532    object file when linking.  */
4533
4534 static bfd_boolean
4535 elfNN_aarch64_merge_private_bfd_data (bfd *ibfd, bfd *obfd)
4536 {
4537   flagword out_flags;
4538   flagword in_flags;
4539   bfd_boolean flags_compatible = TRUE;
4540   asection *sec;
4541
4542   /* Check if we have the same endianess.  */
4543   if (!_bfd_generic_verify_endian_match (ibfd, obfd))
4544     return FALSE;
4545
4546   if (!is_aarch64_elf (ibfd) || !is_aarch64_elf (obfd))
4547     return TRUE;
4548
4549   /* The input BFD must have had its flags initialised.  */
4550   /* The following seems bogus to me -- The flags are initialized in
4551      the assembler but I don't think an elf_flags_init field is
4552      written into the object.  */
4553   /* BFD_ASSERT (elf_flags_init (ibfd)); */
4554
4555   in_flags = elf_elfheader (ibfd)->e_flags;
4556   out_flags = elf_elfheader (obfd)->e_flags;
4557
4558   if (!elf_flags_init (obfd))
4559     {
4560       /* If the input is the default architecture and had the default
4561          flags then do not bother setting the flags for the output
4562          architecture, instead allow future merges to do this.  If no
4563          future merges ever set these flags then they will retain their
4564          uninitialised values, which surprise surprise, correspond
4565          to the default values.  */
4566       if (bfd_get_arch_info (ibfd)->the_default
4567           && elf_elfheader (ibfd)->e_flags == 0)
4568         return TRUE;
4569
4570       elf_flags_init (obfd) = TRUE;
4571       elf_elfheader (obfd)->e_flags = in_flags;
4572
4573       if (bfd_get_arch (obfd) == bfd_get_arch (ibfd)
4574           && bfd_get_arch_info (obfd)->the_default)
4575         return bfd_set_arch_mach (obfd, bfd_get_arch (ibfd),
4576                                   bfd_get_mach (ibfd));
4577
4578       return TRUE;
4579     }
4580
4581   /* Identical flags must be compatible.  */
4582   if (in_flags == out_flags)
4583     return TRUE;
4584
4585   /* Check to see if the input BFD actually contains any sections.  If
4586      not, its flags may not have been initialised either, but it
4587      cannot actually cause any incompatiblity.  Do not short-circuit
4588      dynamic objects; their section list may be emptied by
4589      elf_link_add_object_symbols.
4590
4591      Also check to see if there are no code sections in the input.
4592      In this case there is no need to check for code specific flags.
4593      XXX - do we need to worry about floating-point format compatability
4594      in data sections ?  */
4595   if (!(ibfd->flags & DYNAMIC))
4596     {
4597       bfd_boolean null_input_bfd = TRUE;
4598       bfd_boolean only_data_sections = TRUE;
4599
4600       for (sec = ibfd->sections; sec != NULL; sec = sec->next)
4601         {
4602           if ((bfd_get_section_flags (ibfd, sec)
4603                & (SEC_LOAD | SEC_CODE | SEC_HAS_CONTENTS))
4604               == (SEC_LOAD | SEC_CODE | SEC_HAS_CONTENTS))
4605             only_data_sections = FALSE;
4606
4607           null_input_bfd = FALSE;
4608           break;
4609         }
4610
4611       if (null_input_bfd || only_data_sections)
4612         return TRUE;
4613     }
4614
4615   return flags_compatible;
4616 }
4617
4618 /* Display the flags field.  */
4619
4620 static bfd_boolean
4621 elfNN_aarch64_print_private_bfd_data (bfd *abfd, void *ptr)
4622 {
4623   FILE *file = (FILE *) ptr;
4624   unsigned long flags;
4625
4626   BFD_ASSERT (abfd != NULL && ptr != NULL);
4627
4628   /* Print normal ELF private data.  */
4629   _bfd_elf_print_private_bfd_data (abfd, ptr);
4630
4631   flags = elf_elfheader (abfd)->e_flags;
4632   /* Ignore init flag - it may not be set, despite the flags field
4633      containing valid data.  */
4634
4635   /* xgettext:c-format */
4636   fprintf (file, _("private flags = %lx:"), elf_elfheader (abfd)->e_flags);
4637
4638   if (flags)
4639     fprintf (file, _("<Unrecognised flag bits set>"));
4640
4641   fputc ('\n', file);
4642
4643   return TRUE;
4644 }
4645
4646 /* Update the got entry reference counts for the section being removed.  */
4647
4648 static bfd_boolean
4649 elfNN_aarch64_gc_sweep_hook (bfd *abfd,
4650                              struct bfd_link_info *info,
4651                              asection *sec,
4652                              const Elf_Internal_Rela * relocs)
4653 {
4654   struct elf_aarch64_link_hash_table *htab;
4655   Elf_Internal_Shdr *symtab_hdr;
4656   struct elf_link_hash_entry **sym_hashes;
4657   struct elf_aarch64_local_symbol *locals;
4658   const Elf_Internal_Rela *rel, *relend;
4659
4660   if (info->relocatable)
4661     return TRUE;
4662
4663   htab = elf_aarch64_hash_table (info);
4664
4665   if (htab == NULL)
4666     return FALSE;
4667
4668   elf_section_data (sec)->local_dynrel = NULL;
4669
4670   symtab_hdr = &elf_symtab_hdr (abfd);
4671   sym_hashes = elf_sym_hashes (abfd);
4672
4673   locals = elf_aarch64_locals (abfd);
4674
4675   relend = relocs + sec->reloc_count;
4676   for (rel = relocs; rel < relend; rel++)
4677     {
4678       unsigned long r_symndx;
4679       unsigned int r_type;
4680       struct elf_link_hash_entry *h = NULL;
4681
4682       r_symndx = ELFNN_R_SYM (rel->r_info);
4683
4684       if (r_symndx >= symtab_hdr->sh_info)
4685         {
4686
4687           h = sym_hashes[r_symndx - symtab_hdr->sh_info];
4688           while (h->root.type == bfd_link_hash_indirect
4689                  || h->root.type == bfd_link_hash_warning)
4690             h = (struct elf_link_hash_entry *) h->root.u.i.link;
4691         }
4692       else
4693         {
4694           Elf_Internal_Sym *isym;
4695
4696           /* A local symbol.  */
4697           isym = bfd_sym_from_r_symndx (&htab->sym_cache,
4698                                         abfd, r_symndx);
4699
4700           /* Check relocation against local STT_GNU_IFUNC symbol.  */
4701           if (isym != NULL
4702               && ELF_ST_TYPE (isym->st_info) == STT_GNU_IFUNC)
4703             {
4704               h = elfNN_aarch64_get_local_sym_hash (htab, abfd, rel, FALSE);
4705               if (h == NULL)
4706                 abort ();
4707             }
4708         }
4709
4710       if (h)
4711         {
4712           struct elf_aarch64_link_hash_entry *eh;
4713           struct elf_dyn_relocs **pp;
4714           struct elf_dyn_relocs *p;
4715
4716           eh = (struct elf_aarch64_link_hash_entry *) h;
4717
4718           for (pp = &eh->dyn_relocs; (p = *pp) != NULL; pp = &p->next)
4719             if (p->sec == sec)
4720               {
4721                 /* Everything must go for SEC.  */
4722                 *pp = p->next;
4723                 break;
4724               }
4725         }
4726
4727       r_type = ELFNN_R_TYPE (rel->r_info);
4728       switch (aarch64_tls_transition (abfd,info, r_type, h ,r_symndx))
4729         {
4730         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
4731         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
4732         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
4733         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
4734         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4735         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
4736         case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
4737         case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
4738         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4739         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4740         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4741         case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
4742         case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
4743         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
4744         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
4745         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
4746         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
4747         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
4748         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
4749         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
4750         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
4751           if (h != NULL)
4752             {
4753               if (h->got.refcount > 0)
4754                 h->got.refcount -= 1;
4755
4756               if (h->type == STT_GNU_IFUNC)
4757                 {
4758                   if (h->plt.refcount > 0)
4759                     h->plt.refcount -= 1;
4760                 }
4761             }
4762           else if (locals != NULL)
4763             {
4764               if (locals[r_symndx].got_refcount > 0)
4765                 locals[r_symndx].got_refcount -= 1;
4766             }
4767           break;
4768
4769         case BFD_RELOC_AARCH64_CALL26:
4770         case BFD_RELOC_AARCH64_JUMP26:
4771           /* If this is a local symbol then we resolve it
4772              directly without creating a PLT entry.  */
4773           if (h == NULL)
4774             continue;
4775
4776           if (h->plt.refcount > 0)
4777             h->plt.refcount -= 1;
4778           break;
4779
4780         case BFD_RELOC_AARCH64_MOVW_G0_NC:
4781         case BFD_RELOC_AARCH64_MOVW_G1_NC:
4782         case BFD_RELOC_AARCH64_MOVW_G2_NC:
4783         case BFD_RELOC_AARCH64_MOVW_G3:
4784         case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
4785         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
4786         case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
4787         case BFD_RELOC_AARCH64_NN:
4788           if (h != NULL && info->executable)
4789             {
4790               if (h->plt.refcount > 0)
4791                 h->plt.refcount -= 1;
4792             }
4793           break;
4794
4795         default:
4796           break;
4797         }
4798     }
4799
4800   return TRUE;
4801 }
4802
4803 /* Adjust a symbol defined by a dynamic object and referenced by a
4804    regular object.  The current definition is in some section of the
4805    dynamic object, but we're not including those sections.  We have to
4806    change the definition to something the rest of the link can
4807    understand.  */
4808
4809 static bfd_boolean
4810 elfNN_aarch64_adjust_dynamic_symbol (struct bfd_link_info *info,
4811                                      struct elf_link_hash_entry *h)
4812 {
4813   struct elf_aarch64_link_hash_table *htab;
4814   asection *s;
4815
4816   /* If this is a function, put it in the procedure linkage table.  We
4817      will fill in the contents of the procedure linkage table later,
4818      when we know the address of the .got section.  */
4819   if (h->type == STT_FUNC || h->type == STT_GNU_IFUNC || h->needs_plt)
4820     {
4821       if (h->plt.refcount <= 0
4822           || (h->type != STT_GNU_IFUNC
4823               && (SYMBOL_CALLS_LOCAL (info, h)
4824                   || (ELF_ST_VISIBILITY (h->other) != STV_DEFAULT
4825                       && h->root.type == bfd_link_hash_undefweak))))
4826         {
4827           /* This case can occur if we saw a CALL26 reloc in
4828              an input file, but the symbol wasn't referred to
4829              by a dynamic object or all references were
4830              garbage collected. In which case we can end up
4831              resolving.  */
4832           h->plt.offset = (bfd_vma) - 1;
4833           h->needs_plt = 0;
4834         }
4835
4836       return TRUE;
4837     }
4838   else
4839     /* It's possible that we incorrectly decided a .plt reloc was
4840        needed for an R_X86_64_PC32 reloc to a non-function sym in
4841        check_relocs.  We can't decide accurately between function and
4842        non-function syms in check-relocs;  Objects loaded later in
4843        the link may change h->type.  So fix it now.  */
4844     h->plt.offset = (bfd_vma) - 1;
4845
4846
4847   /* If this is a weak symbol, and there is a real definition, the
4848      processor independent code will have arranged for us to see the
4849      real definition first, and we can just use the same value.  */
4850   if (h->u.weakdef != NULL)
4851     {
4852       BFD_ASSERT (h->u.weakdef->root.type == bfd_link_hash_defined
4853                   || h->u.weakdef->root.type == bfd_link_hash_defweak);
4854       h->root.u.def.section = h->u.weakdef->root.u.def.section;
4855       h->root.u.def.value = h->u.weakdef->root.u.def.value;
4856       if (ELIMINATE_COPY_RELOCS || info->nocopyreloc)
4857         h->non_got_ref = h->u.weakdef->non_got_ref;
4858       return TRUE;
4859     }
4860
4861   /* If we are creating a shared library, we must presume that the
4862      only references to the symbol are via the global offset table.
4863      For such cases we need not do anything here; the relocations will
4864      be handled correctly by relocate_section.  */
4865   if (info->shared)
4866     return TRUE;
4867
4868   /* If there are no references to this symbol that do not use the
4869      GOT, we don't need to generate a copy reloc.  */
4870   if (!h->non_got_ref)
4871     return TRUE;
4872
4873   /* If -z nocopyreloc was given, we won't generate them either.  */
4874   if (info->nocopyreloc)
4875     {
4876       h->non_got_ref = 0;
4877       return TRUE;
4878     }
4879
4880   /* We must allocate the symbol in our .dynbss section, which will
4881      become part of the .bss section of the executable.  There will be
4882      an entry for this symbol in the .dynsym section.  The dynamic
4883      object will contain position independent code, so all references
4884      from the dynamic object to this symbol will go through the global
4885      offset table.  The dynamic linker will use the .dynsym entry to
4886      determine the address it must put in the global offset table, so
4887      both the dynamic object and the regular object will refer to the
4888      same memory location for the variable.  */
4889
4890   htab = elf_aarch64_hash_table (info);
4891
4892   /* We must generate a R_AARCH64_COPY reloc to tell the dynamic linker
4893      to copy the initial value out of the dynamic object and into the
4894      runtime process image.  */
4895   if ((h->root.u.def.section->flags & SEC_ALLOC) != 0 && h->size != 0)
4896     {
4897       htab->srelbss->size += RELOC_SIZE (htab);
4898       h->needs_copy = 1;
4899     }
4900
4901   s = htab->sdynbss;
4902
4903   return _bfd_elf_adjust_dynamic_copy (h, s);
4904
4905 }
4906
4907 static bfd_boolean
4908 elfNN_aarch64_allocate_local_symbols (bfd *abfd, unsigned number)
4909 {
4910   struct elf_aarch64_local_symbol *locals;
4911   locals = elf_aarch64_locals (abfd);
4912   if (locals == NULL)
4913     {
4914       locals = (struct elf_aarch64_local_symbol *)
4915         bfd_zalloc (abfd, number * sizeof (struct elf_aarch64_local_symbol));
4916       if (locals == NULL)
4917         return FALSE;
4918       elf_aarch64_locals (abfd) = locals;
4919     }
4920   return TRUE;
4921 }
4922
4923 /* Create the .got section to hold the global offset table.  */
4924
4925 static bfd_boolean
4926 aarch64_elf_create_got_section (bfd *abfd, struct bfd_link_info *info)
4927 {
4928   const struct elf_backend_data *bed = get_elf_backend_data (abfd);
4929   flagword flags;
4930   asection *s;
4931   struct elf_link_hash_entry *h;
4932   struct elf_link_hash_table *htab = elf_hash_table (info);
4933
4934   /* This function may be called more than once.  */
4935   s = bfd_get_linker_section (abfd, ".got");
4936   if (s != NULL)
4937     return TRUE;
4938
4939   flags = bed->dynamic_sec_flags;
4940
4941   s = bfd_make_section_anyway_with_flags (abfd,
4942                                           (bed->rela_plts_and_copies_p
4943                                            ? ".rela.got" : ".rel.got"),
4944                                           (bed->dynamic_sec_flags
4945                                            | SEC_READONLY));
4946   if (s == NULL
4947       || ! bfd_set_section_alignment (abfd, s, bed->s->log_file_align))
4948     return FALSE;
4949   htab->srelgot = s;
4950
4951   s = bfd_make_section_anyway_with_flags (abfd, ".got", flags);
4952   if (s == NULL
4953       || !bfd_set_section_alignment (abfd, s, bed->s->log_file_align))
4954     return FALSE;
4955   htab->sgot = s;
4956   htab->sgot->size += GOT_ENTRY_SIZE;
4957
4958   if (bed->want_got_sym)
4959     {
4960       /* Define the symbol _GLOBAL_OFFSET_TABLE_ at the start of the .got
4961          (or .got.plt) section.  We don't do this in the linker script
4962          because we don't want to define the symbol if we are not creating
4963          a global offset table.  */
4964       h = _bfd_elf_define_linkage_sym (abfd, info, s,
4965                                        "_GLOBAL_OFFSET_TABLE_");
4966       elf_hash_table (info)->hgot = h;
4967       if (h == NULL)
4968         return FALSE;
4969     }
4970
4971   if (bed->want_got_plt)
4972     {
4973       s = bfd_make_section_anyway_with_flags (abfd, ".got.plt", flags);
4974       if (s == NULL
4975           || !bfd_set_section_alignment (abfd, s,
4976                                          bed->s->log_file_align))
4977         return FALSE;
4978       htab->sgotplt = s;
4979     }
4980
4981   /* The first bit of the global offset table is the header.  */
4982   s->size += bed->got_header_size;
4983
4984   return TRUE;
4985 }
4986
4987 /* Look through the relocs for a section during the first phase.  */
4988
4989 static bfd_boolean
4990 elfNN_aarch64_check_relocs (bfd *abfd, struct bfd_link_info *info,
4991                             asection *sec, const Elf_Internal_Rela *relocs)
4992 {
4993   Elf_Internal_Shdr *symtab_hdr;
4994   struct elf_link_hash_entry **sym_hashes;
4995   const Elf_Internal_Rela *rel;
4996   const Elf_Internal_Rela *rel_end;
4997   asection *sreloc;
4998
4999   struct elf_aarch64_link_hash_table *htab;
5000
5001   if (info->relocatable)
5002     return TRUE;
5003
5004   BFD_ASSERT (is_aarch64_elf (abfd));
5005
5006   htab = elf_aarch64_hash_table (info);
5007   sreloc = NULL;
5008
5009   symtab_hdr = &elf_symtab_hdr (abfd);
5010   sym_hashes = elf_sym_hashes (abfd);
5011
5012   rel_end = relocs + sec->reloc_count;
5013   for (rel = relocs; rel < rel_end; rel++)
5014     {
5015       struct elf_link_hash_entry *h;
5016       unsigned long r_symndx;
5017       unsigned int r_type;
5018       bfd_reloc_code_real_type bfd_r_type;
5019       Elf_Internal_Sym *isym;
5020
5021       r_symndx = ELFNN_R_SYM (rel->r_info);
5022       r_type = ELFNN_R_TYPE (rel->r_info);
5023
5024       if (r_symndx >= NUM_SHDR_ENTRIES (symtab_hdr))
5025         {
5026           (*_bfd_error_handler) (_("%B: bad symbol index: %d"), abfd,
5027                                  r_symndx);
5028           return FALSE;
5029         }
5030
5031       if (r_symndx < symtab_hdr->sh_info)
5032         {
5033           /* A local symbol.  */
5034           isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5035                                         abfd, r_symndx);
5036           if (isym == NULL)
5037             return FALSE;
5038
5039           /* Check relocation against local STT_GNU_IFUNC symbol.  */
5040           if (ELF_ST_TYPE (isym->st_info) == STT_GNU_IFUNC)
5041             {
5042               h = elfNN_aarch64_get_local_sym_hash (htab, abfd, rel,
5043                                                     TRUE);
5044               if (h == NULL)
5045                 return FALSE;
5046
5047               /* Fake a STT_GNU_IFUNC symbol.  */
5048               h->type = STT_GNU_IFUNC;
5049               h->def_regular = 1;
5050               h->ref_regular = 1;
5051               h->forced_local = 1;
5052               h->root.type = bfd_link_hash_defined;
5053             }
5054           else
5055             h = NULL;
5056         }
5057       else
5058         {
5059           h = sym_hashes[r_symndx - symtab_hdr->sh_info];
5060           while (h->root.type == bfd_link_hash_indirect
5061                  || h->root.type == bfd_link_hash_warning)
5062             h = (struct elf_link_hash_entry *) h->root.u.i.link;
5063
5064           /* PR15323, ref flags aren't set for references in the same
5065              object.  */
5066           h->root.non_ir_ref = 1;
5067         }
5068
5069       /* Could be done earlier, if h were already available.  */
5070       bfd_r_type = aarch64_tls_transition (abfd, info, r_type, h, r_symndx);
5071
5072       if (h != NULL)
5073         {
5074           /* Create the ifunc sections for static executables.  If we
5075              never see an indirect function symbol nor we are building
5076              a static executable, those sections will be empty and
5077              won't appear in output.  */
5078           switch (bfd_r_type)
5079             {
5080             default:
5081               break;
5082
5083             case BFD_RELOC_AARCH64_NN:
5084             case BFD_RELOC_AARCH64_CALL26:
5085             case BFD_RELOC_AARCH64_JUMP26:
5086             case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5087             case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5088             case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5089             case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5090             case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5091             case BFD_RELOC_AARCH64_ADD_LO12:
5092               if (htab->root.dynobj == NULL)
5093                 htab->root.dynobj = abfd;
5094               if (!_bfd_elf_create_ifunc_sections (htab->root.dynobj, info))
5095                 return FALSE;
5096               break;
5097             }
5098
5099           /* It is referenced by a non-shared object. */
5100           h->ref_regular = 1;
5101           h->root.non_ir_ref = 1;
5102         }
5103
5104       switch (bfd_r_type)
5105         {
5106         case BFD_RELOC_AARCH64_NN:
5107
5108           /* We don't need to handle relocs into sections not going into
5109              the "real" output.  */
5110           if ((sec->flags & SEC_ALLOC) == 0)
5111             break;
5112
5113           if (h != NULL)
5114             {
5115               if (!info->shared)
5116                 h->non_got_ref = 1;
5117
5118               h->plt.refcount += 1;
5119               h->pointer_equality_needed = 1;
5120             }
5121
5122           /* No need to do anything if we're not creating a shared
5123              object.  */
5124           if (! info->shared)
5125             break;
5126
5127           {
5128             struct elf_dyn_relocs *p;
5129             struct elf_dyn_relocs **head;
5130
5131             /* We must copy these reloc types into the output file.
5132                Create a reloc section in dynobj and make room for
5133                this reloc.  */
5134             if (sreloc == NULL)
5135               {
5136                 if (htab->root.dynobj == NULL)
5137                   htab->root.dynobj = abfd;
5138
5139                 sreloc = _bfd_elf_make_dynamic_reloc_section
5140                   (sec, htab->root.dynobj, LOG_FILE_ALIGN, abfd, /*rela? */ TRUE);
5141
5142                 if (sreloc == NULL)
5143                   return FALSE;
5144               }
5145
5146             /* If this is a global symbol, we count the number of
5147                relocations we need for this symbol.  */
5148             if (h != NULL)
5149               {
5150                 struct elf_aarch64_link_hash_entry *eh;
5151                 eh = (struct elf_aarch64_link_hash_entry *) h;
5152                 head = &eh->dyn_relocs;
5153               }
5154             else
5155               {
5156                 /* Track dynamic relocs needed for local syms too.
5157                    We really need local syms available to do this
5158                    easily.  Oh well.  */
5159
5160                 asection *s;
5161                 void **vpp;
5162
5163                 isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5164                                               abfd, r_symndx);
5165                 if (isym == NULL)
5166                   return FALSE;
5167
5168                 s = bfd_section_from_elf_index (abfd, isym->st_shndx);
5169                 if (s == NULL)
5170                   s = sec;
5171
5172                 /* Beware of type punned pointers vs strict aliasing
5173                    rules.  */
5174                 vpp = &(elf_section_data (s)->local_dynrel);
5175                 head = (struct elf_dyn_relocs **) vpp;
5176               }
5177
5178             p = *head;
5179             if (p == NULL || p->sec != sec)
5180               {
5181                 bfd_size_type amt = sizeof *p;
5182                 p = ((struct elf_dyn_relocs *)
5183                      bfd_zalloc (htab->root.dynobj, amt));
5184                 if (p == NULL)
5185                   return FALSE;
5186                 p->next = *head;
5187                 *head = p;
5188                 p->sec = sec;
5189               }
5190
5191             p->count += 1;
5192
5193           }
5194           break;
5195
5196           /* RR: We probably want to keep a consistency check that
5197              there are no dangling GOT_PAGE relocs.  */
5198         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5199         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5200         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5201         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5202         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
5203         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
5204         case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
5205         case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
5206         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
5207         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
5208         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
5209         case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
5210         case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
5211         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
5212         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
5213         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
5214         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
5215         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
5216         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
5217         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
5218         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
5219           {
5220             unsigned got_type;
5221             unsigned old_got_type;
5222
5223             got_type = aarch64_reloc_got_type (bfd_r_type);
5224
5225             if (h)
5226               {
5227                 h->got.refcount += 1;
5228                 old_got_type = elf_aarch64_hash_entry (h)->got_type;
5229               }
5230             else
5231               {
5232                 struct elf_aarch64_local_symbol *locals;
5233
5234                 if (!elfNN_aarch64_allocate_local_symbols
5235                     (abfd, symtab_hdr->sh_info))
5236                   return FALSE;
5237
5238                 locals = elf_aarch64_locals (abfd);
5239                 BFD_ASSERT (r_symndx < symtab_hdr->sh_info);
5240                 locals[r_symndx].got_refcount += 1;
5241                 old_got_type = locals[r_symndx].got_type;
5242               }
5243
5244             /* If a variable is accessed with both general dynamic TLS
5245                methods, two slots may be created.  */
5246             if (GOT_TLS_GD_ANY_P (old_got_type) && GOT_TLS_GD_ANY_P (got_type))
5247               got_type |= old_got_type;
5248
5249             /* We will already have issued an error message if there
5250                is a TLS/non-TLS mismatch, based on the symbol type.
5251                So just combine any TLS types needed.  */
5252             if (old_got_type != GOT_UNKNOWN && old_got_type != GOT_NORMAL
5253                 && got_type != GOT_NORMAL)
5254               got_type |= old_got_type;
5255
5256             /* If the symbol is accessed by both IE and GD methods, we
5257                are able to relax.  Turn off the GD flag, without
5258                messing up with any other kind of TLS types that may be
5259                involved.  */
5260             if ((got_type & GOT_TLS_IE) && GOT_TLS_GD_ANY_P (got_type))
5261               got_type &= ~ (GOT_TLSDESC_GD | GOT_TLS_GD);
5262
5263             if (old_got_type != got_type)
5264               {
5265                 if (h != NULL)
5266                   elf_aarch64_hash_entry (h)->got_type = got_type;
5267                 else
5268                   {
5269                     struct elf_aarch64_local_symbol *locals;
5270                     locals = elf_aarch64_locals (abfd);
5271                     BFD_ASSERT (r_symndx < symtab_hdr->sh_info);
5272                     locals[r_symndx].got_type = got_type;
5273                   }
5274               }
5275
5276             if (htab->root.dynobj == NULL)
5277               htab->root.dynobj = abfd;
5278             if (! aarch64_elf_create_got_section (htab->root.dynobj, info))
5279               return FALSE;
5280             break;
5281           }
5282
5283         case BFD_RELOC_AARCH64_MOVW_G0_NC:
5284         case BFD_RELOC_AARCH64_MOVW_G1_NC:
5285         case BFD_RELOC_AARCH64_MOVW_G2_NC:
5286         case BFD_RELOC_AARCH64_MOVW_G3:
5287           if (info->shared)
5288             {
5289               int howto_index = bfd_r_type - BFD_RELOC_AARCH64_RELOC_START;
5290               (*_bfd_error_handler)
5291                 (_("%B: relocation %s against `%s' can not be used when making "
5292                    "a shared object; recompile with -fPIC"),
5293                  abfd, elfNN_aarch64_howto_table[howto_index].name,
5294                  (h) ? h->root.root.string : "a local symbol");
5295               bfd_set_error (bfd_error_bad_value);
5296               return FALSE;
5297             }
5298
5299         case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
5300         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5301         case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
5302           if (h != NULL && info->executable)
5303             {
5304               /* If this reloc is in a read-only section, we might
5305                  need a copy reloc.  We can't check reliably at this
5306                  stage whether the section is read-only, as input
5307                  sections have not yet been mapped to output sections.
5308                  Tentatively set the flag for now, and correct in
5309                  adjust_dynamic_symbol.  */
5310               h->non_got_ref = 1;
5311               h->plt.refcount += 1;
5312               h->pointer_equality_needed = 1;
5313             }
5314           /* FIXME:: RR need to handle these in shared libraries
5315              and essentially bomb out as these being non-PIC
5316              relocations in shared libraries.  */
5317           break;
5318
5319         case BFD_RELOC_AARCH64_CALL26:
5320         case BFD_RELOC_AARCH64_JUMP26:
5321           /* If this is a local symbol then we resolve it
5322              directly without creating a PLT entry.  */
5323           if (h == NULL)
5324             continue;
5325
5326           h->needs_plt = 1;
5327           if (h->plt.refcount <= 0)
5328             h->plt.refcount = 1;
5329           else
5330             h->plt.refcount += 1;
5331           break;
5332
5333         default:
5334           break;
5335         }
5336     }
5337
5338   return TRUE;
5339 }
5340
5341 /* Treat mapping symbols as special target symbols.  */
5342
5343 static bfd_boolean
5344 elfNN_aarch64_is_target_special_symbol (bfd *abfd ATTRIBUTE_UNUSED,
5345                                         asymbol *sym)
5346 {
5347   return bfd_is_aarch64_special_symbol_name (sym->name,
5348                                              BFD_AARCH64_SPECIAL_SYM_TYPE_ANY);
5349 }
5350
5351 /* This is a copy of elf_find_function () from elf.c except that
5352    AArch64 mapping symbols are ignored when looking for function names.  */
5353
5354 static bfd_boolean
5355 aarch64_elf_find_function (bfd *abfd ATTRIBUTE_UNUSED,
5356                            asection *section,
5357                            asymbol **symbols,
5358                            bfd_vma offset,
5359                            const char **filename_ptr,
5360                            const char **functionname_ptr)
5361 {
5362   const char *filename = NULL;
5363   asymbol *func = NULL;
5364   bfd_vma low_func = 0;
5365   asymbol **p;
5366
5367   for (p = symbols; *p != NULL; p++)
5368     {
5369       elf_symbol_type *q;
5370
5371       q = (elf_symbol_type *) * p;
5372
5373       switch (ELF_ST_TYPE (q->internal_elf_sym.st_info))
5374         {
5375         default:
5376           break;
5377         case STT_FILE:
5378           filename = bfd_asymbol_name (&q->symbol);
5379           break;
5380         case STT_FUNC:
5381         case STT_NOTYPE:
5382           /* Skip mapping symbols.  */
5383           if ((q->symbol.flags & BSF_LOCAL)
5384               && (bfd_is_aarch64_special_symbol_name
5385                   (q->symbol.name, BFD_AARCH64_SPECIAL_SYM_TYPE_ANY)))
5386             continue;
5387           /* Fall through.  */
5388           if (bfd_get_section (&q->symbol) == section
5389               && q->symbol.value >= low_func && q->symbol.value <= offset)
5390             {
5391               func = (asymbol *) q;
5392               low_func = q->symbol.value;
5393             }
5394           break;
5395         }
5396     }
5397
5398   if (func == NULL)
5399     return FALSE;
5400
5401   if (filename_ptr)
5402     *filename_ptr = filename;
5403   if (functionname_ptr)
5404     *functionname_ptr = bfd_asymbol_name (func);
5405
5406   return TRUE;
5407 }
5408
5409
5410 /* Find the nearest line to a particular section and offset, for error
5411    reporting.   This code is a duplicate of the code in elf.c, except
5412    that it uses aarch64_elf_find_function.  */
5413
5414 static bfd_boolean
5415 elfNN_aarch64_find_nearest_line (bfd *abfd,
5416                                  asection *section,
5417                                  asymbol **symbols,
5418                                  bfd_vma offset,
5419                                  const char **filename_ptr,
5420                                  const char **functionname_ptr,
5421                                  unsigned int *line_ptr)
5422 {
5423   bfd_boolean found = FALSE;
5424
5425   /* We skip _bfd_dwarf1_find_nearest_line since no known AArch64
5426      toolchain uses it.  */
5427
5428   if (_bfd_dwarf2_find_nearest_line (abfd, dwarf_debug_sections,
5429                                      section, symbols, offset,
5430                                      filename_ptr, functionname_ptr,
5431                                      line_ptr, NULL, 0,
5432                                      &elf_tdata (abfd)->dwarf2_find_line_info))
5433     {
5434       if (!*functionname_ptr)
5435         aarch64_elf_find_function (abfd, section, symbols, offset,
5436                                    *filename_ptr ? NULL : filename_ptr,
5437                                    functionname_ptr);
5438
5439       return TRUE;
5440     }
5441
5442   if (!_bfd_stab_section_find_nearest_line (abfd, symbols, section, offset,
5443                                             &found, filename_ptr,
5444                                             functionname_ptr, line_ptr,
5445                                             &elf_tdata (abfd)->line_info))
5446     return FALSE;
5447
5448   if (found && (*functionname_ptr || *line_ptr))
5449     return TRUE;
5450
5451   if (symbols == NULL)
5452     return FALSE;
5453
5454   if (!aarch64_elf_find_function (abfd, section, symbols, offset,
5455                                   filename_ptr, functionname_ptr))
5456     return FALSE;
5457
5458   *line_ptr = 0;
5459   return TRUE;
5460 }
5461
5462 static bfd_boolean
5463 elfNN_aarch64_find_inliner_info (bfd *abfd,
5464                                  const char **filename_ptr,
5465                                  const char **functionname_ptr,
5466                                  unsigned int *line_ptr)
5467 {
5468   bfd_boolean found;
5469   found = _bfd_dwarf2_find_inliner_info
5470     (abfd, filename_ptr,
5471      functionname_ptr, line_ptr, &elf_tdata (abfd)->dwarf2_find_line_info);
5472   return found;
5473 }
5474
5475
5476 static void
5477 elfNN_aarch64_post_process_headers (bfd *abfd,
5478                                     struct bfd_link_info *link_info)
5479 {
5480   Elf_Internal_Ehdr *i_ehdrp;   /* ELF file header, internal form.  */
5481
5482   i_ehdrp = elf_elfheader (abfd);
5483   i_ehdrp->e_ident[EI_ABIVERSION] = AARCH64_ELF_ABI_VERSION;
5484
5485   _bfd_elf_post_process_headers (abfd, link_info);
5486 }
5487
5488 static enum elf_reloc_type_class
5489 elfNN_aarch64_reloc_type_class (const struct bfd_link_info *info ATTRIBUTE_UNUSED,
5490                                 const asection *rel_sec ATTRIBUTE_UNUSED,
5491                                 const Elf_Internal_Rela *rela)
5492 {
5493   switch ((int) ELFNN_R_TYPE (rela->r_info))
5494     {
5495     case AARCH64_R (RELATIVE):
5496       return reloc_class_relative;
5497     case AARCH64_R (JUMP_SLOT):
5498       return reloc_class_plt;
5499     case AARCH64_R (COPY):
5500       return reloc_class_copy;
5501     default:
5502       return reloc_class_normal;
5503     }
5504 }
5505
5506 /* Handle an AArch64 specific section when reading an object file.  This is
5507    called when bfd_section_from_shdr finds a section with an unknown
5508    type.  */
5509
5510 static bfd_boolean
5511 elfNN_aarch64_section_from_shdr (bfd *abfd,
5512                                  Elf_Internal_Shdr *hdr,
5513                                  const char *name, int shindex)
5514 {
5515   /* There ought to be a place to keep ELF backend specific flags, but
5516      at the moment there isn't one.  We just keep track of the
5517      sections by their name, instead.  Fortunately, the ABI gives
5518      names for all the AArch64 specific sections, so we will probably get
5519      away with this.  */
5520   switch (hdr->sh_type)
5521     {
5522     case SHT_AARCH64_ATTRIBUTES:
5523       break;
5524
5525     default:
5526       return FALSE;
5527     }
5528
5529   if (!_bfd_elf_make_section_from_shdr (abfd, hdr, name, shindex))
5530     return FALSE;
5531
5532   return TRUE;
5533 }
5534
5535 /* A structure used to record a list of sections, independently
5536    of the next and prev fields in the asection structure.  */
5537 typedef struct section_list
5538 {
5539   asection *sec;
5540   struct section_list *next;
5541   struct section_list *prev;
5542 }
5543 section_list;
5544
5545 /* Unfortunately we need to keep a list of sections for which
5546    an _aarch64_elf_section_data structure has been allocated.  This
5547    is because it is possible for functions like elfNN_aarch64_write_section
5548    to be called on a section which has had an elf_data_structure
5549    allocated for it (and so the used_by_bfd field is valid) but
5550    for which the AArch64 extended version of this structure - the
5551    _aarch64_elf_section_data structure - has not been allocated.  */
5552 static section_list *sections_with_aarch64_elf_section_data = NULL;
5553
5554 static void
5555 record_section_with_aarch64_elf_section_data (asection *sec)
5556 {
5557   struct section_list *entry;
5558
5559   entry = bfd_malloc (sizeof (*entry));
5560   if (entry == NULL)
5561     return;
5562   entry->sec = sec;
5563   entry->next = sections_with_aarch64_elf_section_data;
5564   entry->prev = NULL;
5565   if (entry->next != NULL)
5566     entry->next->prev = entry;
5567   sections_with_aarch64_elf_section_data = entry;
5568 }
5569
5570 static struct section_list *
5571 find_aarch64_elf_section_entry (asection *sec)
5572 {
5573   struct section_list *entry;
5574   static struct section_list *last_entry = NULL;
5575
5576   /* This is a short cut for the typical case where the sections are added
5577      to the sections_with_aarch64_elf_section_data list in forward order and
5578      then looked up here in backwards order.  This makes a real difference
5579      to the ld-srec/sec64k.exp linker test.  */
5580   entry = sections_with_aarch64_elf_section_data;
5581   if (last_entry != NULL)
5582     {
5583       if (last_entry->sec == sec)
5584         entry = last_entry;
5585       else if (last_entry->next != NULL && last_entry->next->sec == sec)
5586         entry = last_entry->next;
5587     }
5588
5589   for (; entry; entry = entry->next)
5590     if (entry->sec == sec)
5591       break;
5592
5593   if (entry)
5594     /* Record the entry prior to this one - it is the entry we are
5595        most likely to want to locate next time.  Also this way if we
5596        have been called from
5597        unrecord_section_with_aarch64_elf_section_data () we will not
5598        be caching a pointer that is about to be freed.  */
5599     last_entry = entry->prev;
5600
5601   return entry;
5602 }
5603
5604 static void
5605 unrecord_section_with_aarch64_elf_section_data (asection *sec)
5606 {
5607   struct section_list *entry;
5608
5609   entry = find_aarch64_elf_section_entry (sec);
5610
5611   if (entry)
5612     {
5613       if (entry->prev != NULL)
5614         entry->prev->next = entry->next;
5615       if (entry->next != NULL)
5616         entry->next->prev = entry->prev;
5617       if (entry == sections_with_aarch64_elf_section_data)
5618         sections_with_aarch64_elf_section_data = entry->next;
5619       free (entry);
5620     }
5621 }
5622
5623
5624 typedef struct
5625 {
5626   void *finfo;
5627   struct bfd_link_info *info;
5628   asection *sec;
5629   int sec_shndx;
5630   int (*func) (void *, const char *, Elf_Internal_Sym *,
5631                asection *, struct elf_link_hash_entry *);
5632 } output_arch_syminfo;
5633
5634 enum map_symbol_type
5635 {
5636   AARCH64_MAP_INSN,
5637   AARCH64_MAP_DATA
5638 };
5639
5640
5641 /* Output a single mapping symbol.  */
5642
5643 static bfd_boolean
5644 elfNN_aarch64_output_map_sym (output_arch_syminfo *osi,
5645                               enum map_symbol_type type, bfd_vma offset)
5646 {
5647   static const char *names[2] = { "$x", "$d" };
5648   Elf_Internal_Sym sym;
5649
5650   sym.st_value = (osi->sec->output_section->vma
5651                   + osi->sec->output_offset + offset);
5652   sym.st_size = 0;
5653   sym.st_other = 0;
5654   sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_NOTYPE);
5655   sym.st_shndx = osi->sec_shndx;
5656   return osi->func (osi->finfo, names[type], &sym, osi->sec, NULL) == 1;
5657 }
5658
5659
5660
5661 /* Output mapping symbols for PLT entries associated with H.  */
5662
5663 static bfd_boolean
5664 elfNN_aarch64_output_plt_map (struct elf_link_hash_entry *h, void *inf)
5665 {
5666   output_arch_syminfo *osi = (output_arch_syminfo *) inf;
5667   bfd_vma addr;
5668
5669   if (h->root.type == bfd_link_hash_indirect)
5670     return TRUE;
5671
5672   if (h->root.type == bfd_link_hash_warning)
5673     /* When warning symbols are created, they **replace** the "real"
5674        entry in the hash table, thus we never get to see the real
5675        symbol in a hash traversal.  So look at it now.  */
5676     h = (struct elf_link_hash_entry *) h->root.u.i.link;
5677
5678   if (h->plt.offset == (bfd_vma) - 1)
5679     return TRUE;
5680
5681   addr = h->plt.offset;
5682   if (addr == 32)
5683     {
5684       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
5685         return FALSE;
5686     }
5687   return TRUE;
5688 }
5689
5690
5691 /* Output a single local symbol for a generated stub.  */
5692
5693 static bfd_boolean
5694 elfNN_aarch64_output_stub_sym (output_arch_syminfo *osi, const char *name,
5695                                bfd_vma offset, bfd_vma size)
5696 {
5697   Elf_Internal_Sym sym;
5698
5699   sym.st_value = (osi->sec->output_section->vma
5700                   + osi->sec->output_offset + offset);
5701   sym.st_size = size;
5702   sym.st_other = 0;
5703   sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_FUNC);
5704   sym.st_shndx = osi->sec_shndx;
5705   return osi->func (osi->finfo, name, &sym, osi->sec, NULL) == 1;
5706 }
5707
5708 static bfd_boolean
5709 aarch64_map_one_stub (struct bfd_hash_entry *gen_entry, void *in_arg)
5710 {
5711   struct elf_aarch64_stub_hash_entry *stub_entry;
5712   asection *stub_sec;
5713   bfd_vma addr;
5714   char *stub_name;
5715   output_arch_syminfo *osi;
5716
5717   /* Massage our args to the form they really have.  */
5718   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
5719   osi = (output_arch_syminfo *) in_arg;
5720
5721   stub_sec = stub_entry->stub_sec;
5722
5723   /* Ensure this stub is attached to the current section being
5724      processed.  */
5725   if (stub_sec != osi->sec)
5726     return TRUE;
5727
5728   addr = (bfd_vma) stub_entry->stub_offset;
5729
5730   stub_name = stub_entry->output_name;
5731
5732   switch (stub_entry->stub_type)
5733     {
5734     case aarch64_stub_adrp_branch:
5735       if (!elfNN_aarch64_output_stub_sym (osi, stub_name, addr,
5736                                           sizeof (aarch64_adrp_branch_stub)))
5737         return FALSE;
5738       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
5739         return FALSE;
5740       break;
5741     case aarch64_stub_long_branch:
5742       if (!elfNN_aarch64_output_stub_sym
5743           (osi, stub_name, addr, sizeof (aarch64_long_branch_stub)))
5744         return FALSE;
5745       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
5746         return FALSE;
5747       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_DATA, addr + 16))
5748         return FALSE;
5749       break;
5750     default:
5751       BFD_FAIL ();
5752     }
5753
5754   return TRUE;
5755 }
5756
5757 /* Output mapping symbols for linker generated sections.  */
5758
5759 static bfd_boolean
5760 elfNN_aarch64_output_arch_local_syms (bfd *output_bfd,
5761                                       struct bfd_link_info *info,
5762                                       void *finfo,
5763                                       int (*func) (void *, const char *,
5764                                                    Elf_Internal_Sym *,
5765                                                    asection *,
5766                                                    struct elf_link_hash_entry
5767                                                    *))
5768 {
5769   output_arch_syminfo osi;
5770   struct elf_aarch64_link_hash_table *htab;
5771
5772   htab = elf_aarch64_hash_table (info);
5773
5774   osi.finfo = finfo;
5775   osi.info = info;
5776   osi.func = func;
5777
5778   /* Long calls stubs.  */
5779   if (htab->stub_bfd && htab->stub_bfd->sections)
5780     {
5781       asection *stub_sec;
5782
5783       for (stub_sec = htab->stub_bfd->sections;
5784            stub_sec != NULL; stub_sec = stub_sec->next)
5785         {
5786           /* Ignore non-stub sections.  */
5787           if (!strstr (stub_sec->name, STUB_SUFFIX))
5788             continue;
5789
5790           osi.sec = stub_sec;
5791
5792           osi.sec_shndx = _bfd_elf_section_from_bfd_section
5793             (output_bfd, osi.sec->output_section);
5794
5795           bfd_hash_traverse (&htab->stub_hash_table, aarch64_map_one_stub,
5796                              &osi);
5797         }
5798     }
5799
5800   /* Finally, output mapping symbols for the PLT.  */
5801   if (!htab->root.splt || htab->root.splt->size == 0)
5802     return TRUE;
5803
5804   /* For now live without mapping symbols for the plt.  */
5805   osi.sec_shndx = _bfd_elf_section_from_bfd_section
5806     (output_bfd, htab->root.splt->output_section);
5807   osi.sec = htab->root.splt;
5808
5809   elf_link_hash_traverse (&htab->root, elfNN_aarch64_output_plt_map,
5810                           (void *) &osi);
5811
5812   return TRUE;
5813
5814 }
5815
5816 /* Allocate target specific section data.  */
5817
5818 static bfd_boolean
5819 elfNN_aarch64_new_section_hook (bfd *abfd, asection *sec)
5820 {
5821   if (!sec->used_by_bfd)
5822     {
5823       _aarch64_elf_section_data *sdata;
5824       bfd_size_type amt = sizeof (*sdata);
5825
5826       sdata = bfd_zalloc (abfd, amt);
5827       if (sdata == NULL)
5828         return FALSE;
5829       sec->used_by_bfd = sdata;
5830     }
5831
5832   record_section_with_aarch64_elf_section_data (sec);
5833
5834   return _bfd_elf_new_section_hook (abfd, sec);
5835 }
5836
5837
5838 static void
5839 unrecord_section_via_map_over_sections (bfd *abfd ATTRIBUTE_UNUSED,
5840                                         asection *sec,
5841                                         void *ignore ATTRIBUTE_UNUSED)
5842 {
5843   unrecord_section_with_aarch64_elf_section_data (sec);
5844 }
5845
5846 static bfd_boolean
5847 elfNN_aarch64_close_and_cleanup (bfd *abfd)
5848 {
5849   if (abfd->sections)
5850     bfd_map_over_sections (abfd,
5851                            unrecord_section_via_map_over_sections, NULL);
5852
5853   return _bfd_elf_close_and_cleanup (abfd);
5854 }
5855
5856 static bfd_boolean
5857 elfNN_aarch64_bfd_free_cached_info (bfd *abfd)
5858 {
5859   if (abfd->sections)
5860     bfd_map_over_sections (abfd,
5861                            unrecord_section_via_map_over_sections, NULL);
5862
5863   return _bfd_free_cached_info (abfd);
5864 }
5865
5866 /* Create dynamic sections. This is different from the ARM backend in that
5867    the got, plt, gotplt and their relocation sections are all created in the
5868    standard part of the bfd elf backend.  */
5869
5870 static bfd_boolean
5871 elfNN_aarch64_create_dynamic_sections (bfd *dynobj,
5872                                        struct bfd_link_info *info)
5873 {
5874   struct elf_aarch64_link_hash_table *htab;
5875
5876   /* We need to create .got section.  */
5877   if (!aarch64_elf_create_got_section (dynobj, info))
5878     return FALSE;
5879
5880   if (!_bfd_elf_create_dynamic_sections (dynobj, info))
5881     return FALSE;
5882
5883   htab = elf_aarch64_hash_table (info);
5884   htab->sdynbss = bfd_get_linker_section (dynobj, ".dynbss");
5885   if (!info->shared)
5886     htab->srelbss = bfd_get_linker_section (dynobj, ".rela.bss");
5887
5888   if (!htab->sdynbss || (!info->shared && !htab->srelbss))
5889     abort ();
5890
5891   return TRUE;
5892 }
5893
5894
5895 /* Allocate space in .plt, .got and associated reloc sections for
5896    dynamic relocs.  */
5897
5898 static bfd_boolean
5899 elfNN_aarch64_allocate_dynrelocs (struct elf_link_hash_entry *h, void *inf)
5900 {
5901   struct bfd_link_info *info;
5902   struct elf_aarch64_link_hash_table *htab;
5903   struct elf_aarch64_link_hash_entry *eh;
5904   struct elf_dyn_relocs *p;
5905
5906   /* An example of a bfd_link_hash_indirect symbol is versioned
5907      symbol. For example: __gxx_personality_v0(bfd_link_hash_indirect)
5908      -> __gxx_personality_v0(bfd_link_hash_defined)
5909
5910      There is no need to process bfd_link_hash_indirect symbols here
5911      because we will also be presented with the concrete instance of
5912      the symbol and elfNN_aarch64_copy_indirect_symbol () will have been
5913      called to copy all relevant data from the generic to the concrete
5914      symbol instance.
5915    */
5916   if (h->root.type == bfd_link_hash_indirect)
5917     return TRUE;
5918
5919   if (h->root.type == bfd_link_hash_warning)
5920     h = (struct elf_link_hash_entry *) h->root.u.i.link;
5921
5922   info = (struct bfd_link_info *) inf;
5923   htab = elf_aarch64_hash_table (info);
5924
5925   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle it
5926      here if it is defined and referenced in a non-shared object.  */
5927   if (h->type == STT_GNU_IFUNC
5928       && h->def_regular)
5929     return TRUE;
5930   else if (htab->root.dynamic_sections_created && h->plt.refcount > 0)
5931     {
5932       /* Make sure this symbol is output as a dynamic symbol.
5933          Undefined weak syms won't yet be marked as dynamic.  */
5934       if (h->dynindx == -1 && !h->forced_local)
5935         {
5936           if (!bfd_elf_link_record_dynamic_symbol (info, h))
5937             return FALSE;
5938         }
5939
5940       if (info->shared || WILL_CALL_FINISH_DYNAMIC_SYMBOL (1, 0, h))
5941         {
5942           asection *s = htab->root.splt;
5943
5944           /* If this is the first .plt entry, make room for the special
5945              first entry.  */
5946           if (s->size == 0)
5947             s->size += htab->plt_header_size;
5948
5949           h->plt.offset = s->size;
5950
5951           /* If this symbol is not defined in a regular file, and we are
5952              not generating a shared library, then set the symbol to this
5953              location in the .plt.  This is required to make function
5954              pointers compare as equal between the normal executable and
5955              the shared library.  */
5956           if (!info->shared && !h->def_regular)
5957             {
5958               h->root.u.def.section = s;
5959               h->root.u.def.value = h->plt.offset;
5960             }
5961
5962           /* Make room for this entry. For now we only create the
5963              small model PLT entries. We later need to find a way
5964              of relaxing into these from the large model PLT entries.  */
5965           s->size += PLT_SMALL_ENTRY_SIZE;
5966
5967           /* We also need to make an entry in the .got.plt section, which
5968              will be placed in the .got section by the linker script.  */
5969           htab->root.sgotplt->size += GOT_ENTRY_SIZE;
5970
5971           /* We also need to make an entry in the .rela.plt section.  */
5972           htab->root.srelplt->size += RELOC_SIZE (htab);
5973
5974           /* We need to ensure that all GOT entries that serve the PLT
5975              are consecutive with the special GOT slots [0] [1] and
5976              [2]. Any addtional relocations, such as
5977              R_AARCH64_TLSDESC, must be placed after the PLT related
5978              entries.  We abuse the reloc_count such that during
5979              sizing we adjust reloc_count to indicate the number of
5980              PLT related reserved entries.  In subsequent phases when
5981              filling in the contents of the reloc entries, PLT related
5982              entries are placed by computing their PLT index (0
5983              .. reloc_count). While other none PLT relocs are placed
5984              at the slot indicated by reloc_count and reloc_count is
5985              updated.  */
5986
5987           htab->root.srelplt->reloc_count++;
5988         }
5989       else
5990         {
5991           h->plt.offset = (bfd_vma) - 1;
5992           h->needs_plt = 0;
5993         }
5994     }
5995   else
5996     {
5997       h->plt.offset = (bfd_vma) - 1;
5998       h->needs_plt = 0;
5999     }
6000
6001   eh = (struct elf_aarch64_link_hash_entry *) h;
6002   eh->tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
6003
6004   if (h->got.refcount > 0)
6005     {
6006       bfd_boolean dyn;
6007       unsigned got_type = elf_aarch64_hash_entry (h)->got_type;
6008
6009       h->got.offset = (bfd_vma) - 1;
6010
6011       dyn = htab->root.dynamic_sections_created;
6012
6013       /* Make sure this symbol is output as a dynamic symbol.
6014          Undefined weak syms won't yet be marked as dynamic.  */
6015       if (dyn && h->dynindx == -1 && !h->forced_local)
6016         {
6017           if (!bfd_elf_link_record_dynamic_symbol (info, h))
6018             return FALSE;
6019         }
6020
6021       if (got_type == GOT_UNKNOWN)
6022         {
6023         }
6024       else if (got_type == GOT_NORMAL)
6025         {
6026           h->got.offset = htab->root.sgot->size;
6027           htab->root.sgot->size += GOT_ENTRY_SIZE;
6028           if ((ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
6029                || h->root.type != bfd_link_hash_undefweak)
6030               && (info->shared
6031                   || WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, 0, h)))
6032             {
6033               htab->root.srelgot->size += RELOC_SIZE (htab);
6034             }
6035         }
6036       else
6037         {
6038           int indx;
6039           if (got_type & GOT_TLSDESC_GD)
6040             {
6041               eh->tlsdesc_got_jump_table_offset =
6042                 (htab->root.sgotplt->size
6043                  - aarch64_compute_jump_table_size (htab));
6044               htab->root.sgotplt->size += GOT_ENTRY_SIZE * 2;
6045               h->got.offset = (bfd_vma) - 2;
6046             }
6047
6048           if (got_type & GOT_TLS_GD)
6049             {
6050               h->got.offset = htab->root.sgot->size;
6051               htab->root.sgot->size += GOT_ENTRY_SIZE * 2;
6052             }
6053
6054           if (got_type & GOT_TLS_IE)
6055             {
6056               h->got.offset = htab->root.sgot->size;
6057               htab->root.sgot->size += GOT_ENTRY_SIZE;
6058             }
6059
6060           indx = h && h->dynindx != -1 ? h->dynindx : 0;
6061           if ((ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
6062                || h->root.type != bfd_link_hash_undefweak)
6063               && (info->shared
6064                   || indx != 0
6065                   || WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, 0, h)))
6066             {
6067               if (got_type & GOT_TLSDESC_GD)
6068                 {
6069                   htab->root.srelplt->size += RELOC_SIZE (htab);
6070                   /* Note reloc_count not incremented here!  We have
6071                      already adjusted reloc_count for this relocation
6072                      type.  */
6073
6074                   /* TLSDESC PLT is now needed, but not yet determined.  */
6075                   htab->tlsdesc_plt = (bfd_vma) - 1;
6076                 }
6077
6078               if (got_type & GOT_TLS_GD)
6079                 htab->root.srelgot->size += RELOC_SIZE (htab) * 2;
6080
6081               if (got_type & GOT_TLS_IE)
6082                 htab->root.srelgot->size += RELOC_SIZE (htab);
6083             }
6084         }
6085     }
6086   else
6087     {
6088       h->got.offset = (bfd_vma) - 1;
6089     }
6090
6091   if (eh->dyn_relocs == NULL)
6092     return TRUE;
6093
6094   /* In the shared -Bsymbolic case, discard space allocated for
6095      dynamic pc-relative relocs against symbols which turn out to be
6096      defined in regular objects.  For the normal shared case, discard
6097      space for pc-relative relocs that have become local due to symbol
6098      visibility changes.  */
6099
6100   if (info->shared)
6101     {
6102       /* Relocs that use pc_count are those that appear on a call
6103          insn, or certain REL relocs that can generated via assembly.
6104          We want calls to protected symbols to resolve directly to the
6105          function rather than going via the plt.  If people want
6106          function pointer comparisons to work as expected then they
6107          should avoid writing weird assembly.  */
6108       if (SYMBOL_CALLS_LOCAL (info, h))
6109         {
6110           struct elf_dyn_relocs **pp;
6111
6112           for (pp = &eh->dyn_relocs; (p = *pp) != NULL;)
6113             {
6114               p->count -= p->pc_count;
6115               p->pc_count = 0;
6116               if (p->count == 0)
6117                 *pp = p->next;
6118               else
6119                 pp = &p->next;
6120             }
6121         }
6122
6123       /* Also discard relocs on undefined weak syms with non-default
6124          visibility.  */
6125       if (eh->dyn_relocs != NULL && h->root.type == bfd_link_hash_undefweak)
6126         {
6127           if (ELF_ST_VISIBILITY (h->other) != STV_DEFAULT)
6128             eh->dyn_relocs = NULL;
6129
6130           /* Make sure undefined weak symbols are output as a dynamic
6131              symbol in PIEs.  */
6132           else if (h->dynindx == -1
6133                    && !h->forced_local
6134                    && !bfd_elf_link_record_dynamic_symbol (info, h))
6135             return FALSE;
6136         }
6137
6138     }
6139   else if (ELIMINATE_COPY_RELOCS)
6140     {
6141       /* For the non-shared case, discard space for relocs against
6142          symbols which turn out to need copy relocs or are not
6143          dynamic.  */
6144
6145       if (!h->non_got_ref
6146           && ((h->def_dynamic
6147                && !h->def_regular)
6148               || (htab->root.dynamic_sections_created
6149                   && (h->root.type == bfd_link_hash_undefweak
6150                       || h->root.type == bfd_link_hash_undefined))))
6151         {
6152           /* Make sure this symbol is output as a dynamic symbol.
6153              Undefined weak syms won't yet be marked as dynamic.  */
6154           if (h->dynindx == -1
6155               && !h->forced_local
6156               && !bfd_elf_link_record_dynamic_symbol (info, h))
6157             return FALSE;
6158
6159           /* If that succeeded, we know we'll be keeping all the
6160              relocs.  */
6161           if (h->dynindx != -1)
6162             goto keep;
6163         }
6164
6165       eh->dyn_relocs = NULL;
6166
6167     keep:;
6168     }
6169
6170   /* Finally, allocate space.  */
6171   for (p = eh->dyn_relocs; p != NULL; p = p->next)
6172     {
6173       asection *sreloc;
6174
6175       sreloc = elf_section_data (p->sec)->sreloc;
6176
6177       BFD_ASSERT (sreloc != NULL);
6178
6179       sreloc->size += p->count * RELOC_SIZE (htab);
6180     }
6181
6182   return TRUE;
6183 }
6184
6185 /* Allocate space in .plt, .got and associated reloc sections for
6186    ifunc dynamic relocs.  */
6187
6188 static bfd_boolean
6189 elfNN_aarch64_allocate_ifunc_dynrelocs (struct elf_link_hash_entry *h,
6190                                         void *inf)
6191 {
6192   struct bfd_link_info *info;
6193   struct elf_aarch64_link_hash_table *htab;
6194   struct elf_aarch64_link_hash_entry *eh;
6195
6196   /* An example of a bfd_link_hash_indirect symbol is versioned
6197      symbol. For example: __gxx_personality_v0(bfd_link_hash_indirect)
6198      -> __gxx_personality_v0(bfd_link_hash_defined)
6199
6200      There is no need to process bfd_link_hash_indirect symbols here
6201      because we will also be presented with the concrete instance of
6202      the symbol and elfNN_aarch64_copy_indirect_symbol () will have been
6203      called to copy all relevant data from the generic to the concrete
6204      symbol instance.
6205    */
6206   if (h->root.type == bfd_link_hash_indirect)
6207     return TRUE;
6208
6209   if (h->root.type == bfd_link_hash_warning)
6210     h = (struct elf_link_hash_entry *) h->root.u.i.link;
6211
6212   info = (struct bfd_link_info *) inf;
6213   htab = elf_aarch64_hash_table (info);
6214
6215   eh = (struct elf_aarch64_link_hash_entry *) h;
6216
6217   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle it
6218      here if it is defined and referenced in a non-shared object.  */
6219   if (h->type == STT_GNU_IFUNC
6220       && h->def_regular)
6221     return _bfd_elf_allocate_ifunc_dyn_relocs (info, h,
6222                                                &eh->dyn_relocs,
6223                                                htab->plt_entry_size,
6224                                                htab->plt_header_size,
6225                                                GOT_ENTRY_SIZE);
6226   return TRUE;
6227 }
6228
6229 /* Allocate space in .plt, .got and associated reloc sections for
6230    local dynamic relocs.  */
6231
6232 static bfd_boolean
6233 elfNN_aarch64_allocate_local_dynrelocs (void **slot, void *inf)
6234 {
6235   struct elf_link_hash_entry *h
6236     = (struct elf_link_hash_entry *) *slot;
6237
6238   if (h->type != STT_GNU_IFUNC
6239       || !h->def_regular
6240       || !h->ref_regular
6241       || !h->forced_local
6242       || h->root.type != bfd_link_hash_defined)
6243     abort ();
6244
6245   return elfNN_aarch64_allocate_dynrelocs (h, inf);
6246 }
6247
6248 /* Allocate space in .plt, .got and associated reloc sections for
6249    local ifunc dynamic relocs.  */
6250
6251 static bfd_boolean
6252 elfNN_aarch64_allocate_local_ifunc_dynrelocs (void **slot, void *inf)
6253 {
6254   struct elf_link_hash_entry *h
6255     = (struct elf_link_hash_entry *) *slot;
6256
6257   if (h->type != STT_GNU_IFUNC
6258       || !h->def_regular
6259       || !h->ref_regular
6260       || !h->forced_local
6261       || h->root.type != bfd_link_hash_defined)
6262     abort ();
6263
6264   return elfNN_aarch64_allocate_ifunc_dynrelocs (h, inf);
6265 }
6266
6267 /* This is the most important function of all . Innocuosly named
6268    though !  */
6269 static bfd_boolean
6270 elfNN_aarch64_size_dynamic_sections (bfd *output_bfd ATTRIBUTE_UNUSED,
6271                                      struct bfd_link_info *info)
6272 {
6273   struct elf_aarch64_link_hash_table *htab;
6274   bfd *dynobj;
6275   asection *s;
6276   bfd_boolean relocs;
6277   bfd *ibfd;
6278
6279   htab = elf_aarch64_hash_table ((info));
6280   dynobj = htab->root.dynobj;
6281
6282   BFD_ASSERT (dynobj != NULL);
6283
6284   if (htab->root.dynamic_sections_created)
6285     {
6286       if (info->executable)
6287         {
6288           s = bfd_get_linker_section (dynobj, ".interp");
6289           if (s == NULL)
6290             abort ();
6291           s->size = sizeof ELF_DYNAMIC_INTERPRETER;
6292           s->contents = (unsigned char *) ELF_DYNAMIC_INTERPRETER;
6293         }
6294     }
6295
6296   /* Set up .got offsets for local syms, and space for local dynamic
6297      relocs.  */
6298   for (ibfd = info->input_bfds; ibfd != NULL; ibfd = ibfd->link.next)
6299     {
6300       struct elf_aarch64_local_symbol *locals = NULL;
6301       Elf_Internal_Shdr *symtab_hdr;
6302       asection *srel;
6303       unsigned int i;
6304
6305       if (!is_aarch64_elf (ibfd))
6306         continue;
6307
6308       for (s = ibfd->sections; s != NULL; s = s->next)
6309         {
6310           struct elf_dyn_relocs *p;
6311
6312           for (p = (struct elf_dyn_relocs *)
6313                (elf_section_data (s)->local_dynrel); p != NULL; p = p->next)
6314             {
6315               if (!bfd_is_abs_section (p->sec)
6316                   && bfd_is_abs_section (p->sec->output_section))
6317                 {
6318                   /* Input section has been discarded, either because
6319                      it is a copy of a linkonce section or due to
6320                      linker script /DISCARD/, so we'll be discarding
6321                      the relocs too.  */
6322                 }
6323               else if (p->count != 0)
6324                 {
6325                   srel = elf_section_data (p->sec)->sreloc;
6326                   srel->size += p->count * RELOC_SIZE (htab);
6327                   if ((p->sec->output_section->flags & SEC_READONLY) != 0)
6328                     info->flags |= DF_TEXTREL;
6329                 }
6330             }
6331         }
6332
6333       locals = elf_aarch64_locals (ibfd);
6334       if (!locals)
6335         continue;
6336
6337       symtab_hdr = &elf_symtab_hdr (ibfd);
6338       srel = htab->root.srelgot;
6339       for (i = 0; i < symtab_hdr->sh_info; i++)
6340         {
6341           locals[i].got_offset = (bfd_vma) - 1;
6342           locals[i].tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
6343           if (locals[i].got_refcount > 0)
6344             {
6345               unsigned got_type = locals[i].got_type;
6346               if (got_type & GOT_TLSDESC_GD)
6347                 {
6348                   locals[i].tlsdesc_got_jump_table_offset =
6349                     (htab->root.sgotplt->size
6350                      - aarch64_compute_jump_table_size (htab));
6351                   htab->root.sgotplt->size += GOT_ENTRY_SIZE * 2;
6352                   locals[i].got_offset = (bfd_vma) - 2;
6353                 }
6354
6355               if (got_type & GOT_TLS_GD)
6356                 {
6357                   locals[i].got_offset = htab->root.sgot->size;
6358                   htab->root.sgot->size += GOT_ENTRY_SIZE * 2;
6359                 }
6360
6361               if (got_type & GOT_TLS_IE)
6362                 {
6363                   locals[i].got_offset = htab->root.sgot->size;
6364                   htab->root.sgot->size += GOT_ENTRY_SIZE;
6365                 }
6366
6367               if (got_type == GOT_UNKNOWN)
6368                 {
6369                 }
6370
6371               if (got_type == GOT_NORMAL)
6372                 {
6373                 }
6374
6375               if (info->shared)
6376                 {
6377                   if (got_type & GOT_TLSDESC_GD)
6378                     {
6379                       htab->root.srelplt->size += RELOC_SIZE (htab);
6380                       /* Note RELOC_COUNT not incremented here! */
6381                       htab->tlsdesc_plt = (bfd_vma) - 1;
6382                     }
6383
6384                   if (got_type & GOT_TLS_GD)
6385                     htab->root.srelgot->size += RELOC_SIZE (htab) * 2;
6386
6387                   if (got_type & GOT_TLS_IE)
6388                     htab->root.srelgot->size += RELOC_SIZE (htab);
6389                 }
6390             }
6391           else
6392             {
6393               locals[i].got_refcount = (bfd_vma) - 1;
6394             }
6395         }
6396     }
6397
6398
6399   /* Allocate global sym .plt and .got entries, and space for global
6400      sym dynamic relocs.  */
6401   elf_link_hash_traverse (&htab->root, elfNN_aarch64_allocate_dynrelocs,
6402                           info);
6403
6404   /* Allocate global ifunc sym .plt and .got entries, and space for global
6405      ifunc sym dynamic relocs.  */
6406   elf_link_hash_traverse (&htab->root, elfNN_aarch64_allocate_ifunc_dynrelocs,
6407                           info);
6408
6409   /* Allocate .plt and .got entries, and space for local symbols.  */
6410   htab_traverse (htab->loc_hash_table,
6411                  elfNN_aarch64_allocate_local_dynrelocs,
6412                  info);
6413
6414   /* Allocate .plt and .got entries, and space for local ifunc symbols.  */
6415   htab_traverse (htab->loc_hash_table,
6416                  elfNN_aarch64_allocate_local_ifunc_dynrelocs,
6417                  info);
6418
6419   /* For every jump slot reserved in the sgotplt, reloc_count is
6420      incremented.  However, when we reserve space for TLS descriptors,
6421      it's not incremented, so in order to compute the space reserved
6422      for them, it suffices to multiply the reloc count by the jump
6423      slot size.  */
6424
6425   if (htab->root.srelplt)
6426     htab->sgotplt_jump_table_size = aarch64_compute_jump_table_size (htab);
6427
6428   if (htab->tlsdesc_plt)
6429     {
6430       if (htab->root.splt->size == 0)
6431         htab->root.splt->size += PLT_ENTRY_SIZE;
6432
6433       htab->tlsdesc_plt = htab->root.splt->size;
6434       htab->root.splt->size += PLT_TLSDESC_ENTRY_SIZE;
6435
6436       /* If we're not using lazy TLS relocations, don't generate the
6437          GOT entry required.  */
6438       if (!(info->flags & DF_BIND_NOW))
6439         {
6440           htab->dt_tlsdesc_got = htab->root.sgot->size;
6441           htab->root.sgot->size += GOT_ENTRY_SIZE;
6442         }
6443     }
6444
6445   /* We now have determined the sizes of the various dynamic sections.
6446      Allocate memory for them.  */
6447   relocs = FALSE;
6448   for (s = dynobj->sections; s != NULL; s = s->next)
6449     {
6450       if ((s->flags & SEC_LINKER_CREATED) == 0)
6451         continue;
6452
6453       if (s == htab->root.splt
6454           || s == htab->root.sgot
6455           || s == htab->root.sgotplt
6456           || s == htab->root.iplt
6457           || s == htab->root.igotplt || s == htab->sdynbss)
6458         {
6459           /* Strip this section if we don't need it; see the
6460              comment below.  */
6461         }
6462       else if (CONST_STRNEQ (bfd_get_section_name (dynobj, s), ".rela"))
6463         {
6464           if (s->size != 0 && s != htab->root.srelplt)
6465             relocs = TRUE;
6466
6467           /* We use the reloc_count field as a counter if we need
6468              to copy relocs into the output file.  */
6469           if (s != htab->root.srelplt)
6470             s->reloc_count = 0;
6471         }
6472       else
6473         {
6474           /* It's not one of our sections, so don't allocate space.  */
6475           continue;
6476         }
6477
6478       if (s->size == 0)
6479         {
6480           /* If we don't need this section, strip it from the
6481              output file.  This is mostly to handle .rela.bss and
6482              .rela.plt.  We must create both sections in
6483              create_dynamic_sections, because they must be created
6484              before the linker maps input sections to output
6485              sections.  The linker does that before
6486              adjust_dynamic_symbol is called, and it is that
6487              function which decides whether anything needs to go
6488              into these sections.  */
6489
6490           s->flags |= SEC_EXCLUDE;
6491           continue;
6492         }
6493
6494       if ((s->flags & SEC_HAS_CONTENTS) == 0)
6495         continue;
6496
6497       /* Allocate memory for the section contents.  We use bfd_zalloc
6498          here in case unused entries are not reclaimed before the
6499          section's contents are written out.  This should not happen,
6500          but this way if it does, we get a R_AARCH64_NONE reloc instead
6501          of garbage.  */
6502       s->contents = (bfd_byte *) bfd_zalloc (dynobj, s->size);
6503       if (s->contents == NULL)
6504         return FALSE;
6505     }
6506
6507   if (htab->root.dynamic_sections_created)
6508     {
6509       /* Add some entries to the .dynamic section.  We fill in the
6510          values later, in elfNN_aarch64_finish_dynamic_sections, but we
6511          must add the entries now so that we get the correct size for
6512          the .dynamic section.  The DT_DEBUG entry is filled in by the
6513          dynamic linker and used by the debugger.  */
6514 #define add_dynamic_entry(TAG, VAL)                     \
6515       _bfd_elf_add_dynamic_entry (info, TAG, VAL)
6516
6517       if (info->executable)
6518         {
6519           if (!add_dynamic_entry (DT_DEBUG, 0))
6520             return FALSE;
6521         }
6522
6523       if (htab->root.splt->size != 0)
6524         {
6525           if (!add_dynamic_entry (DT_PLTGOT, 0)
6526               || !add_dynamic_entry (DT_PLTRELSZ, 0)
6527               || !add_dynamic_entry (DT_PLTREL, DT_RELA)
6528               || !add_dynamic_entry (DT_JMPREL, 0))
6529             return FALSE;
6530
6531           if (htab->tlsdesc_plt
6532               && (!add_dynamic_entry (DT_TLSDESC_PLT, 0)
6533                   || !add_dynamic_entry (DT_TLSDESC_GOT, 0)))
6534             return FALSE;
6535         }
6536
6537       if (relocs)
6538         {
6539           if (!add_dynamic_entry (DT_RELA, 0)
6540               || !add_dynamic_entry (DT_RELASZ, 0)
6541               || !add_dynamic_entry (DT_RELAENT, RELOC_SIZE (htab)))
6542             return FALSE;
6543
6544           /* If any dynamic relocs apply to a read-only section,
6545              then we need a DT_TEXTREL entry.  */
6546           if ((info->flags & DF_TEXTREL) != 0)
6547             {
6548               if (!add_dynamic_entry (DT_TEXTREL, 0))
6549                 return FALSE;
6550             }
6551         }
6552     }
6553 #undef add_dynamic_entry
6554
6555   return TRUE;
6556 }
6557
6558 static inline void
6559 elf_aarch64_update_plt_entry (bfd *output_bfd,
6560                               bfd_reloc_code_real_type r_type,
6561                               bfd_byte *plt_entry, bfd_vma value)
6562 {
6563   reloc_howto_type *howto = elfNN_aarch64_howto_from_bfd_reloc (r_type);
6564
6565   _bfd_aarch64_elf_put_addend (output_bfd, plt_entry, r_type, howto, value);
6566 }
6567
6568 static void
6569 elfNN_aarch64_create_small_pltn_entry (struct elf_link_hash_entry *h,
6570                                        struct elf_aarch64_link_hash_table
6571                                        *htab, bfd *output_bfd,
6572                                        struct bfd_link_info *info)
6573 {
6574   bfd_byte *plt_entry;
6575   bfd_vma plt_index;
6576   bfd_vma got_offset;
6577   bfd_vma gotplt_entry_address;
6578   bfd_vma plt_entry_address;
6579   Elf_Internal_Rela rela;
6580   bfd_byte *loc;
6581   asection *plt, *gotplt, *relplt;
6582
6583   /* When building a static executable, use .iplt, .igot.plt and
6584      .rela.iplt sections for STT_GNU_IFUNC symbols.  */
6585   if (htab->root.splt != NULL)
6586     {
6587       plt = htab->root.splt;
6588       gotplt = htab->root.sgotplt;
6589       relplt = htab->root.srelplt;
6590     }
6591   else
6592     {
6593       plt = htab->root.iplt;
6594       gotplt = htab->root.igotplt;
6595       relplt = htab->root.irelplt;
6596     }
6597
6598   /* Get the index in the procedure linkage table which
6599      corresponds to this symbol.  This is the index of this symbol
6600      in all the symbols for which we are making plt entries.  The
6601      first entry in the procedure linkage table is reserved.
6602
6603      Get the offset into the .got table of the entry that
6604      corresponds to this function.      Each .got entry is GOT_ENTRY_SIZE
6605      bytes. The first three are reserved for the dynamic linker.
6606
6607      For static executables, we don't reserve anything.  */
6608
6609   if (plt == htab->root.splt)
6610     {
6611       plt_index = (h->plt.offset - htab->plt_header_size) / htab->plt_entry_size;
6612       got_offset = (plt_index + 3) * GOT_ENTRY_SIZE;
6613     }
6614   else
6615     {
6616       plt_index = h->plt.offset / htab->plt_entry_size;
6617       got_offset = plt_index * GOT_ENTRY_SIZE;
6618     }
6619
6620   plt_entry = plt->contents + h->plt.offset;
6621   plt_entry_address = plt->output_section->vma
6622     + plt->output_offset + h->plt.offset;
6623   gotplt_entry_address = gotplt->output_section->vma +
6624     gotplt->output_offset + got_offset;
6625
6626   /* Copy in the boiler-plate for the PLTn entry.  */
6627   memcpy (plt_entry, elfNN_aarch64_small_plt_entry, PLT_SMALL_ENTRY_SIZE);
6628
6629   /* Fill in the top 21 bits for this: ADRP x16, PLT_GOT + n * 8.
6630      ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
6631   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADR_HI21_PCREL,
6632                                 plt_entry,
6633                                 PG (gotplt_entry_address) -
6634                                 PG (plt_entry_address));
6635
6636   /* Fill in the lo12 bits for the load from the pltgot.  */
6637   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_LDSTNN_LO12,
6638                                 plt_entry + 4,
6639                                 PG_OFFSET (gotplt_entry_address));
6640
6641   /* Fill in the lo12 bits for the add from the pltgot entry.  */
6642   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADD_LO12,
6643                                 plt_entry + 8,
6644                                 PG_OFFSET (gotplt_entry_address));
6645
6646   /* All the GOTPLT Entries are essentially initialized to PLT0.  */
6647   bfd_put_NN (output_bfd,
6648               plt->output_section->vma + plt->output_offset,
6649               gotplt->contents + got_offset);
6650
6651   rela.r_offset = gotplt_entry_address;
6652
6653   if (h->dynindx == -1
6654       || ((info->executable
6655            || ELF_ST_VISIBILITY (h->other) != STV_DEFAULT)
6656           && h->def_regular
6657           && h->type == STT_GNU_IFUNC))
6658     {
6659       /* If an STT_GNU_IFUNC symbol is locally defined, generate
6660          R_AARCH64_IRELATIVE instead of R_AARCH64_JUMP_SLOT.  */
6661       rela.r_info = ELFNN_R_INFO (0, AARCH64_R (IRELATIVE));
6662       rela.r_addend = (h->root.u.def.value
6663                        + h->root.u.def.section->output_section->vma
6664                        + h->root.u.def.section->output_offset);
6665     }
6666   else
6667     {
6668       /* Fill in the entry in the .rela.plt section.  */
6669       rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (JUMP_SLOT));
6670       rela.r_addend = 0;
6671     }
6672
6673   /* Compute the relocation entry to used based on PLT index and do
6674      not adjust reloc_count. The reloc_count has already been adjusted
6675      to account for this entry.  */
6676   loc = relplt->contents + plt_index * RELOC_SIZE (htab);
6677   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
6678 }
6679
6680 /* Size sections even though they're not dynamic.  We use it to setup
6681    _TLS_MODULE_BASE_, if needed.  */
6682
6683 static bfd_boolean
6684 elfNN_aarch64_always_size_sections (bfd *output_bfd,
6685                                     struct bfd_link_info *info)
6686 {
6687   asection *tls_sec;
6688
6689   if (info->relocatable)
6690     return TRUE;
6691
6692   tls_sec = elf_hash_table (info)->tls_sec;
6693
6694   if (tls_sec)
6695     {
6696       struct elf_link_hash_entry *tlsbase;
6697
6698       tlsbase = elf_link_hash_lookup (elf_hash_table (info),
6699                                       "_TLS_MODULE_BASE_", TRUE, TRUE, FALSE);
6700
6701       if (tlsbase)
6702         {
6703           struct bfd_link_hash_entry *h = NULL;
6704           const struct elf_backend_data *bed =
6705             get_elf_backend_data (output_bfd);
6706
6707           if (!(_bfd_generic_link_add_one_symbol
6708                 (info, output_bfd, "_TLS_MODULE_BASE_", BSF_LOCAL,
6709                  tls_sec, 0, NULL, FALSE, bed->collect, &h)))
6710             return FALSE;
6711
6712           tlsbase->type = STT_TLS;
6713           tlsbase = (struct elf_link_hash_entry *) h;
6714           tlsbase->def_regular = 1;
6715           tlsbase->other = STV_HIDDEN;
6716           (*bed->elf_backend_hide_symbol) (info, tlsbase, TRUE);
6717         }
6718     }
6719
6720   return TRUE;
6721 }
6722
6723 /* Finish up dynamic symbol handling.  We set the contents of various
6724    dynamic sections here.  */
6725 static bfd_boolean
6726 elfNN_aarch64_finish_dynamic_symbol (bfd *output_bfd,
6727                                      struct bfd_link_info *info,
6728                                      struct elf_link_hash_entry *h,
6729                                      Elf_Internal_Sym *sym)
6730 {
6731   struct elf_aarch64_link_hash_table *htab;
6732   htab = elf_aarch64_hash_table (info);
6733
6734   if (h->plt.offset != (bfd_vma) - 1)
6735     {
6736       asection *plt, *gotplt, *relplt;
6737
6738       /* This symbol has an entry in the procedure linkage table.  Set
6739          it up.  */
6740
6741       /* When building a static executable, use .iplt, .igot.plt and
6742          .rela.iplt sections for STT_GNU_IFUNC symbols.  */
6743       if (htab->root.splt != NULL)
6744         {
6745           plt = htab->root.splt;
6746           gotplt = htab->root.sgotplt;
6747           relplt = htab->root.srelplt;
6748         }
6749       else
6750         {
6751           plt = htab->root.iplt;
6752           gotplt = htab->root.igotplt;
6753           relplt = htab->root.irelplt;
6754         }
6755
6756       /* This symbol has an entry in the procedure linkage table.  Set
6757          it up.  */
6758       if ((h->dynindx == -1
6759            && !((h->forced_local || info->executable)
6760                 && h->def_regular
6761                 && h->type == STT_GNU_IFUNC))
6762           || plt == NULL
6763           || gotplt == NULL
6764           || relplt == NULL)
6765         abort ();
6766
6767       elfNN_aarch64_create_small_pltn_entry (h, htab, output_bfd, info);
6768       if (!h->def_regular)
6769         {
6770           /* Mark the symbol as undefined, rather than as defined in
6771              the .plt section.  Leave the value alone.  This is a clue
6772              for the dynamic linker, to make function pointer
6773              comparisons work between an application and shared
6774              library.  */
6775           sym->st_shndx = SHN_UNDEF;
6776         }
6777     }
6778
6779   if (h->got.offset != (bfd_vma) - 1
6780       && elf_aarch64_hash_entry (h)->got_type == GOT_NORMAL)
6781     {
6782       Elf_Internal_Rela rela;
6783       bfd_byte *loc;
6784
6785       /* This symbol has an entry in the global offset table.  Set it
6786          up.  */
6787       if (htab->root.sgot == NULL || htab->root.srelgot == NULL)
6788         abort ();
6789
6790       rela.r_offset = (htab->root.sgot->output_section->vma
6791                        + htab->root.sgot->output_offset
6792                        + (h->got.offset & ~(bfd_vma) 1));
6793
6794       if (h->def_regular
6795           && h->type == STT_GNU_IFUNC)
6796         {
6797           if (info->shared)
6798             {
6799               /* Generate R_AARCH64_GLOB_DAT.  */
6800               goto do_glob_dat;
6801             }
6802           else
6803             {
6804               asection *plt;
6805
6806               if (!h->pointer_equality_needed)
6807                 abort ();
6808
6809               /* For non-shared object, we can't use .got.plt, which
6810                  contains the real function address if we need pointer
6811                  equality.  We load the GOT entry with the PLT entry.  */
6812               plt = htab->root.splt ? htab->root.splt : htab->root.iplt;
6813               bfd_put_NN (output_bfd, (plt->output_section->vma
6814                                        + plt->output_offset
6815                                        + h->plt.offset),
6816                           htab->root.sgot->contents
6817                           + (h->got.offset & ~(bfd_vma) 1));
6818               return TRUE;
6819             }
6820         }
6821       else if (info->shared && SYMBOL_REFERENCES_LOCAL (info, h))
6822         {
6823           if (!h->def_regular)
6824             return FALSE;
6825
6826           BFD_ASSERT ((h->got.offset & 1) != 0);
6827           rela.r_info = ELFNN_R_INFO (0, AARCH64_R (RELATIVE));
6828           rela.r_addend = (h->root.u.def.value
6829                            + h->root.u.def.section->output_section->vma
6830                            + h->root.u.def.section->output_offset);
6831         }
6832       else
6833         {
6834 do_glob_dat:
6835           BFD_ASSERT ((h->got.offset & 1) == 0);
6836           bfd_put_NN (output_bfd, (bfd_vma) 0,
6837                       htab->root.sgot->contents + h->got.offset);
6838           rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (GLOB_DAT));
6839           rela.r_addend = 0;
6840         }
6841
6842       loc = htab->root.srelgot->contents;
6843       loc += htab->root.srelgot->reloc_count++ * RELOC_SIZE (htab);
6844       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
6845     }
6846
6847   if (h->needs_copy)
6848     {
6849       Elf_Internal_Rela rela;
6850       bfd_byte *loc;
6851
6852       /* This symbol needs a copy reloc.  Set it up.  */
6853
6854       if (h->dynindx == -1
6855           || (h->root.type != bfd_link_hash_defined
6856               && h->root.type != bfd_link_hash_defweak)
6857           || htab->srelbss == NULL)
6858         abort ();
6859
6860       rela.r_offset = (h->root.u.def.value
6861                        + h->root.u.def.section->output_section->vma
6862                        + h->root.u.def.section->output_offset);
6863       rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (COPY));
6864       rela.r_addend = 0;
6865       loc = htab->srelbss->contents;
6866       loc += htab->srelbss->reloc_count++ * RELOC_SIZE (htab);
6867       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
6868     }
6869
6870   /* Mark _DYNAMIC and _GLOBAL_OFFSET_TABLE_ as absolute.  SYM may
6871      be NULL for local symbols.  */
6872   if (sym != NULL
6873       && (h == elf_hash_table (info)->hdynamic
6874           || h == elf_hash_table (info)->hgot))
6875     sym->st_shndx = SHN_ABS;
6876
6877   return TRUE;
6878 }
6879
6880 /* Finish up local dynamic symbol handling.  We set the contents of
6881    various dynamic sections here.  */
6882
6883 static bfd_boolean
6884 elfNN_aarch64_finish_local_dynamic_symbol (void **slot, void *inf)
6885 {
6886   struct elf_link_hash_entry *h
6887     = (struct elf_link_hash_entry *) *slot;
6888   struct bfd_link_info *info
6889     = (struct bfd_link_info *) inf;
6890
6891   return elfNN_aarch64_finish_dynamic_symbol (info->output_bfd,
6892                                               info, h, NULL);
6893 }
6894
6895 static void
6896 elfNN_aarch64_init_small_plt0_entry (bfd *output_bfd ATTRIBUTE_UNUSED,
6897                                      struct elf_aarch64_link_hash_table
6898                                      *htab)
6899 {
6900   /* Fill in PLT0. Fixme:RR Note this doesn't distinguish between
6901      small and large plts and at the minute just generates
6902      the small PLT.  */
6903
6904   /* PLT0 of the small PLT looks like this in ELF64 -
6905      stp x16, x30, [sp, #-16]!          // Save the reloc and lr on stack.
6906      adrp x16, PLT_GOT + 16             // Get the page base of the GOTPLT
6907      ldr  x17, [x16, #:lo12:PLT_GOT+16] // Load the address of the
6908                                         // symbol resolver
6909      add  x16, x16, #:lo12:PLT_GOT+16   // Load the lo12 bits of the
6910                                         // GOTPLT entry for this.
6911      br   x17
6912      PLT0 will be slightly different in ELF32 due to different got entry
6913      size.
6914    */
6915   bfd_vma plt_got_2nd_ent;      /* Address of GOT[2].  */
6916   bfd_vma plt_base;
6917
6918
6919   memcpy (htab->root.splt->contents, elfNN_aarch64_small_plt0_entry,
6920           PLT_ENTRY_SIZE);
6921   elf_section_data (htab->root.splt->output_section)->this_hdr.sh_entsize =
6922     PLT_ENTRY_SIZE;
6923
6924   plt_got_2nd_ent = (htab->root.sgotplt->output_section->vma
6925                   + htab->root.sgotplt->output_offset
6926                   + GOT_ENTRY_SIZE * 2);
6927
6928   plt_base = htab->root.splt->output_section->vma +
6929     htab->root.splt->output_offset;
6930
6931   /* Fill in the top 21 bits for this: ADRP x16, PLT_GOT + n * 8.
6932      ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
6933   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADR_HI21_PCREL,
6934                                 htab->root.splt->contents + 4,
6935                                 PG (plt_got_2nd_ent) - PG (plt_base + 4));
6936
6937   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_LDSTNN_LO12,
6938                                 htab->root.splt->contents + 8,
6939                                 PG_OFFSET (plt_got_2nd_ent));
6940
6941   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADD_LO12,
6942                                 htab->root.splt->contents + 12,
6943                                 PG_OFFSET (plt_got_2nd_ent));
6944 }
6945
6946 static bfd_boolean
6947 elfNN_aarch64_finish_dynamic_sections (bfd *output_bfd,
6948                                        struct bfd_link_info *info)
6949 {
6950   struct elf_aarch64_link_hash_table *htab;
6951   bfd *dynobj;
6952   asection *sdyn;
6953
6954   htab = elf_aarch64_hash_table (info);
6955   dynobj = htab->root.dynobj;
6956   sdyn = bfd_get_linker_section (dynobj, ".dynamic");
6957
6958   if (htab->root.dynamic_sections_created)
6959     {
6960       ElfNN_External_Dyn *dyncon, *dynconend;
6961
6962       if (sdyn == NULL || htab->root.sgot == NULL)
6963         abort ();
6964
6965       dyncon = (ElfNN_External_Dyn *) sdyn->contents;
6966       dynconend = (ElfNN_External_Dyn *) (sdyn->contents + sdyn->size);
6967       for (; dyncon < dynconend; dyncon++)
6968         {
6969           Elf_Internal_Dyn dyn;
6970           asection *s;
6971
6972           bfd_elfNN_swap_dyn_in (dynobj, dyncon, &dyn);
6973
6974           switch (dyn.d_tag)
6975             {
6976             default:
6977               continue;
6978
6979             case DT_PLTGOT:
6980               s = htab->root.sgotplt;
6981               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset;
6982               break;
6983
6984             case DT_JMPREL:
6985               dyn.d_un.d_ptr = htab->root.srelplt->output_section->vma;
6986               break;
6987
6988             case DT_PLTRELSZ:
6989               s = htab->root.srelplt;
6990               dyn.d_un.d_val = s->size;
6991               break;
6992
6993             case DT_RELASZ:
6994               /* The procedure linkage table relocs (DT_JMPREL) should
6995                  not be included in the overall relocs (DT_RELA).
6996                  Therefore, we override the DT_RELASZ entry here to
6997                  make it not include the JMPREL relocs.  Since the
6998                  linker script arranges for .rela.plt to follow all
6999                  other relocation sections, we don't have to worry
7000                  about changing the DT_RELA entry.  */
7001               if (htab->root.srelplt != NULL)
7002                 {
7003                   s = htab->root.srelplt;
7004                   dyn.d_un.d_val -= s->size;
7005                 }
7006               break;
7007
7008             case DT_TLSDESC_PLT:
7009               s = htab->root.splt;
7010               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset
7011                 + htab->tlsdesc_plt;
7012               break;
7013
7014             case DT_TLSDESC_GOT:
7015               s = htab->root.sgot;
7016               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset
7017                 + htab->dt_tlsdesc_got;
7018               break;
7019             }
7020
7021           bfd_elfNN_swap_dyn_out (output_bfd, &dyn, dyncon);
7022         }
7023
7024     }
7025
7026   /* Fill in the special first entry in the procedure linkage table.  */
7027   if (htab->root.splt && htab->root.splt->size > 0)
7028     {
7029       elfNN_aarch64_init_small_plt0_entry (output_bfd, htab);
7030
7031       elf_section_data (htab->root.splt->output_section)->
7032         this_hdr.sh_entsize = htab->plt_entry_size;
7033
7034
7035       if (htab->tlsdesc_plt)
7036         {
7037           bfd_put_NN (output_bfd, (bfd_vma) 0,
7038                       htab->root.sgot->contents + htab->dt_tlsdesc_got);
7039
7040           memcpy (htab->root.splt->contents + htab->tlsdesc_plt,
7041                   elfNN_aarch64_tlsdesc_small_plt_entry,
7042                   sizeof (elfNN_aarch64_tlsdesc_small_plt_entry));
7043
7044           {
7045             bfd_vma adrp1_addr =
7046               htab->root.splt->output_section->vma
7047               + htab->root.splt->output_offset + htab->tlsdesc_plt + 4;
7048
7049             bfd_vma adrp2_addr = adrp1_addr + 4;
7050
7051             bfd_vma got_addr =
7052               htab->root.sgot->output_section->vma
7053               + htab->root.sgot->output_offset;
7054
7055             bfd_vma pltgot_addr =
7056               htab->root.sgotplt->output_section->vma
7057               + htab->root.sgotplt->output_offset;
7058
7059             bfd_vma dt_tlsdesc_got = got_addr + htab->dt_tlsdesc_got;
7060
7061             bfd_byte *plt_entry =
7062               htab->root.splt->contents + htab->tlsdesc_plt;
7063
7064             /* adrp x2, DT_TLSDESC_GOT */
7065             elf_aarch64_update_plt_entry (output_bfd,
7066                                           BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7067                                           plt_entry + 4,
7068                                           (PG (dt_tlsdesc_got)
7069                                            - PG (adrp1_addr)));
7070
7071             /* adrp x3, 0 */
7072             elf_aarch64_update_plt_entry (output_bfd,
7073                                           BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7074                                           plt_entry + 8,
7075                                           (PG (pltgot_addr)
7076                                            - PG (adrp2_addr)));
7077
7078             /* ldr x2, [x2, #0] */
7079             elf_aarch64_update_plt_entry (output_bfd,
7080                                           BFD_RELOC_AARCH64_LDSTNN_LO12,
7081                                           plt_entry + 12,
7082                                           PG_OFFSET (dt_tlsdesc_got));
7083
7084             /* add x3, x3, 0 */
7085             elf_aarch64_update_plt_entry (output_bfd,
7086                                           BFD_RELOC_AARCH64_ADD_LO12,
7087                                           plt_entry + 16,
7088                                           PG_OFFSET (pltgot_addr));
7089           }
7090         }
7091     }
7092
7093   if (htab->root.sgotplt)
7094     {
7095       if (bfd_is_abs_section (htab->root.sgotplt->output_section))
7096         {
7097           (*_bfd_error_handler)
7098             (_("discarded output section: `%A'"), htab->root.sgotplt);
7099           return FALSE;
7100         }
7101
7102       /* Fill in the first three entries in the global offset table.  */
7103       if (htab->root.sgotplt->size > 0)
7104         {
7105           bfd_put_NN (output_bfd, (bfd_vma) 0, htab->root.sgotplt->contents);
7106
7107           /* Write GOT[1] and GOT[2], needed for the dynamic linker.  */
7108           bfd_put_NN (output_bfd,
7109                       (bfd_vma) 0,
7110                       htab->root.sgotplt->contents + GOT_ENTRY_SIZE);
7111           bfd_put_NN (output_bfd,
7112                       (bfd_vma) 0,
7113                       htab->root.sgotplt->contents + GOT_ENTRY_SIZE * 2);
7114         }
7115
7116       if (htab->root.sgot)
7117         {
7118           if (htab->root.sgot->size > 0)
7119             {
7120               bfd_vma addr =
7121                 sdyn ? sdyn->output_section->vma + sdyn->output_offset : 0;
7122               bfd_put_NN (output_bfd, addr, htab->root.sgot->contents);
7123             }
7124         }
7125
7126       elf_section_data (htab->root.sgotplt->output_section)->
7127         this_hdr.sh_entsize = GOT_ENTRY_SIZE;
7128     }
7129
7130   if (htab->root.sgot && htab->root.sgot->size > 0)
7131     elf_section_data (htab->root.sgot->output_section)->this_hdr.sh_entsize
7132       = GOT_ENTRY_SIZE;
7133
7134   /* Fill PLT and GOT entries for local STT_GNU_IFUNC symbols.  */
7135   htab_traverse (htab->loc_hash_table,
7136                  elfNN_aarch64_finish_local_dynamic_symbol,
7137                  info);
7138
7139   return TRUE;
7140 }
7141
7142 /* Return address for Ith PLT stub in section PLT, for relocation REL
7143    or (bfd_vma) -1 if it should not be included.  */
7144
7145 static bfd_vma
7146 elfNN_aarch64_plt_sym_val (bfd_vma i, const asection *plt,
7147                            const arelent *rel ATTRIBUTE_UNUSED)
7148 {
7149   return plt->vma + PLT_ENTRY_SIZE + i * PLT_SMALL_ENTRY_SIZE;
7150 }
7151
7152
7153 /* We use this so we can override certain functions
7154    (though currently we don't).  */
7155
7156 const struct elf_size_info elfNN_aarch64_size_info =
7157 {
7158   sizeof (ElfNN_External_Ehdr),
7159   sizeof (ElfNN_External_Phdr),
7160   sizeof (ElfNN_External_Shdr),
7161   sizeof (ElfNN_External_Rel),
7162   sizeof (ElfNN_External_Rela),
7163   sizeof (ElfNN_External_Sym),
7164   sizeof (ElfNN_External_Dyn),
7165   sizeof (Elf_External_Note),
7166   4,                            /* Hash table entry size.  */
7167   1,                            /* Internal relocs per external relocs.  */
7168   ARCH_SIZE,                    /* Arch size.  */
7169   LOG_FILE_ALIGN,               /* Log_file_align.  */
7170   ELFCLASSNN, EV_CURRENT,
7171   bfd_elfNN_write_out_phdrs,
7172   bfd_elfNN_write_shdrs_and_ehdr,
7173   bfd_elfNN_checksum_contents,
7174   bfd_elfNN_write_relocs,
7175   bfd_elfNN_swap_symbol_in,
7176   bfd_elfNN_swap_symbol_out,
7177   bfd_elfNN_slurp_reloc_table,
7178   bfd_elfNN_slurp_symbol_table,
7179   bfd_elfNN_swap_dyn_in,
7180   bfd_elfNN_swap_dyn_out,
7181   bfd_elfNN_swap_reloc_in,
7182   bfd_elfNN_swap_reloc_out,
7183   bfd_elfNN_swap_reloca_in,
7184   bfd_elfNN_swap_reloca_out
7185 };
7186
7187 #define ELF_ARCH                        bfd_arch_aarch64
7188 #define ELF_MACHINE_CODE                EM_AARCH64
7189 #define ELF_MAXPAGESIZE                 0x10000
7190 #define ELF_MINPAGESIZE                 0x1000
7191 #define ELF_COMMONPAGESIZE              0x1000
7192
7193 #define bfd_elfNN_close_and_cleanup             \
7194   elfNN_aarch64_close_and_cleanup
7195
7196 #define bfd_elfNN_bfd_free_cached_info          \
7197   elfNN_aarch64_bfd_free_cached_info
7198
7199 #define bfd_elfNN_bfd_is_target_special_symbol  \
7200   elfNN_aarch64_is_target_special_symbol
7201
7202 #define bfd_elfNN_bfd_link_hash_table_create    \
7203   elfNN_aarch64_link_hash_table_create
7204
7205 #define bfd_elfNN_bfd_merge_private_bfd_data    \
7206   elfNN_aarch64_merge_private_bfd_data
7207
7208 #define bfd_elfNN_bfd_print_private_bfd_data    \
7209   elfNN_aarch64_print_private_bfd_data
7210
7211 #define bfd_elfNN_bfd_reloc_type_lookup         \
7212   elfNN_aarch64_reloc_type_lookup
7213
7214 #define bfd_elfNN_bfd_reloc_name_lookup         \
7215   elfNN_aarch64_reloc_name_lookup
7216
7217 #define bfd_elfNN_bfd_set_private_flags         \
7218   elfNN_aarch64_set_private_flags
7219
7220 #define bfd_elfNN_find_inliner_info             \
7221   elfNN_aarch64_find_inliner_info
7222
7223 #define bfd_elfNN_find_nearest_line             \
7224   elfNN_aarch64_find_nearest_line
7225
7226 #define bfd_elfNN_mkobject                      \
7227   elfNN_aarch64_mkobject
7228
7229 #define bfd_elfNN_new_section_hook              \
7230   elfNN_aarch64_new_section_hook
7231
7232 #define elf_backend_adjust_dynamic_symbol       \
7233   elfNN_aarch64_adjust_dynamic_symbol
7234
7235 #define elf_backend_always_size_sections        \
7236   elfNN_aarch64_always_size_sections
7237
7238 #define elf_backend_check_relocs                \
7239   elfNN_aarch64_check_relocs
7240
7241 #define elf_backend_copy_indirect_symbol        \
7242   elfNN_aarch64_copy_indirect_symbol
7243
7244 /* Create .dynbss, and .rela.bss sections in DYNOBJ, and set up shortcuts
7245    to them in our hash.  */
7246 #define elf_backend_create_dynamic_sections     \
7247   elfNN_aarch64_create_dynamic_sections
7248
7249 #define elf_backend_init_index_section          \
7250   _bfd_elf_init_2_index_sections
7251
7252 #define elf_backend_finish_dynamic_sections     \
7253   elfNN_aarch64_finish_dynamic_sections
7254
7255 #define elf_backend_finish_dynamic_symbol       \
7256   elfNN_aarch64_finish_dynamic_symbol
7257
7258 #define elf_backend_gc_sweep_hook               \
7259   elfNN_aarch64_gc_sweep_hook
7260
7261 #define elf_backend_object_p                    \
7262   elfNN_aarch64_object_p
7263
7264 #define elf_backend_output_arch_local_syms      \
7265   elfNN_aarch64_output_arch_local_syms
7266
7267 #define elf_backend_plt_sym_val                 \
7268   elfNN_aarch64_plt_sym_val
7269
7270 #define elf_backend_post_process_headers        \
7271   elfNN_aarch64_post_process_headers
7272
7273 #define elf_backend_relocate_section            \
7274   elfNN_aarch64_relocate_section
7275
7276 #define elf_backend_reloc_type_class            \
7277   elfNN_aarch64_reloc_type_class
7278
7279 #define elf_backend_section_from_shdr           \
7280   elfNN_aarch64_section_from_shdr
7281
7282 #define elf_backend_size_dynamic_sections       \
7283   elfNN_aarch64_size_dynamic_sections
7284
7285 #define elf_backend_size_info                   \
7286   elfNN_aarch64_size_info
7287
7288 #define elf_backend_can_refcount       1
7289 #define elf_backend_can_gc_sections    1
7290 #define elf_backend_plt_readonly       1
7291 #define elf_backend_want_got_plt       1
7292 #define elf_backend_want_plt_sym       0
7293 #define elf_backend_may_use_rel_p      0
7294 #define elf_backend_may_use_rela_p     1
7295 #define elf_backend_default_use_rela_p 1
7296 #define elf_backend_rela_normal        1
7297 #define elf_backend_got_header_size (GOT_ENTRY_SIZE * 3)
7298 #define elf_backend_default_execstack  0
7299
7300 #undef  elf_backend_obj_attrs_section
7301 #define elf_backend_obj_attrs_section           ".ARM.attributes"
7302
7303 #include "elfNN-target.h"