Automatic date update in version.in
[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 static const uint32_t aarch64_erratum_835769_stub[] =
1615 {
1616   0x00000000,    /* Placeholder for multiply accumulate.  */
1617   0x14000000,    /* b <label> */
1618 };
1619
1620 /* Section name for stubs is the associated section name plus this
1621    string.  */
1622 #define STUB_SUFFIX ".stub"
1623
1624 enum elf_aarch64_stub_type
1625 {
1626   aarch64_stub_none,
1627   aarch64_stub_adrp_branch,
1628   aarch64_stub_long_branch,
1629   aarch64_stub_erratum_835769_veneer,
1630 };
1631
1632 struct elf_aarch64_stub_hash_entry
1633 {
1634   /* Base hash table entry structure.  */
1635   struct bfd_hash_entry root;
1636
1637   /* The stub section.  */
1638   asection *stub_sec;
1639
1640   /* Offset within stub_sec of the beginning of this stub.  */
1641   bfd_vma stub_offset;
1642
1643   /* Given the symbol's value and its section we can determine its final
1644      value when building the stubs (so the stub knows where to jump).  */
1645   bfd_vma target_value;
1646   asection *target_section;
1647
1648   enum elf_aarch64_stub_type stub_type;
1649
1650   /* The symbol table entry, if any, that this was derived from.  */
1651   struct elf_aarch64_link_hash_entry *h;
1652
1653   /* Destination symbol type */
1654   unsigned char st_type;
1655
1656   /* Where this stub is being called from, or, in the case of combined
1657      stub sections, the first input section in the group.  */
1658   asection *id_sec;
1659
1660   /* The name for the local symbol at the start of this stub.  The
1661      stub name in the hash table has to be unique; this does not, so
1662      it can be friendlier.  */
1663   char *output_name;
1664
1665   /* The instruction which caused this stub to be generated (only valid for
1666      erratum 835769 workaround stubs at present).  */
1667   uint32_t veneered_insn;
1668 };
1669
1670 /* Used to build a map of a section.  This is required for mixed-endian
1671    code/data.  */
1672
1673 typedef struct elf_elf_section_map
1674 {
1675   bfd_vma vma;
1676   char type;
1677 }
1678 elf_aarch64_section_map;
1679
1680
1681 typedef struct _aarch64_elf_section_data
1682 {
1683   struct bfd_elf_section_data elf;
1684   unsigned int mapcount;
1685   unsigned int mapsize;
1686   elf_aarch64_section_map *map;
1687 }
1688 _aarch64_elf_section_data;
1689
1690 #define elf_aarch64_section_data(sec) \
1691   ((_aarch64_elf_section_data *) elf_section_data (sec))
1692
1693 /* A fix-descriptor for erratum 835769.  */
1694 struct aarch64_erratum_835769_fix
1695 {
1696   bfd *input_bfd;
1697   asection *section;
1698   bfd_vma offset;
1699   uint32_t veneered_insn;
1700   char *stub_name;
1701   enum elf_aarch64_stub_type stub_type;
1702 };
1703
1704 /* The size of the thread control block which is defined to be two pointers.  */
1705 #define TCB_SIZE        (ARCH_SIZE/8)*2
1706
1707 struct elf_aarch64_local_symbol
1708 {
1709   unsigned int got_type;
1710   bfd_signed_vma got_refcount;
1711   bfd_vma got_offset;
1712
1713   /* Offset of the GOTPLT entry reserved for the TLS descriptor. The
1714      offset is from the end of the jump table and reserved entries
1715      within the PLTGOT.
1716
1717      The magic value (bfd_vma) -1 indicates that an offset has not be
1718      allocated.  */
1719   bfd_vma tlsdesc_got_jump_table_offset;
1720 };
1721
1722 struct elf_aarch64_obj_tdata
1723 {
1724   struct elf_obj_tdata root;
1725
1726   /* local symbol descriptors */
1727   struct elf_aarch64_local_symbol *locals;
1728
1729   /* Zero to warn when linking objects with incompatible enum sizes.  */
1730   int no_enum_size_warning;
1731
1732   /* Zero to warn when linking objects with incompatible wchar_t sizes.  */
1733   int no_wchar_size_warning;
1734 };
1735
1736 #define elf_aarch64_tdata(bfd)                          \
1737   ((struct elf_aarch64_obj_tdata *) (bfd)->tdata.any)
1738
1739 #define elf_aarch64_locals(bfd) (elf_aarch64_tdata (bfd)->locals)
1740
1741 #define is_aarch64_elf(bfd)                             \
1742   (bfd_get_flavour (bfd) == bfd_target_elf_flavour      \
1743    && elf_tdata (bfd) != NULL                           \
1744    && elf_object_id (bfd) == AARCH64_ELF_DATA)
1745
1746 static bfd_boolean
1747 elfNN_aarch64_mkobject (bfd *abfd)
1748 {
1749   return bfd_elf_allocate_object (abfd, sizeof (struct elf_aarch64_obj_tdata),
1750                                   AARCH64_ELF_DATA);
1751 }
1752
1753 #define elf_aarch64_hash_entry(ent) \
1754   ((struct elf_aarch64_link_hash_entry *)(ent))
1755
1756 #define GOT_UNKNOWN    0
1757 #define GOT_NORMAL     1
1758 #define GOT_TLS_GD     2
1759 #define GOT_TLS_IE     4
1760 #define GOT_TLSDESC_GD 8
1761
1762 #define GOT_TLS_GD_ANY_P(type)  ((type & GOT_TLS_GD) || (type & GOT_TLSDESC_GD))
1763
1764 /* AArch64 ELF linker hash entry.  */
1765 struct elf_aarch64_link_hash_entry
1766 {
1767   struct elf_link_hash_entry root;
1768
1769   /* Track dynamic relocs copied for this symbol.  */
1770   struct elf_dyn_relocs *dyn_relocs;
1771
1772   /* Since PLT entries have variable size, we need to record the
1773      index into .got.plt instead of recomputing it from the PLT
1774      offset.  */
1775   bfd_signed_vma plt_got_offset;
1776
1777   /* Bit mask representing the type of GOT entry(s) if any required by
1778      this symbol.  */
1779   unsigned int got_type;
1780
1781   /* A pointer to the most recently used stub hash entry against this
1782      symbol.  */
1783   struct elf_aarch64_stub_hash_entry *stub_cache;
1784
1785   /* Offset of the GOTPLT entry reserved for the TLS descriptor.  The offset
1786      is from the end of the jump table and reserved entries within the PLTGOT.
1787
1788      The magic value (bfd_vma) -1 indicates that an offset has not
1789      be allocated.  */
1790   bfd_vma tlsdesc_got_jump_table_offset;
1791 };
1792
1793 static unsigned int
1794 elfNN_aarch64_symbol_got_type (struct elf_link_hash_entry *h,
1795                                bfd *abfd,
1796                                unsigned long r_symndx)
1797 {
1798   if (h)
1799     return elf_aarch64_hash_entry (h)->got_type;
1800
1801   if (! elf_aarch64_locals (abfd))
1802     return GOT_UNKNOWN;
1803
1804   return elf_aarch64_locals (abfd)[r_symndx].got_type;
1805 }
1806
1807 /* Get the AArch64 elf linker hash table from a link_info structure.  */
1808 #define elf_aarch64_hash_table(info)                                    \
1809   ((struct elf_aarch64_link_hash_table *) ((info)->hash))
1810
1811 #define aarch64_stub_hash_lookup(table, string, create, copy)           \
1812   ((struct elf_aarch64_stub_hash_entry *)                               \
1813    bfd_hash_lookup ((table), (string), (create), (copy)))
1814
1815 /* AArch64 ELF linker hash table.  */
1816 struct elf_aarch64_link_hash_table
1817 {
1818   /* The main hash table.  */
1819   struct elf_link_hash_table root;
1820
1821   /* Nonzero to force PIC branch veneers.  */
1822   int pic_veneer;
1823
1824   /* Fix erratum 835769.  */
1825   int fix_erratum_835769;
1826
1827   /* A table of fix locations for erratum 835769.  This holds erratum
1828      fix locations between elfNN_aarch64_size_stubs() and
1829      elfNN_aarch64_write_section().  */
1830   struct aarch64_erratum_835769_fix *aarch64_erratum_835769_fixes;
1831   unsigned int num_aarch64_erratum_835769_fixes;
1832
1833   /* The number of bytes in the initial entry in the PLT.  */
1834   bfd_size_type plt_header_size;
1835
1836   /* The number of bytes in the subsequent PLT etries.  */
1837   bfd_size_type plt_entry_size;
1838
1839   /* Short-cuts to get to dynamic linker sections.  */
1840   asection *sdynbss;
1841   asection *srelbss;
1842
1843   /* Small local sym cache.  */
1844   struct sym_cache sym_cache;
1845
1846   /* For convenience in allocate_dynrelocs.  */
1847   bfd *obfd;
1848
1849   /* The amount of space used by the reserved portion of the sgotplt
1850      section, plus whatever space is used by the jump slots.  */
1851   bfd_vma sgotplt_jump_table_size;
1852
1853   /* The stub hash table.  */
1854   struct bfd_hash_table stub_hash_table;
1855
1856   /* Linker stub bfd.  */
1857   bfd *stub_bfd;
1858
1859   /* Linker call-backs.  */
1860   asection *(*add_stub_section) (const char *, asection *);
1861   void (*layout_sections_again) (void);
1862
1863   /* Array to keep track of which stub sections have been created, and
1864      information on stub grouping.  */
1865   struct map_stub
1866   {
1867     /* This is the section to which stubs in the group will be
1868        attached.  */
1869     asection *link_sec;
1870     /* The stub section.  */
1871     asection *stub_sec;
1872   } *stub_group;
1873
1874   /* Assorted information used by elfNN_aarch64_size_stubs.  */
1875   unsigned int bfd_count;
1876   int top_index;
1877   asection **input_list;
1878
1879   /* The offset into splt of the PLT entry for the TLS descriptor
1880      resolver.  Special values are 0, if not necessary (or not found
1881      to be necessary yet), and -1 if needed but not determined
1882      yet.  */
1883   bfd_vma tlsdesc_plt;
1884
1885   /* The GOT offset for the lazy trampoline.  Communicated to the
1886      loader via DT_TLSDESC_GOT.  The magic value (bfd_vma) -1
1887      indicates an offset is not allocated.  */
1888   bfd_vma dt_tlsdesc_got;
1889
1890   /* Used by local STT_GNU_IFUNC symbols.  */
1891   htab_t loc_hash_table;
1892   void * loc_hash_memory;
1893 };
1894
1895 /* Create an entry in an AArch64 ELF linker hash table.  */
1896
1897 static struct bfd_hash_entry *
1898 elfNN_aarch64_link_hash_newfunc (struct bfd_hash_entry *entry,
1899                                  struct bfd_hash_table *table,
1900                                  const char *string)
1901 {
1902   struct elf_aarch64_link_hash_entry *ret =
1903     (struct elf_aarch64_link_hash_entry *) entry;
1904
1905   /* Allocate the structure if it has not already been allocated by a
1906      subclass.  */
1907   if (ret == NULL)
1908     ret = bfd_hash_allocate (table,
1909                              sizeof (struct elf_aarch64_link_hash_entry));
1910   if (ret == NULL)
1911     return (struct bfd_hash_entry *) ret;
1912
1913   /* Call the allocation method of the superclass.  */
1914   ret = ((struct elf_aarch64_link_hash_entry *)
1915          _bfd_elf_link_hash_newfunc ((struct bfd_hash_entry *) ret,
1916                                      table, string));
1917   if (ret != NULL)
1918     {
1919       ret->dyn_relocs = NULL;
1920       ret->got_type = GOT_UNKNOWN;
1921       ret->plt_got_offset = (bfd_vma) - 1;
1922       ret->stub_cache = NULL;
1923       ret->tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
1924     }
1925
1926   return (struct bfd_hash_entry *) ret;
1927 }
1928
1929 /* Initialize an entry in the stub hash table.  */
1930
1931 static struct bfd_hash_entry *
1932 stub_hash_newfunc (struct bfd_hash_entry *entry,
1933                    struct bfd_hash_table *table, const char *string)
1934 {
1935   /* Allocate the structure if it has not already been allocated by a
1936      subclass.  */
1937   if (entry == NULL)
1938     {
1939       entry = bfd_hash_allocate (table,
1940                                  sizeof (struct
1941                                          elf_aarch64_stub_hash_entry));
1942       if (entry == NULL)
1943         return entry;
1944     }
1945
1946   /* Call the allocation method of the superclass.  */
1947   entry = bfd_hash_newfunc (entry, table, string);
1948   if (entry != NULL)
1949     {
1950       struct elf_aarch64_stub_hash_entry *eh;
1951
1952       /* Initialize the local fields.  */
1953       eh = (struct elf_aarch64_stub_hash_entry *) entry;
1954       eh->stub_sec = NULL;
1955       eh->stub_offset = 0;
1956       eh->target_value = 0;
1957       eh->target_section = NULL;
1958       eh->stub_type = aarch64_stub_none;
1959       eh->h = NULL;
1960       eh->id_sec = NULL;
1961     }
1962
1963   return entry;
1964 }
1965
1966 /* Compute a hash of a local hash entry.  We use elf_link_hash_entry
1967   for local symbol so that we can handle local STT_GNU_IFUNC symbols
1968   as global symbol.  We reuse indx and dynstr_index for local symbol
1969   hash since they aren't used by global symbols in this backend.  */
1970
1971 static hashval_t
1972 elfNN_aarch64_local_htab_hash (const void *ptr)
1973 {
1974   struct elf_link_hash_entry *h
1975     = (struct elf_link_hash_entry *) ptr;
1976   return ELF_LOCAL_SYMBOL_HASH (h->indx, h->dynstr_index);
1977 }
1978
1979 /* Compare local hash entries.  */
1980
1981 static int
1982 elfNN_aarch64_local_htab_eq (const void *ptr1, const void *ptr2)
1983 {
1984   struct elf_link_hash_entry *h1
1985      = (struct elf_link_hash_entry *) ptr1;
1986   struct elf_link_hash_entry *h2
1987     = (struct elf_link_hash_entry *) ptr2;
1988
1989   return h1->indx == h2->indx && h1->dynstr_index == h2->dynstr_index;
1990 }
1991
1992 /* Find and/or create a hash entry for local symbol.  */
1993
1994 static struct elf_link_hash_entry *
1995 elfNN_aarch64_get_local_sym_hash (struct elf_aarch64_link_hash_table *htab,
1996                                   bfd *abfd, const Elf_Internal_Rela *rel,
1997                                   bfd_boolean create)
1998 {
1999   struct elf_aarch64_link_hash_entry e, *ret;
2000   asection *sec = abfd->sections;
2001   hashval_t h = ELF_LOCAL_SYMBOL_HASH (sec->id,
2002                                        ELFNN_R_SYM (rel->r_info));
2003   void **slot;
2004
2005   e.root.indx = sec->id;
2006   e.root.dynstr_index = ELFNN_R_SYM (rel->r_info);
2007   slot = htab_find_slot_with_hash (htab->loc_hash_table, &e, h,
2008                                    create ? INSERT : NO_INSERT);
2009
2010   if (!slot)
2011     return NULL;
2012
2013   if (*slot)
2014     {
2015       ret = (struct elf_aarch64_link_hash_entry *) *slot;
2016       return &ret->root;
2017     }
2018
2019   ret = (struct elf_aarch64_link_hash_entry *)
2020         objalloc_alloc ((struct objalloc *) htab->loc_hash_memory,
2021                         sizeof (struct elf_aarch64_link_hash_entry));
2022   if (ret)
2023     {
2024       memset (ret, 0, sizeof (*ret));
2025       ret->root.indx = sec->id;
2026       ret->root.dynstr_index = ELFNN_R_SYM (rel->r_info);
2027       ret->root.dynindx = -1;
2028       *slot = ret;
2029     }
2030   return &ret->root;
2031 }
2032
2033 /* Copy the extra info we tack onto an elf_link_hash_entry.  */
2034
2035 static void
2036 elfNN_aarch64_copy_indirect_symbol (struct bfd_link_info *info,
2037                                     struct elf_link_hash_entry *dir,
2038                                     struct elf_link_hash_entry *ind)
2039 {
2040   struct elf_aarch64_link_hash_entry *edir, *eind;
2041
2042   edir = (struct elf_aarch64_link_hash_entry *) dir;
2043   eind = (struct elf_aarch64_link_hash_entry *) ind;
2044
2045   if (eind->dyn_relocs != NULL)
2046     {
2047       if (edir->dyn_relocs != NULL)
2048         {
2049           struct elf_dyn_relocs **pp;
2050           struct elf_dyn_relocs *p;
2051
2052           /* Add reloc counts against the indirect sym to the direct sym
2053              list.  Merge any entries against the same section.  */
2054           for (pp = &eind->dyn_relocs; (p = *pp) != NULL;)
2055             {
2056               struct elf_dyn_relocs *q;
2057
2058               for (q = edir->dyn_relocs; q != NULL; q = q->next)
2059                 if (q->sec == p->sec)
2060                   {
2061                     q->pc_count += p->pc_count;
2062                     q->count += p->count;
2063                     *pp = p->next;
2064                     break;
2065                   }
2066               if (q == NULL)
2067                 pp = &p->next;
2068             }
2069           *pp = edir->dyn_relocs;
2070         }
2071
2072       edir->dyn_relocs = eind->dyn_relocs;
2073       eind->dyn_relocs = NULL;
2074     }
2075
2076   if (ind->root.type == bfd_link_hash_indirect)
2077     {
2078       /* Copy over PLT info.  */
2079       if (dir->got.refcount <= 0)
2080         {
2081           edir->got_type = eind->got_type;
2082           eind->got_type = GOT_UNKNOWN;
2083         }
2084     }
2085
2086   _bfd_elf_link_hash_copy_indirect (info, dir, ind);
2087 }
2088
2089 /* Destroy an AArch64 elf linker hash table.  */
2090
2091 static void
2092 elfNN_aarch64_link_hash_table_free (bfd *obfd)
2093 {
2094   struct elf_aarch64_link_hash_table *ret
2095     = (struct elf_aarch64_link_hash_table *) obfd->link.hash;
2096
2097   if (ret->loc_hash_table)
2098     htab_delete (ret->loc_hash_table);
2099   if (ret->loc_hash_memory)
2100     objalloc_free ((struct objalloc *) ret->loc_hash_memory);
2101
2102   bfd_hash_table_free (&ret->stub_hash_table);
2103   _bfd_elf_link_hash_table_free (obfd);
2104 }
2105
2106 /* Create an AArch64 elf linker hash table.  */
2107
2108 static struct bfd_link_hash_table *
2109 elfNN_aarch64_link_hash_table_create (bfd *abfd)
2110 {
2111   struct elf_aarch64_link_hash_table *ret;
2112   bfd_size_type amt = sizeof (struct elf_aarch64_link_hash_table);
2113
2114   ret = bfd_zmalloc (amt);
2115   if (ret == NULL)
2116     return NULL;
2117
2118   if (!_bfd_elf_link_hash_table_init
2119       (&ret->root, abfd, elfNN_aarch64_link_hash_newfunc,
2120        sizeof (struct elf_aarch64_link_hash_entry), AARCH64_ELF_DATA))
2121     {
2122       free (ret);
2123       return NULL;
2124     }
2125
2126   ret->plt_header_size = PLT_ENTRY_SIZE;
2127   ret->plt_entry_size = PLT_SMALL_ENTRY_SIZE;
2128   ret->obfd = abfd;
2129   ret->dt_tlsdesc_got = (bfd_vma) - 1;
2130
2131   if (!bfd_hash_table_init (&ret->stub_hash_table, stub_hash_newfunc,
2132                             sizeof (struct elf_aarch64_stub_hash_entry)))
2133     {
2134       _bfd_elf_link_hash_table_free (abfd);
2135       return NULL;
2136     }
2137
2138   ret->loc_hash_table = htab_try_create (1024,
2139                                          elfNN_aarch64_local_htab_hash,
2140                                          elfNN_aarch64_local_htab_eq,
2141                                          NULL);
2142   ret->loc_hash_memory = objalloc_create ();
2143   if (!ret->loc_hash_table || !ret->loc_hash_memory)
2144     {
2145       elfNN_aarch64_link_hash_table_free (abfd);
2146       return NULL;
2147     }
2148   ret->root.root.hash_table_free = elfNN_aarch64_link_hash_table_free;
2149
2150   return &ret->root.root;
2151 }
2152
2153 static bfd_boolean
2154 aarch64_relocate (unsigned int r_type, bfd *input_bfd, asection *input_section,
2155                   bfd_vma offset, bfd_vma value)
2156 {
2157   reloc_howto_type *howto;
2158   bfd_vma place;
2159
2160   howto = elfNN_aarch64_howto_from_type (r_type);
2161   place = (input_section->output_section->vma + input_section->output_offset
2162            + offset);
2163
2164   r_type = elfNN_aarch64_bfd_reloc_from_type (r_type);
2165   value = _bfd_aarch64_elf_resolve_relocation (r_type, place, value, 0, FALSE);
2166   return _bfd_aarch64_elf_put_addend (input_bfd,
2167                                       input_section->contents + offset, r_type,
2168                                       howto, value);
2169 }
2170
2171 static enum elf_aarch64_stub_type
2172 aarch64_select_branch_stub (bfd_vma value, bfd_vma place)
2173 {
2174   if (aarch64_valid_for_adrp_p (value, place))
2175     return aarch64_stub_adrp_branch;
2176   return aarch64_stub_long_branch;
2177 }
2178
2179 /* Determine the type of stub needed, if any, for a call.  */
2180
2181 static enum elf_aarch64_stub_type
2182 aarch64_type_of_stub (struct bfd_link_info *info,
2183                       asection *input_sec,
2184                       const Elf_Internal_Rela *rel,
2185                       unsigned char st_type,
2186                       struct elf_aarch64_link_hash_entry *hash,
2187                       bfd_vma destination)
2188 {
2189   bfd_vma location;
2190   bfd_signed_vma branch_offset;
2191   unsigned int r_type;
2192   struct elf_aarch64_link_hash_table *globals;
2193   enum elf_aarch64_stub_type stub_type = aarch64_stub_none;
2194   bfd_boolean via_plt_p;
2195
2196   if (st_type != STT_FUNC)
2197     return stub_type;
2198
2199   globals = elf_aarch64_hash_table (info);
2200   via_plt_p = (globals->root.splt != NULL && hash != NULL
2201                && hash->root.plt.offset != (bfd_vma) - 1);
2202
2203   if (via_plt_p)
2204     return stub_type;
2205
2206   /* Determine where the call point is.  */
2207   location = (input_sec->output_offset
2208               + input_sec->output_section->vma + rel->r_offset);
2209
2210   branch_offset = (bfd_signed_vma) (destination - location);
2211
2212   r_type = ELFNN_R_TYPE (rel->r_info);
2213
2214   /* We don't want to redirect any old unconditional jump in this way,
2215      only one which is being used for a sibcall, where it is
2216      acceptable for the IP0 and IP1 registers to be clobbered.  */
2217   if ((r_type == AARCH64_R (CALL26) || r_type == AARCH64_R (JUMP26))
2218       && (branch_offset > AARCH64_MAX_FWD_BRANCH_OFFSET
2219           || branch_offset < AARCH64_MAX_BWD_BRANCH_OFFSET))
2220     {
2221       stub_type = aarch64_stub_long_branch;
2222     }
2223
2224   return stub_type;
2225 }
2226
2227 /* Build a name for an entry in the stub hash table.  */
2228
2229 static char *
2230 elfNN_aarch64_stub_name (const asection *input_section,
2231                          const asection *sym_sec,
2232                          const struct elf_aarch64_link_hash_entry *hash,
2233                          const Elf_Internal_Rela *rel)
2234 {
2235   char *stub_name;
2236   bfd_size_type len;
2237
2238   if (hash)
2239     {
2240       len = 8 + 1 + strlen (hash->root.root.root.string) + 1 + 16 + 1;
2241       stub_name = bfd_malloc (len);
2242       if (stub_name != NULL)
2243         snprintf (stub_name, len, "%08x_%s+%" BFD_VMA_FMT "x",
2244                   (unsigned int) input_section->id,
2245                   hash->root.root.root.string,
2246                   rel->r_addend);
2247     }
2248   else
2249     {
2250       len = 8 + 1 + 8 + 1 + 8 + 1 + 16 + 1;
2251       stub_name = bfd_malloc (len);
2252       if (stub_name != NULL)
2253         snprintf (stub_name, len, "%08x_%x:%x+%" BFD_VMA_FMT "x",
2254                   (unsigned int) input_section->id,
2255                   (unsigned int) sym_sec->id,
2256                   (unsigned int) ELFNN_R_SYM (rel->r_info),
2257                   rel->r_addend);
2258     }
2259
2260   return stub_name;
2261 }
2262
2263 /* Look up an entry in the stub hash.  Stub entries are cached because
2264    creating the stub name takes a bit of time.  */
2265
2266 static struct elf_aarch64_stub_hash_entry *
2267 elfNN_aarch64_get_stub_entry (const asection *input_section,
2268                               const asection *sym_sec,
2269                               struct elf_link_hash_entry *hash,
2270                               const Elf_Internal_Rela *rel,
2271                               struct elf_aarch64_link_hash_table *htab)
2272 {
2273   struct elf_aarch64_stub_hash_entry *stub_entry;
2274   struct elf_aarch64_link_hash_entry *h =
2275     (struct elf_aarch64_link_hash_entry *) hash;
2276   const asection *id_sec;
2277
2278   if ((input_section->flags & SEC_CODE) == 0)
2279     return NULL;
2280
2281   /* If this input section is part of a group of sections sharing one
2282      stub section, then use the id of the first section in the group.
2283      Stub names need to include a section id, as there may well be
2284      more than one stub used to reach say, printf, and we need to
2285      distinguish between them.  */
2286   id_sec = htab->stub_group[input_section->id].link_sec;
2287
2288   if (h != NULL && h->stub_cache != NULL
2289       && h->stub_cache->h == h && h->stub_cache->id_sec == id_sec)
2290     {
2291       stub_entry = h->stub_cache;
2292     }
2293   else
2294     {
2295       char *stub_name;
2296
2297       stub_name = elfNN_aarch64_stub_name (id_sec, sym_sec, h, rel);
2298       if (stub_name == NULL)
2299         return NULL;
2300
2301       stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table,
2302                                              stub_name, FALSE, FALSE);
2303       if (h != NULL)
2304         h->stub_cache = stub_entry;
2305
2306       free (stub_name);
2307     }
2308
2309   return stub_entry;
2310 }
2311
2312 /* Add a new stub entry to the stub hash.  Not all fields of the new
2313    stub entry are initialised.  */
2314
2315 static struct elf_aarch64_stub_hash_entry *
2316 elfNN_aarch64_add_stub (const char *stub_name,
2317                         asection *section,
2318                         struct elf_aarch64_link_hash_table *htab)
2319 {
2320   asection *link_sec;
2321   asection *stub_sec;
2322   struct elf_aarch64_stub_hash_entry *stub_entry;
2323
2324   link_sec = htab->stub_group[section->id].link_sec;
2325   stub_sec = htab->stub_group[section->id].stub_sec;
2326   if (stub_sec == NULL)
2327     {
2328       stub_sec = htab->stub_group[link_sec->id].stub_sec;
2329       if (stub_sec == NULL)
2330         {
2331           size_t namelen;
2332           bfd_size_type len;
2333           char *s_name;
2334
2335           namelen = strlen (link_sec->name);
2336           len = namelen + sizeof (STUB_SUFFIX);
2337           s_name = bfd_alloc (htab->stub_bfd, len);
2338           if (s_name == NULL)
2339             return NULL;
2340
2341           memcpy (s_name, link_sec->name, namelen);
2342           memcpy (s_name + namelen, STUB_SUFFIX, sizeof (STUB_SUFFIX));
2343           stub_sec = (*htab->add_stub_section) (s_name, link_sec);
2344           if (stub_sec == NULL)
2345             return NULL;
2346           htab->stub_group[link_sec->id].stub_sec = stub_sec;
2347         }
2348       htab->stub_group[section->id].stub_sec = stub_sec;
2349     }
2350
2351   /* Enter this entry into the linker stub hash table.  */
2352   stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table, stub_name,
2353                                          TRUE, FALSE);
2354   if (stub_entry == NULL)
2355     {
2356       (*_bfd_error_handler) (_("%s: cannot create stub entry %s"),
2357                              section->owner, stub_name);
2358       return NULL;
2359     }
2360
2361   stub_entry->stub_sec = stub_sec;
2362   stub_entry->stub_offset = 0;
2363   stub_entry->id_sec = link_sec;
2364
2365   return stub_entry;
2366 }
2367
2368 static bfd_boolean
2369 aarch64_build_one_stub (struct bfd_hash_entry *gen_entry,
2370                         void *in_arg ATTRIBUTE_UNUSED)
2371 {
2372   struct elf_aarch64_stub_hash_entry *stub_entry;
2373   asection *stub_sec;
2374   bfd *stub_bfd;
2375   bfd_byte *loc;
2376   bfd_vma sym_value;
2377   bfd_vma veneered_insn_loc;
2378   bfd_vma veneer_entry_loc;
2379   bfd_signed_vma branch_offset = 0;
2380   unsigned int template_size;
2381   const uint32_t *template;
2382   unsigned int i;
2383
2384   /* Massage our args to the form they really have.  */
2385   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
2386
2387   stub_sec = stub_entry->stub_sec;
2388
2389   /* Make a note of the offset within the stubs for this entry.  */
2390   stub_entry->stub_offset = stub_sec->size;
2391   loc = stub_sec->contents + stub_entry->stub_offset;
2392
2393   stub_bfd = stub_sec->owner;
2394
2395   /* This is the address of the stub destination.  */
2396   sym_value = (stub_entry->target_value
2397                + stub_entry->target_section->output_offset
2398                + stub_entry->target_section->output_section->vma);
2399
2400   if (stub_entry->stub_type == aarch64_stub_long_branch)
2401     {
2402       bfd_vma place = (stub_entry->stub_offset + stub_sec->output_section->vma
2403                        + stub_sec->output_offset);
2404
2405       /* See if we can relax the stub.  */
2406       if (aarch64_valid_for_adrp_p (sym_value, place))
2407         stub_entry->stub_type = aarch64_select_branch_stub (sym_value, place);
2408     }
2409
2410   switch (stub_entry->stub_type)
2411     {
2412     case aarch64_stub_adrp_branch:
2413       template = aarch64_adrp_branch_stub;
2414       template_size = sizeof (aarch64_adrp_branch_stub);
2415       break;
2416     case aarch64_stub_long_branch:
2417       template = aarch64_long_branch_stub;
2418       template_size = sizeof (aarch64_long_branch_stub);
2419       break;
2420     case aarch64_stub_erratum_835769_veneer:
2421       template = aarch64_erratum_835769_stub;
2422       template_size = sizeof (aarch64_erratum_835769_stub);
2423       break;
2424     default:
2425       BFD_FAIL ();
2426       return FALSE;
2427     }
2428
2429   for (i = 0; i < (template_size / sizeof template[0]); i++)
2430     {
2431       bfd_putl32 (template[i], loc);
2432       loc += 4;
2433     }
2434
2435   template_size = (template_size + 7) & ~7;
2436   stub_sec->size += template_size;
2437
2438   switch (stub_entry->stub_type)
2439     {
2440     case aarch64_stub_adrp_branch:
2441       if (aarch64_relocate (AARCH64_R (ADR_PREL_PG_HI21), stub_bfd, stub_sec,
2442                             stub_entry->stub_offset, sym_value))
2443         /* The stub would not have been relaxed if the offset was out
2444            of range.  */
2445         BFD_FAIL ();
2446
2447       _bfd_final_link_relocate
2448         (elfNN_aarch64_howto_from_type (AARCH64_R (ADD_ABS_LO12_NC)),
2449          stub_bfd,
2450          stub_sec,
2451          stub_sec->contents,
2452          stub_entry->stub_offset + 4,
2453          sym_value,
2454          0);
2455       break;
2456
2457     case aarch64_stub_long_branch:
2458       /* We want the value relative to the address 12 bytes back from the
2459          value itself.  */
2460       _bfd_final_link_relocate (elfNN_aarch64_howto_from_type
2461                                 (AARCH64_R (PRELNN)), stub_bfd, stub_sec,
2462                                 stub_sec->contents,
2463                                 stub_entry->stub_offset + 16,
2464                                 sym_value + 12, 0);
2465       break;
2466
2467     case aarch64_stub_erratum_835769_veneer:
2468       veneered_insn_loc = stub_entry->target_section->output_section->vma
2469                           + stub_entry->target_section->output_offset
2470                           + stub_entry->target_value;
2471       veneer_entry_loc = stub_entry->stub_sec->output_section->vma
2472                           + stub_entry->stub_sec->output_offset
2473                           + stub_entry->stub_offset;
2474       branch_offset = veneered_insn_loc - veneer_entry_loc;
2475       branch_offset >>= 2;
2476       branch_offset &= 0x3ffffff;
2477       bfd_putl32 (stub_entry->veneered_insn,
2478                   stub_sec->contents + stub_entry->stub_offset);
2479       bfd_putl32 (template[1] | branch_offset,
2480                   stub_sec->contents + stub_entry->stub_offset + 4);
2481       break;
2482
2483     default:
2484       break;
2485     }
2486
2487   return TRUE;
2488 }
2489
2490 /* As above, but don't actually build the stub.  Just bump offset so
2491    we know stub section sizes.  */
2492
2493 static bfd_boolean
2494 aarch64_size_one_stub (struct bfd_hash_entry *gen_entry,
2495                        void *in_arg ATTRIBUTE_UNUSED)
2496 {
2497   struct elf_aarch64_stub_hash_entry *stub_entry;
2498   int size;
2499
2500   /* Massage our args to the form they really have.  */
2501   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
2502
2503   switch (stub_entry->stub_type)
2504     {
2505     case aarch64_stub_adrp_branch:
2506       size = sizeof (aarch64_adrp_branch_stub);
2507       break;
2508     case aarch64_stub_long_branch:
2509       size = sizeof (aarch64_long_branch_stub);
2510       break;
2511     case aarch64_stub_erratum_835769_veneer:
2512       size = sizeof (aarch64_erratum_835769_stub);
2513       break;
2514     default:
2515       BFD_FAIL ();
2516       return FALSE;
2517       break;
2518     }
2519
2520   size = (size + 7) & ~7;
2521   stub_entry->stub_sec->size += size;
2522   return TRUE;
2523 }
2524
2525 /* External entry points for sizing and building linker stubs.  */
2526
2527 /* Set up various things so that we can make a list of input sections
2528    for each output section included in the link.  Returns -1 on error,
2529    0 when no stubs will be needed, and 1 on success.  */
2530
2531 int
2532 elfNN_aarch64_setup_section_lists (bfd *output_bfd,
2533                                    struct bfd_link_info *info)
2534 {
2535   bfd *input_bfd;
2536   unsigned int bfd_count;
2537   int top_id, top_index;
2538   asection *section;
2539   asection **input_list, **list;
2540   bfd_size_type amt;
2541   struct elf_aarch64_link_hash_table *htab =
2542     elf_aarch64_hash_table (info);
2543
2544   if (!is_elf_hash_table (htab))
2545     return 0;
2546
2547   /* Count the number of input BFDs and find the top input section id.  */
2548   for (input_bfd = info->input_bfds, bfd_count = 0, top_id = 0;
2549        input_bfd != NULL; input_bfd = input_bfd->link.next)
2550     {
2551       bfd_count += 1;
2552       for (section = input_bfd->sections;
2553            section != NULL; section = section->next)
2554         {
2555           if (top_id < section->id)
2556             top_id = section->id;
2557         }
2558     }
2559   htab->bfd_count = bfd_count;
2560
2561   amt = sizeof (struct map_stub) * (top_id + 1);
2562   htab->stub_group = bfd_zmalloc (amt);
2563   if (htab->stub_group == NULL)
2564     return -1;
2565
2566   /* We can't use output_bfd->section_count here to find the top output
2567      section index as some sections may have been removed, and
2568      _bfd_strip_section_from_output doesn't renumber the indices.  */
2569   for (section = output_bfd->sections, top_index = 0;
2570        section != NULL; section = section->next)
2571     {
2572       if (top_index < section->index)
2573         top_index = section->index;
2574     }
2575
2576   htab->top_index = top_index;
2577   amt = sizeof (asection *) * (top_index + 1);
2578   input_list = bfd_malloc (amt);
2579   htab->input_list = input_list;
2580   if (input_list == NULL)
2581     return -1;
2582
2583   /* For sections we aren't interested in, mark their entries with a
2584      value we can check later.  */
2585   list = input_list + top_index;
2586   do
2587     *list = bfd_abs_section_ptr;
2588   while (list-- != input_list);
2589
2590   for (section = output_bfd->sections;
2591        section != NULL; section = section->next)
2592     {
2593       if ((section->flags & SEC_CODE) != 0)
2594         input_list[section->index] = NULL;
2595     }
2596
2597   return 1;
2598 }
2599
2600 /* Used by elfNN_aarch64_next_input_section and group_sections.  */
2601 #define PREV_SEC(sec) (htab->stub_group[(sec)->id].link_sec)
2602
2603 /* The linker repeatedly calls this function for each input section,
2604    in the order that input sections are linked into output sections.
2605    Build lists of input sections to determine groupings between which
2606    we may insert linker stubs.  */
2607
2608 void
2609 elfNN_aarch64_next_input_section (struct bfd_link_info *info, asection *isec)
2610 {
2611   struct elf_aarch64_link_hash_table *htab =
2612     elf_aarch64_hash_table (info);
2613
2614   if (isec->output_section->index <= htab->top_index)
2615     {
2616       asection **list = htab->input_list + isec->output_section->index;
2617
2618       if (*list != bfd_abs_section_ptr)
2619         {
2620           /* Steal the link_sec pointer for our list.  */
2621           /* This happens to make the list in reverse order,
2622              which is what we want.  */
2623           PREV_SEC (isec) = *list;
2624           *list = isec;
2625         }
2626     }
2627 }
2628
2629 /* See whether we can group stub sections together.  Grouping stub
2630    sections may result in fewer stubs.  More importantly, we need to
2631    put all .init* and .fini* stubs at the beginning of the .init or
2632    .fini output sections respectively, because glibc splits the
2633    _init and _fini functions into multiple parts.  Putting a stub in
2634    the middle of a function is not a good idea.  */
2635
2636 static void
2637 group_sections (struct elf_aarch64_link_hash_table *htab,
2638                 bfd_size_type stub_group_size,
2639                 bfd_boolean stubs_always_before_branch)
2640 {
2641   asection **list = htab->input_list + htab->top_index;
2642
2643   do
2644     {
2645       asection *tail = *list;
2646
2647       if (tail == bfd_abs_section_ptr)
2648         continue;
2649
2650       while (tail != NULL)
2651         {
2652           asection *curr;
2653           asection *prev;
2654           bfd_size_type total;
2655
2656           curr = tail;
2657           total = tail->size;
2658           while ((prev = PREV_SEC (curr)) != NULL
2659                  && ((total += curr->output_offset - prev->output_offset)
2660                      < stub_group_size))
2661             curr = prev;
2662
2663           /* OK, the size from the start of CURR to the end is less
2664              than stub_group_size and thus can be handled by one stub
2665              section.  (Or the tail section is itself larger than
2666              stub_group_size, in which case we may be toast.)
2667              We should really be keeping track of the total size of
2668              stubs added here, as stubs contribute to the final output
2669              section size.  */
2670           do
2671             {
2672               prev = PREV_SEC (tail);
2673               /* Set up this stub group.  */
2674               htab->stub_group[tail->id].link_sec = curr;
2675             }
2676           while (tail != curr && (tail = prev) != NULL);
2677
2678           /* But wait, there's more!  Input sections up to stub_group_size
2679              bytes before the stub section can be handled by it too.  */
2680           if (!stubs_always_before_branch)
2681             {
2682               total = 0;
2683               while (prev != NULL
2684                      && ((total += tail->output_offset - prev->output_offset)
2685                          < stub_group_size))
2686                 {
2687                   tail = prev;
2688                   prev = PREV_SEC (tail);
2689                   htab->stub_group[tail->id].link_sec = curr;
2690                 }
2691             }
2692           tail = prev;
2693         }
2694     }
2695   while (list-- != htab->input_list);
2696
2697   free (htab->input_list);
2698 }
2699
2700 #undef PREV_SEC
2701
2702 #define AARCH64_BITS(x, pos, n) (((x) >> (pos)) & ((1 << (n)) - 1))
2703
2704 #define AARCH64_RT(insn) AARCH64_BITS (insn, 0, 5)
2705 #define AARCH64_RT2(insn) AARCH64_BITS (insn, 10, 5)
2706 #define AARCH64_RA(insn) AARCH64_BITS (insn, 10, 5)
2707 #define AARCH64_RD(insn) AARCH64_BITS (insn, 0, 5)
2708 #define AARCH64_RN(insn) AARCH64_BITS (insn, 5, 5)
2709 #define AARCH64_RM(insn) AARCH64_BITS (insn, 16, 5)
2710
2711 #define AARCH64_MAC(insn) (((insn) & 0xff000000) == 0x9b000000)
2712 #define AARCH64_BIT(insn, n) AARCH64_BITS (insn, n, 1)
2713 #define AARCH64_OP31(insn) AARCH64_BITS (insn, 21, 3)
2714 #define AARCH64_ZR 0x1f
2715
2716 /* All ld/st ops.  See C4-182 of the ARM ARM.  The encoding space for
2717    LD_PCREL, LDST_RO, LDST_UI and LDST_UIMM cover prefetch ops.  */
2718
2719 #define AARCH64_LD(insn) (AARCH64_BIT (insn, 22) == 1)
2720 #define AARCH64_LDST(insn) (((insn) & 0x0a000000) == 0x08000000)
2721 #define AARCH64_LDST_EX(insn) (((insn) & 0x3f000000) == 0x08000000)
2722 #define AARCH64_LDST_PCREL(insn) (((insn) & 0x3b000000) == 0x18000000)
2723 #define AARCH64_LDST_NAP(insn) (((insn) & 0x3b800000) == 0x28000000)
2724 #define AARCH64_LDSTP_PI(insn) (((insn) & 0x3b800000) == 0x28800000)
2725 #define AARCH64_LDSTP_O(insn) (((insn) & 0x3b800000) == 0x29000000)
2726 #define AARCH64_LDSTP_PRE(insn) (((insn) & 0x3b800000) == 0x29800000)
2727 #define AARCH64_LDST_UI(insn) (((insn) & 0x3b200c00) == 0x38000000)
2728 #define AARCH64_LDST_PIIMM(insn) (((insn) & 0x3b200c00) == 0x38000400)
2729 #define AARCH64_LDST_U(insn) (((insn) & 0x3b200c00) == 0x38000800)
2730 #define AARCH64_LDST_PREIMM(insn) (((insn) & 0x3b200c00) == 0x38000c00)
2731 #define AARCH64_LDST_RO(insn) (((insn) & 0x3b200c00) == 0x38200800)
2732 #define AARCH64_LDST_UIMM(insn) (((insn) & 0x3b000000) == 0x39000000)
2733 #define AARCH64_LDST_SIMD_M(insn) (((insn) & 0xbfbf0000) == 0x0c000000)
2734 #define AARCH64_LDST_SIMD_M_PI(insn) (((insn) & 0xbfa00000) == 0x0c800000)
2735 #define AARCH64_LDST_SIMD_S(insn) (((insn) & 0xbf9f0000) == 0x0d000000)
2736 #define AARCH64_LDST_SIMD_S_PI(insn) (((insn) & 0xbf800000) == 0x0d800000)
2737
2738 /* Classify an INSN if it is indeed a load/store.  Return TRUE if INSN
2739    is a load/store along with the Rt and Rtn.  Return FALSE if not a
2740    load/store.  */
2741
2742 static bfd_boolean
2743 aarch64_mem_op_p (uint32_t insn, unsigned int *rt, unsigned int *rtn,
2744                   bfd_boolean *pair, bfd_boolean *load)
2745 {
2746   uint32_t opcode;
2747   unsigned int r;
2748   uint32_t opc = 0;
2749   uint32_t v = 0;
2750   uint32_t opc_v = 0;
2751
2752   /* Bail out quickly if INSN doesn't fall into the the load-store
2753      encoding space.  */
2754   if (!AARCH64_LDST (insn))
2755     return FALSE;
2756
2757   *pair = FALSE;
2758   *load = FALSE;
2759   if (AARCH64_LDST_EX (insn))
2760     {
2761       *rt = AARCH64_RT (insn);
2762       *rtn = *rt;
2763       if (AARCH64_BIT (insn, 21) == 1)
2764         {
2765           *pair = TRUE;
2766           *rtn = AARCH64_RT2 (insn);
2767         }
2768       *load = AARCH64_LD (insn);
2769       return TRUE;
2770     }
2771   else if (AARCH64_LDST_NAP (insn)
2772            || AARCH64_LDSTP_PI (insn)
2773            || AARCH64_LDSTP_O (insn)
2774            || AARCH64_LDSTP_PRE (insn))
2775     {
2776       *pair = TRUE;
2777       *rt = AARCH64_RT (insn);
2778       *rtn = AARCH64_RT2 (insn);
2779       *load = AARCH64_LD (insn);
2780       return TRUE;
2781     }
2782   else if (AARCH64_LDST_PCREL (insn)
2783            || AARCH64_LDST_UI (insn)
2784            || AARCH64_LDST_PIIMM (insn)
2785            || AARCH64_LDST_U (insn)
2786            || AARCH64_LDST_PREIMM (insn)
2787            || AARCH64_LDST_RO (insn)
2788            || AARCH64_LDST_UIMM (insn))
2789    {
2790       *rt = AARCH64_RT (insn);
2791       *rtn = *rt;
2792       if (AARCH64_LDST_PCREL (insn))
2793         *load = TRUE;
2794       opc = AARCH64_BITS (insn, 22, 2);
2795       v = AARCH64_BIT (insn, 26);
2796       opc_v = opc | (v << 2);
2797       *load =  (opc_v == 1 || opc_v == 2 || opc_v == 3
2798                 || opc_v == 5 || opc_v == 7);
2799       return TRUE;
2800    }
2801   else if (AARCH64_LDST_SIMD_M (insn)
2802            || AARCH64_LDST_SIMD_M_PI (insn))
2803     {
2804       *rt = AARCH64_RT (insn);
2805       *load = AARCH64_BIT (insn, 22);
2806       opcode = (insn >> 12) & 0xf;
2807       switch (opcode)
2808         {
2809         case 0:
2810         case 2:
2811           *rtn = *rt + 3;
2812           break;
2813
2814         case 4:
2815         case 6:
2816           *rtn = *rt + 2;
2817           break;
2818
2819         case 7:
2820           *rtn = *rt;
2821           break;
2822
2823         case 8:
2824         case 10:
2825           *rtn = *rt + 1;
2826           break;
2827
2828         default:
2829           return FALSE;
2830         }
2831       return TRUE;
2832     }
2833   else if (AARCH64_LDST_SIMD_S (insn)
2834            || AARCH64_LDST_SIMD_S_PI (insn))
2835     {
2836       *rt = AARCH64_RT (insn);
2837       r = (insn >> 21) & 1;
2838       *load = AARCH64_BIT (insn, 22);
2839       opcode = (insn >> 13) & 0x7;
2840       switch (opcode)
2841         {
2842         case 0:
2843         case 2:
2844         case 4:
2845           *rtn = *rt + r;
2846           break;
2847
2848         case 1:
2849         case 3:
2850         case 5:
2851           *rtn = *rt + (r == 0 ? 2 : 3);
2852           break;
2853
2854         case 6:
2855           *rtn = *rt + r;
2856           break;
2857
2858         case 7:
2859           *rtn = *rt + (r == 0 ? 2 : 3);
2860           break;
2861
2862         default:
2863           return FALSE;
2864         }
2865       return TRUE;
2866     }
2867
2868   return FALSE;
2869 }
2870
2871 /* Return TRUE if INSN is multiply-accumulate.  */
2872
2873 static bfd_boolean
2874 aarch64_mlxl_p (uint32_t insn)
2875 {
2876   uint32_t op31 = AARCH64_OP31 (insn);
2877
2878   if (AARCH64_MAC (insn)
2879       && (op31 == 0 || op31 == 1 || op31 == 5)
2880       /* Exclude MUL instructions which are encoded as a multiple accumulate
2881          with RA = XZR.  */
2882       && AARCH64_RA (insn) != AARCH64_ZR)
2883     return TRUE;
2884
2885   return FALSE;
2886 }
2887
2888 /* Some early revisions of the Cortex-A53 have an erratum (835769) whereby
2889    it is possible for a 64-bit multiply-accumulate instruction to generate an
2890    incorrect result.  The details are quite complex and hard to
2891    determine statically, since branches in the code may exist in some
2892    circumstances, but all cases end with a memory (load, store, or
2893    prefetch) instruction followed immediately by the multiply-accumulate
2894    operation.  We employ a linker patching technique, by moving the potentially
2895    affected multiply-accumulate instruction into a patch region and replacing
2896    the original instruction with a branch to the patch.  This function checks
2897    if INSN_1 is the memory operation followed by a multiply-accumulate
2898    operation (INSN_2).  Return TRUE if an erratum sequence is found, FALSE
2899    if INSN_1 and INSN_2 are safe.  */
2900
2901 static bfd_boolean
2902 aarch64_erratum_sequence (uint32_t insn_1, uint32_t insn_2)
2903 {
2904   uint32_t rt;
2905   uint32_t rtn;
2906   uint32_t rn;
2907   uint32_t rm;
2908   uint32_t ra;
2909   bfd_boolean pair;
2910   bfd_boolean load;
2911
2912   if (aarch64_mlxl_p (insn_2)
2913       && aarch64_mem_op_p (insn_1, &rt, &rtn, &pair, &load))
2914     {
2915       /* Any SIMD memory op is independent of the subsequent MLA
2916          by definition of the erratum.  */
2917       if (AARCH64_BIT (insn_1, 26))
2918         return TRUE;
2919
2920       /* If not SIMD, check for integer memory ops and MLA relationship.  */
2921       rn = AARCH64_RN (insn_2);
2922       ra = AARCH64_RA (insn_2);
2923       rm = AARCH64_RM (insn_2);
2924
2925       /* If this is a load and there's a true(RAW) dependency, we are safe
2926          and this is not an erratum sequence.  */
2927       if (load &&
2928           (rt == rn || rt == rm || rt == ra
2929            || (pair && (rtn == rn || rtn == rm || rtn == ra))))
2930         return FALSE;
2931
2932       /* We conservatively put out stubs for all other cases (including
2933          writebacks).  */
2934       return TRUE;
2935     }
2936
2937   return FALSE;
2938 }
2939
2940 /* Used to order a list of mapping symbols by address.  */
2941
2942 static int
2943 elf_aarch64_compare_mapping (const void *a, const void *b)
2944 {
2945   const elf_aarch64_section_map *amap = (const elf_aarch64_section_map *) a;
2946   const elf_aarch64_section_map *bmap = (const elf_aarch64_section_map *) b;
2947
2948   if (amap->vma > bmap->vma)
2949     return 1;
2950   else if (amap->vma < bmap->vma)
2951     return -1;
2952   else if (amap->type > bmap->type)
2953     /* Ensure results do not depend on the host qsort for objects with
2954        multiple mapping symbols at the same address by sorting on type
2955        after vma.  */
2956     return 1;
2957   else if (amap->type < bmap->type)
2958     return -1;
2959   else
2960     return 0;
2961 }
2962
2963 static bfd_boolean
2964 erratum_835769_scan (bfd *input_bfd,
2965                      struct bfd_link_info *info,
2966                      struct aarch64_erratum_835769_fix **fixes_p,
2967                      unsigned int *num_fixes_p,
2968                      unsigned int *fix_table_size_p)
2969 {
2970   asection *section;
2971   struct elf_aarch64_link_hash_table *htab = elf_aarch64_hash_table (info);
2972   struct aarch64_erratum_835769_fix *fixes = *fixes_p;
2973   unsigned int num_fixes = *num_fixes_p;
2974   unsigned int fix_table_size = *fix_table_size_p;
2975
2976   if (htab == NULL)
2977     return FALSE;
2978
2979   for (section = input_bfd->sections;
2980        section != NULL;
2981        section = section->next)
2982     {
2983       bfd_byte *contents = NULL;
2984       struct _aarch64_elf_section_data *sec_data;
2985       unsigned int span;
2986
2987       if (elf_section_type (section) != SHT_PROGBITS
2988           || (elf_section_flags (section) & SHF_EXECINSTR) == 0
2989           || (section->flags & SEC_EXCLUDE) != 0
2990           || (section->sec_info_type == SEC_INFO_TYPE_JUST_SYMS)
2991           || (section->output_section == bfd_abs_section_ptr))
2992         continue;
2993
2994       if (elf_section_data (section)->this_hdr.contents != NULL)
2995         contents = elf_section_data (section)->this_hdr.contents;
2996       else if (! bfd_malloc_and_get_section (input_bfd, section, &contents))
2997         return TRUE;
2998
2999       sec_data = elf_aarch64_section_data (section);
3000
3001       qsort (sec_data->map, sec_data->mapcount,
3002              sizeof (elf_aarch64_section_map), elf_aarch64_compare_mapping);
3003
3004       for (span = 0; span < sec_data->mapcount; span++)
3005         {
3006           unsigned int span_start = sec_data->map[span].vma;
3007           unsigned int span_end = ((span == sec_data->mapcount - 1)
3008                                    ? sec_data->map[0].vma + section->size
3009                                    : sec_data->map[span + 1].vma);
3010           unsigned int i;
3011           char span_type = sec_data->map[span].type;
3012
3013           if (span_type == 'd')
3014             continue;
3015
3016           for (i = span_start; i + 4 < span_end; i += 4)
3017             {
3018               uint32_t insn_1 = bfd_getl32 (contents + i);
3019               uint32_t insn_2 = bfd_getl32 (contents + i + 4);
3020
3021               if (aarch64_erratum_sequence (insn_1, insn_2))
3022                 {
3023                   char *stub_name = NULL;
3024                   stub_name = (char *) bfd_malloc
3025                                 (strlen ("__erratum_835769_veneer_") + 16);
3026                   if (stub_name != NULL)
3027                     sprintf
3028                       (stub_name,"__erratum_835769_veneer_%d", num_fixes);
3029                   else
3030                     return TRUE;
3031
3032                   if (num_fixes == fix_table_size)
3033                     {
3034                       fix_table_size *= 2;
3035                       fixes =
3036                         (struct aarch64_erratum_835769_fix *)
3037                           bfd_realloc (fixes,
3038                                        sizeof (struct aarch64_erratum_835769_fix)
3039                                          * fix_table_size);
3040                       if (fixes == NULL)
3041                         return TRUE;
3042                     }
3043
3044                   fixes[num_fixes].input_bfd = input_bfd;
3045                   fixes[num_fixes].section = section;
3046                   fixes[num_fixes].offset = i + 4;
3047                   fixes[num_fixes].veneered_insn = insn_2;
3048                   fixes[num_fixes].stub_name = stub_name;
3049                   fixes[num_fixes].stub_type = aarch64_stub_erratum_835769_veneer;
3050                   num_fixes++;
3051                 }
3052             }
3053         }
3054       if (elf_section_data (section)->this_hdr.contents == NULL)
3055         free (contents);
3056     }
3057
3058   *fixes_p = fixes;
3059   *num_fixes_p = num_fixes;
3060   *fix_table_size_p = fix_table_size;
3061   return FALSE;
3062 }
3063
3064 /* Find or create a stub section.  Returns a pointer to the stub section, and
3065    the section to which the stub section will be attached (in *LINK_SEC_P).
3066    LINK_SEC_P may be NULL.  */
3067
3068 static asection *
3069 elf_aarch64_create_or_find_stub_sec (asection **link_sec_p, asection *section,
3070                                    struct elf_aarch64_link_hash_table *htab)
3071 {
3072   asection *link_sec;
3073   asection *stub_sec;
3074
3075   link_sec = htab->stub_group[section->id].link_sec;
3076   BFD_ASSERT (link_sec != NULL);
3077   stub_sec = htab->stub_group[section->id].stub_sec;
3078
3079   if (stub_sec == NULL)
3080     {
3081       stub_sec = htab->stub_group[link_sec->id].stub_sec;
3082       if (stub_sec == NULL)
3083         {
3084           size_t namelen;
3085           bfd_size_type len;
3086           char *s_name;
3087
3088           namelen = strlen (link_sec->name);
3089           len = namelen + sizeof (STUB_SUFFIX);
3090           s_name = (char *) bfd_alloc (htab->stub_bfd, len);
3091           if (s_name == NULL)
3092             return NULL;
3093
3094           memcpy (s_name, link_sec->name, namelen);
3095           memcpy (s_name + namelen, STUB_SUFFIX, sizeof (STUB_SUFFIX));
3096           stub_sec = (*htab->add_stub_section) (s_name, link_sec);
3097
3098           if (stub_sec == NULL)
3099             return NULL;
3100           htab->stub_group[link_sec->id].stub_sec = stub_sec;
3101         }
3102       htab->stub_group[section->id].stub_sec = stub_sec;
3103     }
3104
3105   if (link_sec_p)
3106     *link_sec_p = link_sec;
3107
3108   return stub_sec;
3109 }
3110
3111 /* Determine and set the size of the stub section for a final link.
3112
3113    The basic idea here is to examine all the relocations looking for
3114    PC-relative calls to a target that is unreachable with a "bl"
3115    instruction.  */
3116
3117 bfd_boolean
3118 elfNN_aarch64_size_stubs (bfd *output_bfd,
3119                           bfd *stub_bfd,
3120                           struct bfd_link_info *info,
3121                           bfd_signed_vma group_size,
3122                           asection * (*add_stub_section) (const char *,
3123                                                           asection *),
3124                           void (*layout_sections_again) (void))
3125 {
3126   bfd_size_type stub_group_size;
3127   bfd_boolean stubs_always_before_branch;
3128   bfd_boolean stub_changed = 0;
3129   struct elf_aarch64_link_hash_table *htab = elf_aarch64_hash_table (info);
3130   struct aarch64_erratum_835769_fix *erratum_835769_fixes = NULL;
3131   unsigned int num_erratum_835769_fixes = 0;
3132   unsigned int erratum_835769_fix_table_size = 10;
3133   unsigned int i;
3134
3135   if (htab->fix_erratum_835769)
3136     {
3137       erratum_835769_fixes
3138         = (struct aarch64_erratum_835769_fix *)
3139             bfd_zmalloc
3140               (sizeof (struct aarch64_erratum_835769_fix) *
3141                                         erratum_835769_fix_table_size);
3142       if (erratum_835769_fixes == NULL)
3143         goto error_ret_free_local;
3144     }
3145
3146   /* Propagate mach to stub bfd, because it may not have been
3147      finalized when we created stub_bfd.  */
3148   bfd_set_arch_mach (stub_bfd, bfd_get_arch (output_bfd),
3149                      bfd_get_mach (output_bfd));
3150
3151   /* Stash our params away.  */
3152   htab->stub_bfd = stub_bfd;
3153   htab->add_stub_section = add_stub_section;
3154   htab->layout_sections_again = layout_sections_again;
3155   stubs_always_before_branch = group_size < 0;
3156   if (group_size < 0)
3157     stub_group_size = -group_size;
3158   else
3159     stub_group_size = group_size;
3160
3161   if (stub_group_size == 1)
3162     {
3163       /* Default values.  */
3164       /* AArch64 branch range is +-128MB. The value used is 1MB less.  */
3165       stub_group_size = 127 * 1024 * 1024;
3166     }
3167
3168   group_sections (htab, stub_group_size, stubs_always_before_branch);
3169
3170   while (1)
3171     {
3172       bfd *input_bfd;
3173       unsigned int bfd_indx;
3174       asection *stub_sec;
3175       unsigned prev_num_erratum_835769_fixes = num_erratum_835769_fixes;
3176
3177       num_erratum_835769_fixes = 0;
3178       for (input_bfd = info->input_bfds, bfd_indx = 0;
3179            input_bfd != NULL; input_bfd = input_bfd->link.next, bfd_indx++)
3180         {
3181           Elf_Internal_Shdr *symtab_hdr;
3182           asection *section;
3183           Elf_Internal_Sym *local_syms = NULL;
3184
3185           /* We'll need the symbol table in a second.  */
3186           symtab_hdr = &elf_tdata (input_bfd)->symtab_hdr;
3187           if (symtab_hdr->sh_info == 0)
3188             continue;
3189
3190           /* Walk over each section attached to the input bfd.  */
3191           for (section = input_bfd->sections;
3192                section != NULL; section = section->next)
3193             {
3194               Elf_Internal_Rela *internal_relocs, *irelaend, *irela;
3195
3196               /* If there aren't any relocs, then there's nothing more
3197                  to do.  */
3198               if ((section->flags & SEC_RELOC) == 0
3199                   || section->reloc_count == 0
3200                   || (section->flags & SEC_CODE) == 0)
3201                 continue;
3202
3203               /* If this section is a link-once section that will be
3204                  discarded, then don't create any stubs.  */
3205               if (section->output_section == NULL
3206                   || section->output_section->owner != output_bfd)
3207                 continue;
3208
3209               /* Get the relocs.  */
3210               internal_relocs
3211                 = _bfd_elf_link_read_relocs (input_bfd, section, NULL,
3212                                              NULL, info->keep_memory);
3213               if (internal_relocs == NULL)
3214                 goto error_ret_free_local;
3215
3216               /* Now examine each relocation.  */
3217               irela = internal_relocs;
3218               irelaend = irela + section->reloc_count;
3219               for (; irela < irelaend; irela++)
3220                 {
3221                   unsigned int r_type, r_indx;
3222                   enum elf_aarch64_stub_type stub_type;
3223                   struct elf_aarch64_stub_hash_entry *stub_entry;
3224                   asection *sym_sec;
3225                   bfd_vma sym_value;
3226                   bfd_vma destination;
3227                   struct elf_aarch64_link_hash_entry *hash;
3228                   const char *sym_name;
3229                   char *stub_name;
3230                   const asection *id_sec;
3231                   unsigned char st_type;
3232                   bfd_size_type len;
3233
3234                   r_type = ELFNN_R_TYPE (irela->r_info);
3235                   r_indx = ELFNN_R_SYM (irela->r_info);
3236
3237                   if (r_type >= (unsigned int) R_AARCH64_end)
3238                     {
3239                       bfd_set_error (bfd_error_bad_value);
3240                     error_ret_free_internal:
3241                       if (elf_section_data (section)->relocs == NULL)
3242                         free (internal_relocs);
3243                       goto error_ret_free_local;
3244                     }
3245
3246                   /* Only look for stubs on unconditional branch and
3247                      branch and link instructions.  */
3248                   if (r_type != (unsigned int) AARCH64_R (CALL26)
3249                       && r_type != (unsigned int) AARCH64_R (JUMP26))
3250                     continue;
3251
3252                   /* Now determine the call target, its name, value,
3253                      section.  */
3254                   sym_sec = NULL;
3255                   sym_value = 0;
3256                   destination = 0;
3257                   hash = NULL;
3258                   sym_name = NULL;
3259                   if (r_indx < symtab_hdr->sh_info)
3260                     {
3261                       /* It's a local symbol.  */
3262                       Elf_Internal_Sym *sym;
3263                       Elf_Internal_Shdr *hdr;
3264
3265                       if (local_syms == NULL)
3266                         {
3267                           local_syms
3268                             = (Elf_Internal_Sym *) symtab_hdr->contents;
3269                           if (local_syms == NULL)
3270                             local_syms
3271                               = bfd_elf_get_elf_syms (input_bfd, symtab_hdr,
3272                                                       symtab_hdr->sh_info, 0,
3273                                                       NULL, NULL, NULL);
3274                           if (local_syms == NULL)
3275                             goto error_ret_free_internal;
3276                         }
3277
3278                       sym = local_syms + r_indx;
3279                       hdr = elf_elfsections (input_bfd)[sym->st_shndx];
3280                       sym_sec = hdr->bfd_section;
3281                       if (!sym_sec)
3282                         /* This is an undefined symbol.  It can never
3283                            be resolved.  */
3284                         continue;
3285
3286                       if (ELF_ST_TYPE (sym->st_info) != STT_SECTION)
3287                         sym_value = sym->st_value;
3288                       destination = (sym_value + irela->r_addend
3289                                      + sym_sec->output_offset
3290                                      + sym_sec->output_section->vma);
3291                       st_type = ELF_ST_TYPE (sym->st_info);
3292                       sym_name
3293                         = bfd_elf_string_from_elf_section (input_bfd,
3294                                                            symtab_hdr->sh_link,
3295                                                            sym->st_name);
3296                     }
3297                   else
3298                     {
3299                       int e_indx;
3300
3301                       e_indx = r_indx - symtab_hdr->sh_info;
3302                       hash = ((struct elf_aarch64_link_hash_entry *)
3303                               elf_sym_hashes (input_bfd)[e_indx]);
3304
3305                       while (hash->root.root.type == bfd_link_hash_indirect
3306                              || hash->root.root.type == bfd_link_hash_warning)
3307                         hash = ((struct elf_aarch64_link_hash_entry *)
3308                                 hash->root.root.u.i.link);
3309
3310                       if (hash->root.root.type == bfd_link_hash_defined
3311                           || hash->root.root.type == bfd_link_hash_defweak)
3312                         {
3313                           struct elf_aarch64_link_hash_table *globals =
3314                             elf_aarch64_hash_table (info);
3315                           sym_sec = hash->root.root.u.def.section;
3316                           sym_value = hash->root.root.u.def.value;
3317                           /* For a destination in a shared library,
3318                              use the PLT stub as target address to
3319                              decide whether a branch stub is
3320                              needed.  */
3321                           if (globals->root.splt != NULL && hash != NULL
3322                               && hash->root.plt.offset != (bfd_vma) - 1)
3323                             {
3324                               sym_sec = globals->root.splt;
3325                               sym_value = hash->root.plt.offset;
3326                               if (sym_sec->output_section != NULL)
3327                                 destination = (sym_value
3328                                                + sym_sec->output_offset
3329                                                +
3330                                                sym_sec->output_section->vma);
3331                             }
3332                           else if (sym_sec->output_section != NULL)
3333                             destination = (sym_value + irela->r_addend
3334                                            + sym_sec->output_offset
3335                                            + sym_sec->output_section->vma);
3336                         }
3337                       else if (hash->root.root.type == bfd_link_hash_undefined
3338                                || (hash->root.root.type
3339                                    == bfd_link_hash_undefweak))
3340                         {
3341                           /* For a shared library, use the PLT stub as
3342                              target address to decide whether a long
3343                              branch stub is needed.
3344                              For absolute code, they cannot be handled.  */
3345                           struct elf_aarch64_link_hash_table *globals =
3346                             elf_aarch64_hash_table (info);
3347
3348                           if (globals->root.splt != NULL && hash != NULL
3349                               && hash->root.plt.offset != (bfd_vma) - 1)
3350                             {
3351                               sym_sec = globals->root.splt;
3352                               sym_value = hash->root.plt.offset;
3353                               if (sym_sec->output_section != NULL)
3354                                 destination = (sym_value
3355                                                + sym_sec->output_offset
3356                                                +
3357                                                sym_sec->output_section->vma);
3358                             }
3359                           else
3360                             continue;
3361                         }
3362                       else
3363                         {
3364                           bfd_set_error (bfd_error_bad_value);
3365                           goto error_ret_free_internal;
3366                         }
3367                       st_type = ELF_ST_TYPE (hash->root.type);
3368                       sym_name = hash->root.root.root.string;
3369                     }
3370
3371                   /* Determine what (if any) linker stub is needed.  */
3372                   stub_type = aarch64_type_of_stub
3373                     (info, section, irela, st_type, hash, destination);
3374                   if (stub_type == aarch64_stub_none)
3375                     continue;
3376
3377                   /* Support for grouping stub sections.  */
3378                   id_sec = htab->stub_group[section->id].link_sec;
3379
3380                   /* Get the name of this stub.  */
3381                   stub_name = elfNN_aarch64_stub_name (id_sec, sym_sec, hash,
3382                                                        irela);
3383                   if (!stub_name)
3384                     goto error_ret_free_internal;
3385
3386                   stub_entry =
3387                     aarch64_stub_hash_lookup (&htab->stub_hash_table,
3388                                               stub_name, FALSE, FALSE);
3389                   if (stub_entry != NULL)
3390                     {
3391                       /* The proper stub has already been created.  */
3392                       free (stub_name);
3393                       continue;
3394                     }
3395
3396                   stub_entry = elfNN_aarch64_add_stub (stub_name, section,
3397                                                        htab);
3398                   if (stub_entry == NULL)
3399                     {
3400                       free (stub_name);
3401                       goto error_ret_free_internal;
3402                     }
3403
3404                   stub_entry->target_value = sym_value;
3405                   stub_entry->target_section = sym_sec;
3406                   stub_entry->stub_type = stub_type;
3407                   stub_entry->h = hash;
3408                   stub_entry->st_type = st_type;
3409
3410                   if (sym_name == NULL)
3411                     sym_name = "unnamed";
3412                   len = sizeof (STUB_ENTRY_NAME) + strlen (sym_name);
3413                   stub_entry->output_name = bfd_alloc (htab->stub_bfd, len);
3414                   if (stub_entry->output_name == NULL)
3415                     {
3416                       free (stub_name);
3417                       goto error_ret_free_internal;
3418                     }
3419
3420                   snprintf (stub_entry->output_name, len, STUB_ENTRY_NAME,
3421                             sym_name);
3422
3423                   stub_changed = TRUE;
3424                 }
3425
3426               /* We're done with the internal relocs, free them.  */
3427               if (elf_section_data (section)->relocs == NULL)
3428                 free (internal_relocs);
3429             }
3430
3431           if (htab->fix_erratum_835769)
3432             {
3433               /* Scan for sequences which might trigger erratum 835769.  */
3434               if (erratum_835769_scan (input_bfd, info, &erratum_835769_fixes,
3435                                        &num_erratum_835769_fixes,
3436                                        &erratum_835769_fix_table_size)  != 0)
3437                 goto error_ret_free_local;
3438             }
3439         }
3440
3441       if (prev_num_erratum_835769_fixes != num_erratum_835769_fixes)
3442         stub_changed = TRUE;
3443
3444       if (!stub_changed)
3445         break;
3446
3447       /* OK, we've added some stubs.  Find out the new size of the
3448          stub sections.  */
3449       for (stub_sec = htab->stub_bfd->sections;
3450            stub_sec != NULL; stub_sec = stub_sec->next)
3451         {
3452           /* Ignore non-stub sections.  */
3453           if (!strstr (stub_sec->name, STUB_SUFFIX))
3454             continue;
3455           stub_sec->size = 0;
3456         }
3457
3458       bfd_hash_traverse (&htab->stub_hash_table, aarch64_size_one_stub, htab);
3459
3460       /* Add erratum 835769 veneers to stub section sizes too.  */
3461       if (htab->fix_erratum_835769)
3462         for (i = 0; i < num_erratum_835769_fixes; i++)
3463           {
3464             stub_sec = elf_aarch64_create_or_find_stub_sec (NULL,
3465                          erratum_835769_fixes[i].section, htab);
3466
3467             if (stub_sec == NULL)
3468               goto error_ret_free_local;
3469
3470             stub_sec->size += 8;
3471           }
3472
3473       /* Ask the linker to do its stuff.  */
3474       (*htab->layout_sections_again) ();
3475       stub_changed = FALSE;
3476     }
3477
3478   /* Add stubs for erratum 835769 fixes now.  */
3479   if (htab->fix_erratum_835769)
3480     {
3481       for (i = 0; i < num_erratum_835769_fixes; i++)
3482         {
3483           struct elf_aarch64_stub_hash_entry *stub_entry;
3484           char *stub_name = erratum_835769_fixes[i].stub_name;
3485           asection *section = erratum_835769_fixes[i].section;
3486           unsigned int section_id = erratum_835769_fixes[i].section->id;
3487           asection *link_sec = htab->stub_group[section_id].link_sec;
3488           asection *stub_sec = htab->stub_group[section_id].stub_sec;
3489
3490           stub_entry = aarch64_stub_hash_lookup (&htab->stub_hash_table,
3491                                                  stub_name, TRUE, FALSE);
3492           if (stub_entry == NULL)
3493             {
3494               (*_bfd_error_handler) (_("%s: cannot create stub entry %s"),
3495                                      section->owner,
3496                                      stub_name);
3497               return FALSE;
3498             }
3499
3500           stub_entry->stub_sec = stub_sec;
3501           stub_entry->stub_offset = 0;
3502           stub_entry->id_sec = link_sec;
3503           stub_entry->stub_type = erratum_835769_fixes[i].stub_type;
3504           stub_entry->target_section = section;
3505           stub_entry->target_value = erratum_835769_fixes[i].offset;
3506           stub_entry->veneered_insn = erratum_835769_fixes[i].veneered_insn;
3507           stub_entry->output_name = erratum_835769_fixes[i].stub_name;
3508         }
3509
3510       /* Stash the erratum 835769 fix array for use later in
3511          elfNN_aarch64_write_section().  */
3512       htab->aarch64_erratum_835769_fixes = erratum_835769_fixes;
3513       htab->num_aarch64_erratum_835769_fixes = num_erratum_835769_fixes;
3514     }
3515   else
3516     {
3517       htab->aarch64_erratum_835769_fixes = NULL;
3518       htab->num_aarch64_erratum_835769_fixes = 0;
3519     }
3520
3521   return TRUE;
3522
3523 error_ret_free_local:
3524   return FALSE;
3525 }
3526
3527 /* Build all the stubs associated with the current output file.  The
3528    stubs are kept in a hash table attached to the main linker hash
3529    table.  We also set up the .plt entries for statically linked PIC
3530    functions here.  This function is called via aarch64_elf_finish in the
3531    linker.  */
3532
3533 bfd_boolean
3534 elfNN_aarch64_build_stubs (struct bfd_link_info *info)
3535 {
3536   asection *stub_sec;
3537   struct bfd_hash_table *table;
3538   struct elf_aarch64_link_hash_table *htab;
3539
3540   htab = elf_aarch64_hash_table (info);
3541
3542   for (stub_sec = htab->stub_bfd->sections;
3543        stub_sec != NULL; stub_sec = stub_sec->next)
3544     {
3545       bfd_size_type size;
3546
3547       /* Ignore non-stub sections.  */
3548       if (!strstr (stub_sec->name, STUB_SUFFIX))
3549         continue;
3550
3551       /* Allocate memory to hold the linker stubs.  */
3552       size = stub_sec->size;
3553       stub_sec->contents = bfd_zalloc (htab->stub_bfd, size);
3554       if (stub_sec->contents == NULL && size != 0)
3555         return FALSE;
3556       stub_sec->size = 0;
3557     }
3558
3559   /* Build the stubs as directed by the stub hash table.  */
3560   table = &htab->stub_hash_table;
3561   bfd_hash_traverse (table, aarch64_build_one_stub, info);
3562
3563   return TRUE;
3564 }
3565
3566
3567 /* Add an entry to the code/data map for section SEC.  */
3568
3569 static void
3570 elfNN_aarch64_section_map_add (asection *sec, char type, bfd_vma vma)
3571 {
3572   struct _aarch64_elf_section_data *sec_data =
3573     elf_aarch64_section_data (sec);
3574   unsigned int newidx;
3575
3576   if (sec_data->map == NULL)
3577     {
3578       sec_data->map = bfd_malloc (sizeof (elf_aarch64_section_map));
3579       sec_data->mapcount = 0;
3580       sec_data->mapsize = 1;
3581     }
3582
3583   newidx = sec_data->mapcount++;
3584
3585   if (sec_data->mapcount > sec_data->mapsize)
3586     {
3587       sec_data->mapsize *= 2;
3588       sec_data->map = bfd_realloc_or_free
3589         (sec_data->map, sec_data->mapsize * sizeof (elf_aarch64_section_map));
3590     }
3591
3592   if (sec_data->map)
3593     {
3594       sec_data->map[newidx].vma = vma;
3595       sec_data->map[newidx].type = type;
3596     }
3597 }
3598
3599
3600 /* Initialise maps of insn/data for input BFDs.  */
3601 void
3602 bfd_elfNN_aarch64_init_maps (bfd *abfd)
3603 {
3604   Elf_Internal_Sym *isymbuf;
3605   Elf_Internal_Shdr *hdr;
3606   unsigned int i, localsyms;
3607
3608   /* Make sure that we are dealing with an AArch64 elf binary.  */
3609   if (!is_aarch64_elf (abfd))
3610     return;
3611
3612   if ((abfd->flags & DYNAMIC) != 0)
3613    return;
3614
3615   hdr = &elf_symtab_hdr (abfd);
3616   localsyms = hdr->sh_info;
3617
3618   /* Obtain a buffer full of symbols for this BFD. The hdr->sh_info field
3619      should contain the number of local symbols, which should come before any
3620      global symbols.  Mapping symbols are always local.  */
3621   isymbuf = bfd_elf_get_elf_syms (abfd, hdr, localsyms, 0, NULL, NULL, NULL);
3622
3623   /* No internal symbols read?  Skip this BFD.  */
3624   if (isymbuf == NULL)
3625     return;
3626
3627   for (i = 0; i < localsyms; i++)
3628     {
3629       Elf_Internal_Sym *isym = &isymbuf[i];
3630       asection *sec = bfd_section_from_elf_index (abfd, isym->st_shndx);
3631       const char *name;
3632
3633       if (sec != NULL && ELF_ST_BIND (isym->st_info) == STB_LOCAL)
3634         {
3635           name = bfd_elf_string_from_elf_section (abfd,
3636                                                   hdr->sh_link,
3637                                                   isym->st_name);
3638
3639           if (bfd_is_aarch64_special_symbol_name
3640               (name, BFD_AARCH64_SPECIAL_SYM_TYPE_MAP))
3641             elfNN_aarch64_section_map_add (sec, name[1], isym->st_value);
3642         }
3643     }
3644 }
3645
3646 /* Set option values needed during linking.  */
3647 void
3648 bfd_elfNN_aarch64_set_options (struct bfd *output_bfd,
3649                                struct bfd_link_info *link_info,
3650                                int no_enum_warn,
3651                                int no_wchar_warn, int pic_veneer,
3652                                int fix_erratum_835769)
3653 {
3654   struct elf_aarch64_link_hash_table *globals;
3655
3656   globals = elf_aarch64_hash_table (link_info);
3657   globals->pic_veneer = pic_veneer;
3658   globals->fix_erratum_835769 = fix_erratum_835769;
3659
3660   BFD_ASSERT (is_aarch64_elf (output_bfd));
3661   elf_aarch64_tdata (output_bfd)->no_enum_size_warning = no_enum_warn;
3662   elf_aarch64_tdata (output_bfd)->no_wchar_size_warning = no_wchar_warn;
3663 }
3664
3665 static bfd_vma
3666 aarch64_calculate_got_entry_vma (struct elf_link_hash_entry *h,
3667                                  struct elf_aarch64_link_hash_table
3668                                  *globals, struct bfd_link_info *info,
3669                                  bfd_vma value, bfd *output_bfd,
3670                                  bfd_boolean *unresolved_reloc_p)
3671 {
3672   bfd_vma off = (bfd_vma) - 1;
3673   asection *basegot = globals->root.sgot;
3674   bfd_boolean dyn = globals->root.dynamic_sections_created;
3675
3676   if (h != NULL)
3677     {
3678       BFD_ASSERT (basegot != NULL);
3679       off = h->got.offset;
3680       BFD_ASSERT (off != (bfd_vma) - 1);
3681       if (!WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, info->shared, h)
3682           || (info->shared
3683               && SYMBOL_REFERENCES_LOCAL (info, h))
3684           || (ELF_ST_VISIBILITY (h->other)
3685               && h->root.type == bfd_link_hash_undefweak))
3686         {
3687           /* This is actually a static link, or it is a -Bsymbolic link
3688              and the symbol is defined locally.  We must initialize this
3689              entry in the global offset table.  Since the offset must
3690              always be a multiple of 8 (4 in the case of ILP32), we use
3691              the least significant bit to record whether we have
3692              initialized it already.
3693              When doing a dynamic link, we create a .rel(a).got relocation
3694              entry to initialize the value.  This is done in the
3695              finish_dynamic_symbol routine.  */
3696           if ((off & 1) != 0)
3697             off &= ~1;
3698           else
3699             {
3700               bfd_put_NN (output_bfd, value, basegot->contents + off);
3701               h->got.offset |= 1;
3702             }
3703         }
3704       else
3705         *unresolved_reloc_p = FALSE;
3706
3707       off = off + basegot->output_section->vma + basegot->output_offset;
3708     }
3709
3710   return off;
3711 }
3712
3713 /* Change R_TYPE to a more efficient access model where possible,
3714    return the new reloc type.  */
3715
3716 static bfd_reloc_code_real_type
3717 aarch64_tls_transition_without_check (bfd_reloc_code_real_type r_type,
3718                                       struct elf_link_hash_entry *h)
3719 {
3720   bfd_boolean is_local = h == NULL;
3721
3722   switch (r_type)
3723     {
3724     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3725     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3726       return (is_local
3727               ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1
3728               : BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21);
3729
3730     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3731     case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
3732       return (is_local
3733               ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC
3734               : BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC);
3735
3736     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3737       return is_local ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1 : r_type;
3738
3739     case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
3740       return is_local ? BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC : r_type;
3741
3742     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3743     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3744       /* Instructions with these relocations will become NOPs.  */
3745       return BFD_RELOC_AARCH64_NONE;
3746
3747     default:
3748       break;
3749     }
3750
3751   return r_type;
3752 }
3753
3754 static unsigned int
3755 aarch64_reloc_got_type (bfd_reloc_code_real_type r_type)
3756 {
3757   switch (r_type)
3758     {
3759     case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
3760     case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
3761     case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
3762     case BFD_RELOC_AARCH64_GOT_LD_PREL19:
3763       return GOT_NORMAL;
3764
3765     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
3766     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
3767       return GOT_TLS_GD;
3768
3769     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
3770     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
3771     case BFD_RELOC_AARCH64_TLSDESC_CALL:
3772     case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
3773     case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
3774       return GOT_TLSDESC_GD;
3775
3776     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
3777     case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
3778     case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
3779       return GOT_TLS_IE;
3780
3781     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
3782     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
3783     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
3784     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
3785     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
3786     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
3787     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
3788     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
3789       return GOT_UNKNOWN;
3790
3791     default:
3792       break;
3793     }
3794   return GOT_UNKNOWN;
3795 }
3796
3797 static bfd_boolean
3798 aarch64_can_relax_tls (bfd *input_bfd,
3799                        struct bfd_link_info *info,
3800                        bfd_reloc_code_real_type r_type,
3801                        struct elf_link_hash_entry *h,
3802                        unsigned long r_symndx)
3803 {
3804   unsigned int symbol_got_type;
3805   unsigned int reloc_got_type;
3806
3807   if (! IS_AARCH64_TLS_RELOC (r_type))
3808     return FALSE;
3809
3810   symbol_got_type = elfNN_aarch64_symbol_got_type (h, input_bfd, r_symndx);
3811   reloc_got_type = aarch64_reloc_got_type (r_type);
3812
3813   if (symbol_got_type == GOT_TLS_IE && GOT_TLS_GD_ANY_P (reloc_got_type))
3814     return TRUE;
3815
3816   if (info->shared)
3817     return FALSE;
3818
3819   if  (h && h->root.type == bfd_link_hash_undefweak)
3820     return FALSE;
3821
3822   return TRUE;
3823 }
3824
3825 /* Given the relocation code R_TYPE, return the relaxed bfd reloc
3826    enumerator.  */
3827
3828 static bfd_reloc_code_real_type
3829 aarch64_tls_transition (bfd *input_bfd,
3830                         struct bfd_link_info *info,
3831                         unsigned int r_type,
3832                         struct elf_link_hash_entry *h,
3833                         unsigned long r_symndx)
3834 {
3835   bfd_reloc_code_real_type bfd_r_type
3836     = elfNN_aarch64_bfd_reloc_from_type (r_type);
3837
3838   if (! aarch64_can_relax_tls (input_bfd, info, bfd_r_type, h, r_symndx))
3839     return bfd_r_type;
3840
3841   return aarch64_tls_transition_without_check (bfd_r_type, h);
3842 }
3843
3844 /* Return the base VMA address which should be subtracted from real addresses
3845    when resolving R_AARCH64_TLS_DTPREL relocation.  */
3846
3847 static bfd_vma
3848 dtpoff_base (struct bfd_link_info *info)
3849 {
3850   /* If tls_sec is NULL, we should have signalled an error already.  */
3851   BFD_ASSERT (elf_hash_table (info)->tls_sec != NULL);
3852   return elf_hash_table (info)->tls_sec->vma;
3853 }
3854
3855 /* Return the base VMA address which should be subtracted from real addresses
3856    when resolving R_AARCH64_TLS_GOTTPREL64 relocations.  */
3857
3858 static bfd_vma
3859 tpoff_base (struct bfd_link_info *info)
3860 {
3861   struct elf_link_hash_table *htab = elf_hash_table (info);
3862
3863   /* If tls_sec is NULL, we should have signalled an error already.  */
3864   BFD_ASSERT (htab->tls_sec != NULL);
3865
3866   bfd_vma base = align_power ((bfd_vma) TCB_SIZE,
3867                               htab->tls_sec->alignment_power);
3868   return htab->tls_sec->vma - base;
3869 }
3870
3871 static bfd_vma *
3872 symbol_got_offset_ref (bfd *input_bfd, struct elf_link_hash_entry *h,
3873                        unsigned long r_symndx)
3874 {
3875   /* Calculate the address of the GOT entry for symbol
3876      referred to in h.  */
3877   if (h != NULL)
3878     return &h->got.offset;
3879   else
3880     {
3881       /* local symbol */
3882       struct elf_aarch64_local_symbol *l;
3883
3884       l = elf_aarch64_locals (input_bfd);
3885       return &l[r_symndx].got_offset;
3886     }
3887 }
3888
3889 static void
3890 symbol_got_offset_mark (bfd *input_bfd, struct elf_link_hash_entry *h,
3891                         unsigned long r_symndx)
3892 {
3893   bfd_vma *p;
3894   p = symbol_got_offset_ref (input_bfd, h, r_symndx);
3895   *p |= 1;
3896 }
3897
3898 static int
3899 symbol_got_offset_mark_p (bfd *input_bfd, struct elf_link_hash_entry *h,
3900                           unsigned long r_symndx)
3901 {
3902   bfd_vma value;
3903   value = * symbol_got_offset_ref (input_bfd, h, r_symndx);
3904   return value & 1;
3905 }
3906
3907 static bfd_vma
3908 symbol_got_offset (bfd *input_bfd, struct elf_link_hash_entry *h,
3909                    unsigned long r_symndx)
3910 {
3911   bfd_vma value;
3912   value = * symbol_got_offset_ref (input_bfd, h, r_symndx);
3913   value &= ~1;
3914   return value;
3915 }
3916
3917 static bfd_vma *
3918 symbol_tlsdesc_got_offset_ref (bfd *input_bfd, struct elf_link_hash_entry *h,
3919                                unsigned long r_symndx)
3920 {
3921   /* Calculate the address of the GOT entry for symbol
3922      referred to in h.  */
3923   if (h != NULL)
3924     {
3925       struct elf_aarch64_link_hash_entry *eh;
3926       eh = (struct elf_aarch64_link_hash_entry *) h;
3927       return &eh->tlsdesc_got_jump_table_offset;
3928     }
3929   else
3930     {
3931       /* local symbol */
3932       struct elf_aarch64_local_symbol *l;
3933
3934       l = elf_aarch64_locals (input_bfd);
3935       return &l[r_symndx].tlsdesc_got_jump_table_offset;
3936     }
3937 }
3938
3939 static void
3940 symbol_tlsdesc_got_offset_mark (bfd *input_bfd, struct elf_link_hash_entry *h,
3941                                 unsigned long r_symndx)
3942 {
3943   bfd_vma *p;
3944   p = symbol_tlsdesc_got_offset_ref (input_bfd, h, r_symndx);
3945   *p |= 1;
3946 }
3947
3948 static int
3949 symbol_tlsdesc_got_offset_mark_p (bfd *input_bfd,
3950                                   struct elf_link_hash_entry *h,
3951                                   unsigned long r_symndx)
3952 {
3953   bfd_vma value;
3954   value = * symbol_tlsdesc_got_offset_ref (input_bfd, h, r_symndx);
3955   return value & 1;
3956 }
3957
3958 static bfd_vma
3959 symbol_tlsdesc_got_offset (bfd *input_bfd, struct elf_link_hash_entry *h,
3960                           unsigned long r_symndx)
3961 {
3962   bfd_vma value;
3963   value = * symbol_tlsdesc_got_offset_ref (input_bfd, h, r_symndx);
3964   value &= ~1;
3965   return value;
3966 }
3967
3968 /* Data for make_branch_to_erratum_835769_stub().  */
3969
3970 struct erratum_835769_branch_to_stub_data
3971 {
3972   asection *output_section;
3973   bfd_byte *contents;
3974 };
3975
3976 /* Helper to insert branches to erratum 835769 stubs in the right
3977    places for a particular section.  */
3978
3979 static bfd_boolean
3980 make_branch_to_erratum_835769_stub (struct bfd_hash_entry *gen_entry,
3981                                     void *in_arg)
3982 {
3983   struct elf_aarch64_stub_hash_entry *stub_entry;
3984   struct erratum_835769_branch_to_stub_data *data;
3985   bfd_byte *contents;
3986   unsigned long branch_insn = 0;
3987   bfd_vma veneered_insn_loc, veneer_entry_loc;
3988   bfd_signed_vma branch_offset;
3989   unsigned int target;
3990   bfd *abfd;
3991
3992   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
3993   data = (struct erratum_835769_branch_to_stub_data *) in_arg;
3994
3995   if (stub_entry->target_section != data->output_section
3996       || stub_entry->stub_type != aarch64_stub_erratum_835769_veneer)
3997     return TRUE;
3998
3999   contents = data->contents;
4000   veneered_insn_loc = stub_entry->target_section->output_section->vma
4001                       + stub_entry->target_section->output_offset
4002                       + stub_entry->target_value;
4003   veneer_entry_loc = stub_entry->stub_sec->output_section->vma
4004                      + stub_entry->stub_sec->output_offset
4005                      + stub_entry->stub_offset;
4006   branch_offset = veneer_entry_loc - veneered_insn_loc;
4007
4008   abfd = stub_entry->target_section->owner;
4009   if (!aarch64_valid_branch_p (veneer_entry_loc, veneered_insn_loc))
4010             (*_bfd_error_handler)
4011                 (_("%B: error: Erratum 835769 stub out "
4012                    "of range (input file too large)"), abfd);
4013
4014   target = stub_entry->target_value;
4015   branch_insn = 0x14000000;
4016   branch_offset >>= 2;
4017   branch_offset &= 0x3ffffff;
4018   branch_insn |= branch_offset;
4019   bfd_putl32 (branch_insn, &contents[target]);
4020
4021   return TRUE;
4022 }
4023
4024 static bfd_boolean
4025 elfNN_aarch64_write_section (bfd *output_bfd  ATTRIBUTE_UNUSED,
4026                              struct bfd_link_info *link_info,
4027                              asection *sec,
4028                              bfd_byte *contents)
4029
4030 {
4031   struct elf_aarch64_link_hash_table *globals =
4032                                         elf_aarch64_hash_table (link_info);
4033
4034   if (globals == NULL)
4035     return FALSE;
4036
4037   /* Fix code to point to erratum 835769 stubs.  */
4038   if (globals->fix_erratum_835769)
4039     {
4040       struct erratum_835769_branch_to_stub_data data;
4041
4042       data.output_section = sec;
4043       data.contents = contents;
4044       bfd_hash_traverse (&globals->stub_hash_table,
4045                          make_branch_to_erratum_835769_stub, &data);
4046     }
4047
4048   return FALSE;
4049 }
4050
4051 /* Perform a relocation as part of a final link.  */
4052 static bfd_reloc_status_type
4053 elfNN_aarch64_final_link_relocate (reloc_howto_type *howto,
4054                                    bfd *input_bfd,
4055                                    bfd *output_bfd,
4056                                    asection *input_section,
4057                                    bfd_byte *contents,
4058                                    Elf_Internal_Rela *rel,
4059                                    bfd_vma value,
4060                                    struct bfd_link_info *info,
4061                                    asection *sym_sec,
4062                                    struct elf_link_hash_entry *h,
4063                                    bfd_boolean *unresolved_reloc_p,
4064                                    bfd_boolean save_addend,
4065                                    bfd_vma *saved_addend,
4066                                    Elf_Internal_Sym *sym)
4067 {
4068   Elf_Internal_Shdr *symtab_hdr;
4069   unsigned int r_type = howto->type;
4070   bfd_reloc_code_real_type bfd_r_type
4071     = elfNN_aarch64_bfd_reloc_from_howto (howto);
4072   bfd_reloc_code_real_type new_bfd_r_type;
4073   unsigned long r_symndx;
4074   bfd_byte *hit_data = contents + rel->r_offset;
4075   bfd_vma place;
4076   bfd_signed_vma signed_addend;
4077   struct elf_aarch64_link_hash_table *globals;
4078   bfd_boolean weak_undef_p;
4079
4080   globals = elf_aarch64_hash_table (info);
4081
4082   symtab_hdr = &elf_symtab_hdr (input_bfd);
4083
4084   BFD_ASSERT (is_aarch64_elf (input_bfd));
4085
4086   r_symndx = ELFNN_R_SYM (rel->r_info);
4087
4088   /* It is possible to have linker relaxations on some TLS access
4089      models.  Update our information here.  */
4090   new_bfd_r_type = aarch64_tls_transition (input_bfd, info, r_type, h, r_symndx);
4091   if (new_bfd_r_type != bfd_r_type)
4092     {
4093       bfd_r_type = new_bfd_r_type;
4094       howto = elfNN_aarch64_howto_from_bfd_reloc (bfd_r_type);
4095       BFD_ASSERT (howto != NULL);
4096       r_type = howto->type;
4097     }
4098
4099   place = input_section->output_section->vma
4100     + input_section->output_offset + rel->r_offset;
4101
4102   /* Get addend, accumulating the addend for consecutive relocs
4103      which refer to the same offset.  */
4104   signed_addend = saved_addend ? *saved_addend : 0;
4105   signed_addend += rel->r_addend;
4106
4107   weak_undef_p = (h ? h->root.type == bfd_link_hash_undefweak
4108                   : bfd_is_und_section (sym_sec));
4109
4110   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle
4111      it here if it is defined in a non-shared object.  */
4112   if (h != NULL
4113       && h->type == STT_GNU_IFUNC
4114       && h->def_regular)
4115     {
4116       asection *plt;
4117       const char *name;
4118       asection *base_got;
4119       bfd_vma off;
4120
4121       if ((input_section->flags & SEC_ALLOC) == 0
4122           || h->plt.offset == (bfd_vma) -1)
4123         abort ();
4124
4125       /* STT_GNU_IFUNC symbol must go through PLT.  */
4126       plt = globals->root.splt ? globals->root.splt : globals->root.iplt;
4127       value = (plt->output_section->vma + plt->output_offset + h->plt.offset);
4128
4129       switch (bfd_r_type)
4130         {
4131         default:
4132           if (h->root.root.string)
4133             name = h->root.root.string;
4134           else
4135             name = bfd_elf_sym_name (input_bfd, symtab_hdr, sym,
4136                                      NULL);
4137           (*_bfd_error_handler)
4138             (_("%B: relocation %s against STT_GNU_IFUNC "
4139                "symbol `%s' isn't handled by %s"), input_bfd,
4140              howto->name, name, __FUNCTION__);
4141           bfd_set_error (bfd_error_bad_value);
4142           return FALSE;
4143
4144         case BFD_RELOC_AARCH64_NN:
4145           if (rel->r_addend != 0)
4146             {
4147               if (h->root.root.string)
4148                 name = h->root.root.string;
4149               else
4150                 name = bfd_elf_sym_name (input_bfd, symtab_hdr,
4151                                          sym, NULL);
4152               (*_bfd_error_handler)
4153                 (_("%B: relocation %s against STT_GNU_IFUNC "
4154                    "symbol `%s' has non-zero addend: %d"),
4155                  input_bfd, howto->name, name, rel->r_addend);
4156               bfd_set_error (bfd_error_bad_value);
4157               return FALSE;
4158             }
4159
4160           /* Generate dynamic relocation only when there is a
4161              non-GOT reference in a shared object.  */
4162           if (info->shared && h->non_got_ref)
4163             {
4164               Elf_Internal_Rela outrel;
4165               asection *sreloc;
4166
4167               /* Need a dynamic relocation to get the real function
4168                  address.  */
4169               outrel.r_offset = _bfd_elf_section_offset (output_bfd,
4170                                                          info,
4171                                                          input_section,
4172                                                          rel->r_offset);
4173               if (outrel.r_offset == (bfd_vma) -1
4174                   || outrel.r_offset == (bfd_vma) -2)
4175                 abort ();
4176
4177               outrel.r_offset += (input_section->output_section->vma
4178                                   + input_section->output_offset);
4179
4180               if (h->dynindx == -1
4181                   || h->forced_local
4182                   || info->executable)
4183                 {
4184                   /* This symbol is resolved locally.  */
4185                   outrel.r_info = ELFNN_R_INFO (0, AARCH64_R (IRELATIVE));
4186                   outrel.r_addend = (h->root.u.def.value
4187                                      + h->root.u.def.section->output_section->vma
4188                                      + h->root.u.def.section->output_offset);
4189                 }
4190               else
4191                 {
4192                   outrel.r_info = ELFNN_R_INFO (h->dynindx, r_type);
4193                   outrel.r_addend = 0;
4194                 }
4195
4196               sreloc = globals->root.irelifunc;
4197               elf_append_rela (output_bfd, sreloc, &outrel);
4198
4199               /* If this reloc is against an external symbol, we
4200                  do not want to fiddle with the addend.  Otherwise,
4201                  we need to include the symbol value so that it
4202                  becomes an addend for the dynamic reloc.  For an
4203                  internal symbol, we have updated addend.  */
4204               return bfd_reloc_ok;
4205             }
4206           /* FALLTHROUGH */
4207         case BFD_RELOC_AARCH64_JUMP26:
4208         case BFD_RELOC_AARCH64_CALL26:
4209           value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4210                                                        signed_addend,
4211                                                        weak_undef_p);
4212           return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type,
4213                                               howto, value);
4214         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
4215         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
4216         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
4217         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
4218           base_got = globals->root.sgot;
4219           off = h->got.offset;
4220
4221           if (base_got == NULL)
4222             abort ();
4223
4224           if (off == (bfd_vma) -1)
4225             {
4226               bfd_vma plt_index;
4227
4228               /* We can't use h->got.offset here to save state, or
4229                  even just remember the offset, as finish_dynamic_symbol
4230                  would use that as offset into .got.  */
4231
4232               if (globals->root.splt != NULL)
4233                 {
4234                   plt_index = ((h->plt.offset - globals->plt_header_size) /
4235                                globals->plt_entry_size);
4236                   off = (plt_index + 3) * GOT_ENTRY_SIZE;
4237                   base_got = globals->root.sgotplt;
4238                 }
4239               else
4240                 {
4241                   plt_index = h->plt.offset / globals->plt_entry_size;
4242                   off = plt_index * GOT_ENTRY_SIZE;
4243                   base_got = globals->root.igotplt;
4244                 }
4245
4246               if (h->dynindx == -1
4247                   || h->forced_local
4248                   || info->symbolic)
4249                 {
4250                   /* This references the local definition.  We must
4251                      initialize this entry in the global offset table.
4252                      Since the offset must always be a multiple of 8,
4253                      we use the least significant bit to record
4254                      whether we have initialized it already.
4255
4256                      When doing a dynamic link, we create a .rela.got
4257                      relocation entry to initialize the value.  This
4258                      is done in the finish_dynamic_symbol routine.       */
4259                   if ((off & 1) != 0)
4260                     off &= ~1;
4261                   else
4262                     {
4263                       bfd_put_NN (output_bfd, value,
4264                                   base_got->contents + off);
4265                       /* Note that this is harmless as -1 | 1 still is -1.  */
4266                       h->got.offset |= 1;
4267                     }
4268                 }
4269               value = (base_got->output_section->vma
4270                        + base_got->output_offset + off);
4271             }
4272           else
4273             value = aarch64_calculate_got_entry_vma (h, globals, info,
4274                                                      value, output_bfd,
4275                                                      unresolved_reloc_p);
4276           value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4277                                                        0, weak_undef_p);
4278           return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type, howto, value);
4279         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
4280         case BFD_RELOC_AARCH64_ADD_LO12:
4281           break;
4282         }
4283     }
4284
4285   switch (bfd_r_type)
4286     {
4287     case BFD_RELOC_AARCH64_NONE:
4288     case BFD_RELOC_AARCH64_TLSDESC_CALL:
4289       *unresolved_reloc_p = FALSE;
4290       return bfd_reloc_ok;
4291
4292     case BFD_RELOC_AARCH64_NN:
4293
4294       /* When generating a shared object or relocatable executable, these
4295          relocations are copied into the output file to be resolved at
4296          run time.  */
4297       if (((info->shared == TRUE) || globals->root.is_relocatable_executable)
4298           && (input_section->flags & SEC_ALLOC)
4299           && (h == NULL
4300               || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4301               || h->root.type != bfd_link_hash_undefweak))
4302         {
4303           Elf_Internal_Rela outrel;
4304           bfd_byte *loc;
4305           bfd_boolean skip, relocate;
4306           asection *sreloc;
4307
4308           *unresolved_reloc_p = FALSE;
4309
4310           skip = FALSE;
4311           relocate = FALSE;
4312
4313           outrel.r_addend = signed_addend;
4314           outrel.r_offset =
4315             _bfd_elf_section_offset (output_bfd, info, input_section,
4316                                      rel->r_offset);
4317           if (outrel.r_offset == (bfd_vma) - 1)
4318             skip = TRUE;
4319           else if (outrel.r_offset == (bfd_vma) - 2)
4320             {
4321               skip = TRUE;
4322               relocate = TRUE;
4323             }
4324
4325           outrel.r_offset += (input_section->output_section->vma
4326                               + input_section->output_offset);
4327
4328           if (skip)
4329             memset (&outrel, 0, sizeof outrel);
4330           else if (h != NULL
4331                    && h->dynindx != -1
4332                    && (!info->shared || !info->symbolic || !h->def_regular))
4333             outrel.r_info = ELFNN_R_INFO (h->dynindx, r_type);
4334           else
4335             {
4336               int symbol;
4337
4338               /* On SVR4-ish systems, the dynamic loader cannot
4339                  relocate the text and data segments independently,
4340                  so the symbol does not matter.  */
4341               symbol = 0;
4342               outrel.r_info = ELFNN_R_INFO (symbol, AARCH64_R (RELATIVE));
4343               outrel.r_addend += value;
4344             }
4345
4346           sreloc = elf_section_data (input_section)->sreloc;
4347           if (sreloc == NULL || sreloc->contents == NULL)
4348             return bfd_reloc_notsupported;
4349
4350           loc = sreloc->contents + sreloc->reloc_count++ * RELOC_SIZE (globals);
4351           bfd_elfNN_swap_reloca_out (output_bfd, &outrel, loc);
4352
4353           if (sreloc->reloc_count * RELOC_SIZE (globals) > sreloc->size)
4354             {
4355               /* Sanity to check that we have previously allocated
4356                  sufficient space in the relocation section for the
4357                  number of relocations we actually want to emit.  */
4358               abort ();
4359             }
4360
4361           /* If this reloc is against an external symbol, we do not want to
4362              fiddle with the addend.  Otherwise, we need to include the symbol
4363              value so that it becomes an addend for the dynamic reloc.  */
4364           if (!relocate)
4365             return bfd_reloc_ok;
4366
4367           return _bfd_final_link_relocate (howto, input_bfd, input_section,
4368                                            contents, rel->r_offset, value,
4369                                            signed_addend);
4370         }
4371       else
4372         value += signed_addend;
4373       break;
4374
4375     case BFD_RELOC_AARCH64_JUMP26:
4376     case BFD_RELOC_AARCH64_CALL26:
4377       {
4378         asection *splt = globals->root.splt;
4379         bfd_boolean via_plt_p =
4380           splt != NULL && h != NULL && h->plt.offset != (bfd_vma) - 1;
4381
4382         /* A call to an undefined weak symbol is converted to a jump to
4383            the next instruction unless a PLT entry will be created.
4384            The jump to the next instruction is optimized as a NOP.
4385            Do the same for local undefined symbols.  */
4386         if (weak_undef_p && ! via_plt_p)
4387           {
4388             bfd_putl32 (INSN_NOP, hit_data);
4389             return bfd_reloc_ok;
4390           }
4391
4392         /* If the call goes through a PLT entry, make sure to
4393            check distance to the right destination address.  */
4394         if (via_plt_p)
4395           {
4396             value = (splt->output_section->vma
4397                      + splt->output_offset + h->plt.offset);
4398             *unresolved_reloc_p = FALSE;
4399           }
4400
4401         /* If the target symbol is global and marked as a function the
4402            relocation applies a function call or a tail call.  In this
4403            situation we can veneer out of range branches.  The veneers
4404            use IP0 and IP1 hence cannot be used arbitrary out of range
4405            branches that occur within the body of a function.  */
4406         if (h && h->type == STT_FUNC)
4407           {
4408             /* Check if a stub has to be inserted because the destination
4409                is too far away.  */
4410             if (! aarch64_valid_branch_p (value, place))
4411               {
4412                 /* The target is out of reach, so redirect the branch to
4413                    the local stub for this function.  */
4414                 struct elf_aarch64_stub_hash_entry *stub_entry;
4415                 stub_entry = elfNN_aarch64_get_stub_entry (input_section,
4416                                                            sym_sec, h,
4417                                                            rel, globals);
4418                 if (stub_entry != NULL)
4419                   value = (stub_entry->stub_offset
4420                            + stub_entry->stub_sec->output_offset
4421                            + stub_entry->stub_sec->output_section->vma);
4422               }
4423           }
4424       }
4425       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4426                                                    signed_addend, weak_undef_p);
4427       break;
4428
4429     case BFD_RELOC_AARCH64_16:
4430 #if ARCH_SIZE == 64
4431     case BFD_RELOC_AARCH64_32:
4432 #endif
4433     case BFD_RELOC_AARCH64_ADD_LO12:
4434     case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
4435     case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
4436     case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
4437     case BFD_RELOC_AARCH64_BRANCH19:
4438     case BFD_RELOC_AARCH64_LD_LO19_PCREL:
4439     case BFD_RELOC_AARCH64_LDST8_LO12:
4440     case BFD_RELOC_AARCH64_LDST16_LO12:
4441     case BFD_RELOC_AARCH64_LDST32_LO12:
4442     case BFD_RELOC_AARCH64_LDST64_LO12:
4443     case BFD_RELOC_AARCH64_LDST128_LO12:
4444     case BFD_RELOC_AARCH64_MOVW_G0_S:
4445     case BFD_RELOC_AARCH64_MOVW_G1_S:
4446     case BFD_RELOC_AARCH64_MOVW_G2_S:
4447     case BFD_RELOC_AARCH64_MOVW_G0:
4448     case BFD_RELOC_AARCH64_MOVW_G0_NC:
4449     case BFD_RELOC_AARCH64_MOVW_G1:
4450     case BFD_RELOC_AARCH64_MOVW_G1_NC:
4451     case BFD_RELOC_AARCH64_MOVW_G2:
4452     case BFD_RELOC_AARCH64_MOVW_G2_NC:
4453     case BFD_RELOC_AARCH64_MOVW_G3:
4454     case BFD_RELOC_AARCH64_16_PCREL:
4455     case BFD_RELOC_AARCH64_32_PCREL:
4456     case BFD_RELOC_AARCH64_64_PCREL:
4457     case BFD_RELOC_AARCH64_TSTBR14:
4458       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4459                                                    signed_addend, weak_undef_p);
4460       break;
4461
4462     case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
4463     case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
4464     case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
4465     case BFD_RELOC_AARCH64_GOT_LD_PREL19:
4466       if (globals->root.sgot == NULL)
4467         BFD_ASSERT (h != NULL);
4468
4469       if (h != NULL)
4470         {
4471           value = aarch64_calculate_got_entry_vma (h, globals, info, value,
4472                                                    output_bfd,
4473                                                    unresolved_reloc_p);
4474           value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4475                                                        0, weak_undef_p);
4476         }
4477       break;
4478
4479     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4480     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4481     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4482     case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
4483     case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
4484       if (globals->root.sgot == NULL)
4485         return bfd_reloc_notsupported;
4486
4487       value = (symbol_got_offset (input_bfd, h, r_symndx)
4488                + globals->root.sgot->output_section->vma
4489                + globals->root.sgot->output_offset);
4490
4491       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4492                                                    0, weak_undef_p);
4493       *unresolved_reloc_p = FALSE;
4494       break;
4495
4496     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
4497     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
4498     case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
4499     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
4500     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
4501     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
4502     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
4503     case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
4504       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4505                                                    signed_addend - tpoff_base (info),
4506                                                    weak_undef_p);
4507       *unresolved_reloc_p = FALSE;
4508       break;
4509
4510     case BFD_RELOC_AARCH64_TLSDESC_ADD:
4511     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4512     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
4513     case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
4514     case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
4515     case BFD_RELOC_AARCH64_TLSDESC_LDR:
4516       if (globals->root.sgot == NULL)
4517         return bfd_reloc_notsupported;
4518       value = (symbol_tlsdesc_got_offset (input_bfd, h, r_symndx)
4519                + globals->root.sgotplt->output_section->vma
4520                + globals->root.sgotplt->output_offset
4521                + globals->sgotplt_jump_table_size);
4522
4523       value = _bfd_aarch64_elf_resolve_relocation (bfd_r_type, place, value,
4524                                                    0, weak_undef_p);
4525       *unresolved_reloc_p = FALSE;
4526       break;
4527
4528     default:
4529       return bfd_reloc_notsupported;
4530     }
4531
4532   if (saved_addend)
4533     *saved_addend = value;
4534
4535   /* Only apply the final relocation in a sequence.  */
4536   if (save_addend)
4537     return bfd_reloc_continue;
4538
4539   return _bfd_aarch64_elf_put_addend (input_bfd, hit_data, bfd_r_type,
4540                                       howto, value);
4541 }
4542
4543 /* Handle TLS relaxations.  Relaxing is possible for symbols that use
4544    R_AARCH64_TLSDESC_ADR_{PAGE, LD64_LO12_NC, ADD_LO12_NC} during a static
4545    link.
4546
4547    Return bfd_reloc_ok if we're done, bfd_reloc_continue if the caller
4548    is to then call final_link_relocate.  Return other values in the
4549    case of error.  */
4550
4551 static bfd_reloc_status_type
4552 elfNN_aarch64_tls_relax (struct elf_aarch64_link_hash_table *globals,
4553                          bfd *input_bfd, bfd_byte *contents,
4554                          Elf_Internal_Rela *rel, struct elf_link_hash_entry *h)
4555 {
4556   bfd_boolean is_local = h == NULL;
4557   unsigned int r_type = ELFNN_R_TYPE (rel->r_info);
4558   unsigned long insn;
4559
4560   BFD_ASSERT (globals && input_bfd && contents && rel);
4561
4562   switch (elfNN_aarch64_bfd_reloc_from_type (r_type))
4563     {
4564     case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4565     case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
4566       if (is_local)
4567         {
4568           /* GD->LE relaxation:
4569              adrp x0, :tlsgd:var     =>   movz x0, :tprel_g1:var
4570              or
4571              adrp x0, :tlsdesc:var   =>   movz x0, :tprel_g1:var
4572            */
4573           bfd_putl32 (0xd2a00000, contents + rel->r_offset);
4574           return bfd_reloc_continue;
4575         }
4576       else
4577         {
4578           /* GD->IE relaxation:
4579              adrp x0, :tlsgd:var     =>   adrp x0, :gottprel:var
4580              or
4581              adrp x0, :tlsdesc:var   =>   adrp x0, :gottprel:var
4582            */
4583           return bfd_reloc_continue;
4584         }
4585
4586     case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
4587       if (is_local)
4588         {
4589           /* GD->LE relaxation:
4590              ldr xd, [x0, #:tlsdesc_lo12:var]   =>   movk x0, :tprel_g0_nc:var
4591            */
4592           bfd_putl32 (0xf2800000, contents + rel->r_offset);
4593           return bfd_reloc_continue;
4594         }
4595       else
4596         {
4597           /* GD->IE relaxation:
4598              ldr xd, [x0, #:tlsdesc_lo12:var] => ldr x0, [x0, #:gottprel_lo12:var]
4599            */
4600           insn = bfd_getl32 (contents + rel->r_offset);
4601           insn &= 0xffffffe0;
4602           bfd_putl32 (insn, contents + rel->r_offset);
4603           return bfd_reloc_continue;
4604         }
4605
4606     case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4607       if (is_local)
4608         {
4609           /* GD->LE relaxation
4610              add  x0, #:tlsgd_lo12:var  => movk x0, :tprel_g0_nc:var
4611              bl   __tls_get_addr        => mrs  x1, tpidr_el0
4612              nop                        => add  x0, x1, x0
4613            */
4614
4615           /* First kill the tls_get_addr reloc on the bl instruction.  */
4616           BFD_ASSERT (rel->r_offset + 4 == rel[1].r_offset);
4617           rel[1].r_info = ELFNN_R_INFO (STN_UNDEF, R_AARCH64_NONE);
4618
4619           bfd_putl32 (0xf2800000, contents + rel->r_offset);
4620           bfd_putl32 (0xd53bd041, contents + rel->r_offset + 4);
4621           bfd_putl32 (0x8b000020, contents + rel->r_offset + 8);
4622           return bfd_reloc_continue;
4623         }
4624       else
4625         {
4626           /* GD->IE relaxation
4627              ADD  x0, #:tlsgd_lo12:var  => ldr  x0, [x0, #:gottprel_lo12:var]
4628              BL   __tls_get_addr        => mrs  x1, tpidr_el0
4629                R_AARCH64_CALL26
4630              NOP                        => add  x0, x1, x0
4631            */
4632
4633           BFD_ASSERT (ELFNN_R_TYPE (rel[1].r_info) == AARCH64_R (CALL26));
4634
4635           /* Remove the relocation on the BL instruction.  */
4636           rel[1].r_info = ELFNN_R_INFO (STN_UNDEF, R_AARCH64_NONE);
4637
4638           bfd_putl32 (0xf9400000, contents + rel->r_offset);
4639
4640           /* We choose to fixup the BL and NOP instructions using the
4641              offset from the second relocation to allow flexibility in
4642              scheduling instructions between the ADD and BL.  */
4643           bfd_putl32 (0xd53bd041, contents + rel[1].r_offset);
4644           bfd_putl32 (0x8b000020, contents + rel[1].r_offset + 4);
4645           return bfd_reloc_continue;
4646         }
4647
4648     case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
4649     case BFD_RELOC_AARCH64_TLSDESC_CALL:
4650       /* GD->IE/LE relaxation:
4651          add x0, x0, #:tlsdesc_lo12:var   =>   nop
4652          blr xd                           =>   nop
4653        */
4654       bfd_putl32 (INSN_NOP, contents + rel->r_offset);
4655       return bfd_reloc_ok;
4656
4657     case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4658       /* IE->LE relaxation:
4659          adrp xd, :gottprel:var   =>   movz xd, :tprel_g1:var
4660        */
4661       if (is_local)
4662         {
4663           insn = bfd_getl32 (contents + rel->r_offset);
4664           bfd_putl32 (0xd2a00000 | (insn & 0x1f), contents + rel->r_offset);
4665         }
4666       return bfd_reloc_continue;
4667
4668     case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
4669       /* IE->LE relaxation:
4670          ldr  xd, [xm, #:gottprel_lo12:var]   =>   movk xd, :tprel_g0_nc:var
4671        */
4672       if (is_local)
4673         {
4674           insn = bfd_getl32 (contents + rel->r_offset);
4675           bfd_putl32 (0xf2800000 | (insn & 0x1f), contents + rel->r_offset);
4676         }
4677       return bfd_reloc_continue;
4678
4679     default:
4680       return bfd_reloc_continue;
4681     }
4682
4683   return bfd_reloc_ok;
4684 }
4685
4686 /* Relocate an AArch64 ELF section.  */
4687
4688 static bfd_boolean
4689 elfNN_aarch64_relocate_section (bfd *output_bfd,
4690                                 struct bfd_link_info *info,
4691                                 bfd *input_bfd,
4692                                 asection *input_section,
4693                                 bfd_byte *contents,
4694                                 Elf_Internal_Rela *relocs,
4695                                 Elf_Internal_Sym *local_syms,
4696                                 asection **local_sections)
4697 {
4698   Elf_Internal_Shdr *symtab_hdr;
4699   struct elf_link_hash_entry **sym_hashes;
4700   Elf_Internal_Rela *rel;
4701   Elf_Internal_Rela *relend;
4702   const char *name;
4703   struct elf_aarch64_link_hash_table *globals;
4704   bfd_boolean save_addend = FALSE;
4705   bfd_vma addend = 0;
4706
4707   globals = elf_aarch64_hash_table (info);
4708
4709   symtab_hdr = &elf_symtab_hdr (input_bfd);
4710   sym_hashes = elf_sym_hashes (input_bfd);
4711
4712   rel = relocs;
4713   relend = relocs + input_section->reloc_count;
4714   for (; rel < relend; rel++)
4715     {
4716       unsigned int r_type;
4717       bfd_reloc_code_real_type bfd_r_type;
4718       bfd_reloc_code_real_type relaxed_bfd_r_type;
4719       reloc_howto_type *howto;
4720       unsigned long r_symndx;
4721       Elf_Internal_Sym *sym;
4722       asection *sec;
4723       struct elf_link_hash_entry *h;
4724       bfd_vma relocation;
4725       bfd_reloc_status_type r;
4726       arelent bfd_reloc;
4727       char sym_type;
4728       bfd_boolean unresolved_reloc = FALSE;
4729       char *error_message = NULL;
4730
4731       r_symndx = ELFNN_R_SYM (rel->r_info);
4732       r_type = ELFNN_R_TYPE (rel->r_info);
4733
4734       bfd_reloc.howto = elfNN_aarch64_howto_from_type (r_type);
4735       howto = bfd_reloc.howto;
4736
4737       if (howto == NULL)
4738         {
4739           (*_bfd_error_handler)
4740             (_("%B: unrecognized relocation (0x%x) in section `%A'"),
4741              input_bfd, input_section, r_type);
4742           return FALSE;
4743         }
4744       bfd_r_type = elfNN_aarch64_bfd_reloc_from_howto (howto);
4745
4746       h = NULL;
4747       sym = NULL;
4748       sec = NULL;
4749
4750       if (r_symndx < symtab_hdr->sh_info)
4751         {
4752           sym = local_syms + r_symndx;
4753           sym_type = ELFNN_ST_TYPE (sym->st_info);
4754           sec = local_sections[r_symndx];
4755
4756           /* An object file might have a reference to a local
4757              undefined symbol.  This is a daft object file, but we
4758              should at least do something about it.  */
4759           if (r_type != R_AARCH64_NONE && r_type != R_AARCH64_NULL
4760               && bfd_is_und_section (sec)
4761               && ELF_ST_BIND (sym->st_info) != STB_WEAK)
4762             {
4763               if (!info->callbacks->undefined_symbol
4764                   (info, bfd_elf_string_from_elf_section
4765                    (input_bfd, symtab_hdr->sh_link, sym->st_name),
4766                    input_bfd, input_section, rel->r_offset, TRUE))
4767                 return FALSE;
4768             }
4769
4770           relocation = _bfd_elf_rela_local_sym (output_bfd, sym, &sec, rel);
4771
4772           /* Relocate against local STT_GNU_IFUNC symbol.  */
4773           if (!info->relocatable
4774               && ELF_ST_TYPE (sym->st_info) == STT_GNU_IFUNC)
4775             {
4776               h = elfNN_aarch64_get_local_sym_hash (globals, input_bfd,
4777                                                     rel, FALSE);
4778               if (h == NULL)
4779                 abort ();
4780
4781               /* Set STT_GNU_IFUNC symbol value.  */
4782               h->root.u.def.value = sym->st_value;
4783               h->root.u.def.section = sec;
4784             }
4785         }
4786       else
4787         {
4788           bfd_boolean warned, ignored;
4789
4790           RELOC_FOR_GLOBAL_SYMBOL (info, input_bfd, input_section, rel,
4791                                    r_symndx, symtab_hdr, sym_hashes,
4792                                    h, sec, relocation,
4793                                    unresolved_reloc, warned, ignored);
4794
4795           sym_type = h->type;
4796         }
4797
4798       if (sec != NULL && discarded_section (sec))
4799         RELOC_AGAINST_DISCARDED_SECTION (info, input_bfd, input_section,
4800                                          rel, 1, relend, howto, 0, contents);
4801
4802       if (info->relocatable)
4803         continue;
4804
4805       if (h != NULL)
4806         name = h->root.root.string;
4807       else
4808         {
4809           name = (bfd_elf_string_from_elf_section
4810                   (input_bfd, symtab_hdr->sh_link, sym->st_name));
4811           if (name == NULL || *name == '\0')
4812             name = bfd_section_name (input_bfd, sec);
4813         }
4814
4815       if (r_symndx != 0
4816           && r_type != R_AARCH64_NONE
4817           && r_type != R_AARCH64_NULL
4818           && (h == NULL
4819               || h->root.type == bfd_link_hash_defined
4820               || h->root.type == bfd_link_hash_defweak)
4821           && IS_AARCH64_TLS_RELOC (bfd_r_type) != (sym_type == STT_TLS))
4822         {
4823           (*_bfd_error_handler)
4824             ((sym_type == STT_TLS
4825               ? _("%B(%A+0x%lx): %s used with TLS symbol %s")
4826               : _("%B(%A+0x%lx): %s used with non-TLS symbol %s")),
4827              input_bfd,
4828              input_section, (long) rel->r_offset, howto->name, name);
4829         }
4830
4831       /* We relax only if we can see that there can be a valid transition
4832          from a reloc type to another.
4833          We call elfNN_aarch64_final_link_relocate unless we're completely
4834          done, i.e., the relaxation produced the final output we want.  */
4835
4836       relaxed_bfd_r_type = aarch64_tls_transition (input_bfd, info, r_type,
4837                                                    h, r_symndx);
4838       if (relaxed_bfd_r_type != bfd_r_type)
4839         {
4840           bfd_r_type = relaxed_bfd_r_type;
4841           howto = elfNN_aarch64_howto_from_bfd_reloc (bfd_r_type);
4842           BFD_ASSERT (howto != NULL);
4843           r_type = howto->type;
4844           r = elfNN_aarch64_tls_relax (globals, input_bfd, contents, rel, h);
4845           unresolved_reloc = 0;
4846         }
4847       else
4848         r = bfd_reloc_continue;
4849
4850       /* There may be multiple consecutive relocations for the
4851          same offset.  In that case we are supposed to treat the
4852          output of each relocation as the addend for the next.  */
4853       if (rel + 1 < relend
4854           && rel->r_offset == rel[1].r_offset
4855           && ELFNN_R_TYPE (rel[1].r_info) != R_AARCH64_NONE
4856           && ELFNN_R_TYPE (rel[1].r_info) != R_AARCH64_NULL)
4857         save_addend = TRUE;
4858       else
4859         save_addend = FALSE;
4860
4861       if (r == bfd_reloc_continue)
4862         r = elfNN_aarch64_final_link_relocate (howto, input_bfd, output_bfd,
4863                                                input_section, contents, rel,
4864                                                relocation, info, sec,
4865                                                h, &unresolved_reloc,
4866                                                save_addend, &addend, sym);
4867
4868       switch (elfNN_aarch64_bfd_reloc_from_type (r_type))
4869         {
4870         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
4871         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
4872           if (! symbol_got_offset_mark_p (input_bfd, h, r_symndx))
4873             {
4874               bfd_boolean need_relocs = FALSE;
4875               bfd_byte *loc;
4876               int indx;
4877               bfd_vma off;
4878
4879               off = symbol_got_offset (input_bfd, h, r_symndx);
4880               indx = h && h->dynindx != -1 ? h->dynindx : 0;
4881
4882               need_relocs =
4883                 (info->shared || indx != 0) &&
4884                 (h == NULL
4885                  || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4886                  || h->root.type != bfd_link_hash_undefweak);
4887
4888               BFD_ASSERT (globals->root.srelgot != NULL);
4889
4890               if (need_relocs)
4891                 {
4892                   Elf_Internal_Rela rela;
4893                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLS_DTPMOD));
4894                   rela.r_addend = 0;
4895                   rela.r_offset = globals->root.sgot->output_section->vma +
4896                     globals->root.sgot->output_offset + off;
4897
4898
4899                   loc = globals->root.srelgot->contents;
4900                   loc += globals->root.srelgot->reloc_count++
4901                     * RELOC_SIZE (htab);
4902                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4903
4904                   if (indx == 0)
4905                     {
4906                       bfd_put_NN (output_bfd,
4907                                   relocation - dtpoff_base (info),
4908                                   globals->root.sgot->contents + off
4909                                   + GOT_ENTRY_SIZE);
4910                     }
4911                   else
4912                     {
4913                       /* This TLS symbol is global. We emit a
4914                          relocation to fixup the tls offset at load
4915                          time.  */
4916                       rela.r_info =
4917                         ELFNN_R_INFO (indx, AARCH64_R (TLS_DTPREL));
4918                       rela.r_addend = 0;
4919                       rela.r_offset =
4920                         (globals->root.sgot->output_section->vma
4921                          + globals->root.sgot->output_offset + off
4922                          + GOT_ENTRY_SIZE);
4923
4924                       loc = globals->root.srelgot->contents;
4925                       loc += globals->root.srelgot->reloc_count++
4926                         * RELOC_SIZE (globals);
4927                       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4928                       bfd_put_NN (output_bfd, (bfd_vma) 0,
4929                                   globals->root.sgot->contents + off
4930                                   + GOT_ENTRY_SIZE);
4931                     }
4932                 }
4933               else
4934                 {
4935                   bfd_put_NN (output_bfd, (bfd_vma) 1,
4936                               globals->root.sgot->contents + off);
4937                   bfd_put_NN (output_bfd,
4938                               relocation - dtpoff_base (info),
4939                               globals->root.sgot->contents + off
4940                               + GOT_ENTRY_SIZE);
4941                 }
4942
4943               symbol_got_offset_mark (input_bfd, h, r_symndx);
4944             }
4945           break;
4946
4947         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
4948         case BFD_RELOC_AARCH64_TLSIE_LDNN_GOTTPREL_LO12_NC:
4949           if (! symbol_got_offset_mark_p (input_bfd, h, r_symndx))
4950             {
4951               bfd_boolean need_relocs = FALSE;
4952               bfd_byte *loc;
4953               int indx;
4954               bfd_vma off;
4955
4956               off = symbol_got_offset (input_bfd, h, r_symndx);
4957
4958               indx = h && h->dynindx != -1 ? h->dynindx : 0;
4959
4960               need_relocs =
4961                 (info->shared || indx != 0) &&
4962                 (h == NULL
4963                  || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
4964                  || h->root.type != bfd_link_hash_undefweak);
4965
4966               BFD_ASSERT (globals->root.srelgot != NULL);
4967
4968               if (need_relocs)
4969                 {
4970                   Elf_Internal_Rela rela;
4971
4972                   if (indx == 0)
4973                     rela.r_addend = relocation - dtpoff_base (info);
4974                   else
4975                     rela.r_addend = 0;
4976
4977                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLS_TPREL));
4978                   rela.r_offset = globals->root.sgot->output_section->vma +
4979                     globals->root.sgot->output_offset + off;
4980
4981                   loc = globals->root.srelgot->contents;
4982                   loc += globals->root.srelgot->reloc_count++
4983                     * RELOC_SIZE (htab);
4984
4985                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
4986
4987                   bfd_put_NN (output_bfd, rela.r_addend,
4988                               globals->root.sgot->contents + off);
4989                 }
4990               else
4991                 bfd_put_NN (output_bfd, relocation - tpoff_base (info),
4992                             globals->root.sgot->contents + off);
4993
4994               symbol_got_offset_mark (input_bfd, h, r_symndx);
4995             }
4996           break;
4997
4998         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
4999         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
5000         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
5001         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
5002         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
5003         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
5004         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
5005         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
5006           break;
5007
5008         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
5009         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
5010         case BFD_RELOC_AARCH64_TLSDESC_LDNN_LO12_NC:
5011           if (! symbol_tlsdesc_got_offset_mark_p (input_bfd, h, r_symndx))
5012             {
5013               bfd_boolean need_relocs = FALSE;
5014               int indx = h && h->dynindx != -1 ? h->dynindx : 0;
5015               bfd_vma off = symbol_tlsdesc_got_offset (input_bfd, h, r_symndx);
5016
5017               need_relocs = (h == NULL
5018                              || ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
5019                              || h->root.type != bfd_link_hash_undefweak);
5020
5021               BFD_ASSERT (globals->root.srelgot != NULL);
5022               BFD_ASSERT (globals->root.sgot != NULL);
5023
5024               if (need_relocs)
5025                 {
5026                   bfd_byte *loc;
5027                   Elf_Internal_Rela rela;
5028                   rela.r_info = ELFNN_R_INFO (indx, AARCH64_R (TLSDESC));
5029
5030                   rela.r_addend = 0;
5031                   rela.r_offset = (globals->root.sgotplt->output_section->vma
5032                                    + globals->root.sgotplt->output_offset
5033                                    + off + globals->sgotplt_jump_table_size);
5034
5035                   if (indx == 0)
5036                     rela.r_addend = relocation - dtpoff_base (info);
5037
5038                   /* Allocate the next available slot in the PLT reloc
5039                      section to hold our R_AARCH64_TLSDESC, the next
5040                      available slot is determined from reloc_count,
5041                      which we step. But note, reloc_count was
5042                      artifically moved down while allocating slots for
5043                      real PLT relocs such that all of the PLT relocs
5044                      will fit above the initial reloc_count and the
5045                      extra stuff will fit below.  */
5046                   loc = globals->root.srelplt->contents;
5047                   loc += globals->root.srelplt->reloc_count++
5048                     * RELOC_SIZE (globals);
5049
5050                   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
5051
5052                   bfd_put_NN (output_bfd, (bfd_vma) 0,
5053                               globals->root.sgotplt->contents + off +
5054                               globals->sgotplt_jump_table_size);
5055                   bfd_put_NN (output_bfd, (bfd_vma) 0,
5056                               globals->root.sgotplt->contents + off +
5057                               globals->sgotplt_jump_table_size +
5058                               GOT_ENTRY_SIZE);
5059                 }
5060
5061               symbol_tlsdesc_got_offset_mark (input_bfd, h, r_symndx);
5062             }
5063           break;
5064         default:
5065           break;
5066         }
5067
5068       if (!save_addend)
5069         addend = 0;
5070
5071
5072       /* Dynamic relocs are not propagated for SEC_DEBUGGING sections
5073          because such sections are not SEC_ALLOC and thus ld.so will
5074          not process them.  */
5075       if (unresolved_reloc
5076           && !((input_section->flags & SEC_DEBUGGING) != 0
5077                && h->def_dynamic)
5078           && _bfd_elf_section_offset (output_bfd, info, input_section,
5079                                       +rel->r_offset) != (bfd_vma) - 1)
5080         {
5081           (*_bfd_error_handler)
5082             (_
5083              ("%B(%A+0x%lx): unresolvable %s relocation against symbol `%s'"),
5084              input_bfd, input_section, (long) rel->r_offset, howto->name,
5085              h->root.root.string);
5086           return FALSE;
5087         }
5088
5089       if (r != bfd_reloc_ok && r != bfd_reloc_continue)
5090         {
5091           switch (r)
5092             {
5093             case bfd_reloc_overflow:
5094               /* If the overflowing reloc was to an undefined symbol,
5095                  we have already printed one error message and there
5096                  is no point complaining again.  */
5097               if ((!h ||
5098                    h->root.type != bfd_link_hash_undefined)
5099                   && (!((*info->callbacks->reloc_overflow)
5100                         (info, (h ? &h->root : NULL), name, howto->name,
5101                          (bfd_vma) 0, input_bfd, input_section,
5102                          rel->r_offset))))
5103                 return FALSE;
5104               break;
5105
5106             case bfd_reloc_undefined:
5107               if (!((*info->callbacks->undefined_symbol)
5108                     (info, name, input_bfd, input_section,
5109                      rel->r_offset, TRUE)))
5110                 return FALSE;
5111               break;
5112
5113             case bfd_reloc_outofrange:
5114               error_message = _("out of range");
5115               goto common_error;
5116
5117             case bfd_reloc_notsupported:
5118               error_message = _("unsupported relocation");
5119               goto common_error;
5120
5121             case bfd_reloc_dangerous:
5122               /* error_message should already be set.  */
5123               goto common_error;
5124
5125             default:
5126               error_message = _("unknown error");
5127               /* Fall through.  */
5128
5129             common_error:
5130               BFD_ASSERT (error_message != NULL);
5131               if (!((*info->callbacks->reloc_dangerous)
5132                     (info, error_message, input_bfd, input_section,
5133                      rel->r_offset)))
5134                 return FALSE;
5135               break;
5136             }
5137         }
5138     }
5139
5140   return TRUE;
5141 }
5142
5143 /* Set the right machine number.  */
5144
5145 static bfd_boolean
5146 elfNN_aarch64_object_p (bfd *abfd)
5147 {
5148 #if ARCH_SIZE == 32
5149   bfd_default_set_arch_mach (abfd, bfd_arch_aarch64, bfd_mach_aarch64_ilp32);
5150 #else
5151   bfd_default_set_arch_mach (abfd, bfd_arch_aarch64, bfd_mach_aarch64);
5152 #endif
5153   return TRUE;
5154 }
5155
5156 /* Function to keep AArch64 specific flags in the ELF header.  */
5157
5158 static bfd_boolean
5159 elfNN_aarch64_set_private_flags (bfd *abfd, flagword flags)
5160 {
5161   if (elf_flags_init (abfd) && elf_elfheader (abfd)->e_flags != flags)
5162     {
5163     }
5164   else
5165     {
5166       elf_elfheader (abfd)->e_flags = flags;
5167       elf_flags_init (abfd) = TRUE;
5168     }
5169
5170   return TRUE;
5171 }
5172
5173 /* Merge backend specific data from an object file to the output
5174    object file when linking.  */
5175
5176 static bfd_boolean
5177 elfNN_aarch64_merge_private_bfd_data (bfd *ibfd, bfd *obfd)
5178 {
5179   flagword out_flags;
5180   flagword in_flags;
5181   bfd_boolean flags_compatible = TRUE;
5182   asection *sec;
5183
5184   /* Check if we have the same endianess.  */
5185   if (!_bfd_generic_verify_endian_match (ibfd, obfd))
5186     return FALSE;
5187
5188   if (!is_aarch64_elf (ibfd) || !is_aarch64_elf (obfd))
5189     return TRUE;
5190
5191   /* The input BFD must have had its flags initialised.  */
5192   /* The following seems bogus to me -- The flags are initialized in
5193      the assembler but I don't think an elf_flags_init field is
5194      written into the object.  */
5195   /* BFD_ASSERT (elf_flags_init (ibfd)); */
5196
5197   in_flags = elf_elfheader (ibfd)->e_flags;
5198   out_flags = elf_elfheader (obfd)->e_flags;
5199
5200   if (!elf_flags_init (obfd))
5201     {
5202       /* If the input is the default architecture and had the default
5203          flags then do not bother setting the flags for the output
5204          architecture, instead allow future merges to do this.  If no
5205          future merges ever set these flags then they will retain their
5206          uninitialised values, which surprise surprise, correspond
5207          to the default values.  */
5208       if (bfd_get_arch_info (ibfd)->the_default
5209           && elf_elfheader (ibfd)->e_flags == 0)
5210         return TRUE;
5211
5212       elf_flags_init (obfd) = TRUE;
5213       elf_elfheader (obfd)->e_flags = in_flags;
5214
5215       if (bfd_get_arch (obfd) == bfd_get_arch (ibfd)
5216           && bfd_get_arch_info (obfd)->the_default)
5217         return bfd_set_arch_mach (obfd, bfd_get_arch (ibfd),
5218                                   bfd_get_mach (ibfd));
5219
5220       return TRUE;
5221     }
5222
5223   /* Identical flags must be compatible.  */
5224   if (in_flags == out_flags)
5225     return TRUE;
5226
5227   /* Check to see if the input BFD actually contains any sections.  If
5228      not, its flags may not have been initialised either, but it
5229      cannot actually cause any incompatiblity.  Do not short-circuit
5230      dynamic objects; their section list may be emptied by
5231      elf_link_add_object_symbols.
5232
5233      Also check to see if there are no code sections in the input.
5234      In this case there is no need to check for code specific flags.
5235      XXX - do we need to worry about floating-point format compatability
5236      in data sections ?  */
5237   if (!(ibfd->flags & DYNAMIC))
5238     {
5239       bfd_boolean null_input_bfd = TRUE;
5240       bfd_boolean only_data_sections = TRUE;
5241
5242       for (sec = ibfd->sections; sec != NULL; sec = sec->next)
5243         {
5244           if ((bfd_get_section_flags (ibfd, sec)
5245                & (SEC_LOAD | SEC_CODE | SEC_HAS_CONTENTS))
5246               == (SEC_LOAD | SEC_CODE | SEC_HAS_CONTENTS))
5247             only_data_sections = FALSE;
5248
5249           null_input_bfd = FALSE;
5250           break;
5251         }
5252
5253       if (null_input_bfd || only_data_sections)
5254         return TRUE;
5255     }
5256
5257   return flags_compatible;
5258 }
5259
5260 /* Display the flags field.  */
5261
5262 static bfd_boolean
5263 elfNN_aarch64_print_private_bfd_data (bfd *abfd, void *ptr)
5264 {
5265   FILE *file = (FILE *) ptr;
5266   unsigned long flags;
5267
5268   BFD_ASSERT (abfd != NULL && ptr != NULL);
5269
5270   /* Print normal ELF private data.  */
5271   _bfd_elf_print_private_bfd_data (abfd, ptr);
5272
5273   flags = elf_elfheader (abfd)->e_flags;
5274   /* Ignore init flag - it may not be set, despite the flags field
5275      containing valid data.  */
5276
5277   /* xgettext:c-format */
5278   fprintf (file, _("private flags = %lx:"), elf_elfheader (abfd)->e_flags);
5279
5280   if (flags)
5281     fprintf (file, _("<Unrecognised flag bits set>"));
5282
5283   fputc ('\n', file);
5284
5285   return TRUE;
5286 }
5287
5288 /* Update the got entry reference counts for the section being removed.  */
5289
5290 static bfd_boolean
5291 elfNN_aarch64_gc_sweep_hook (bfd *abfd,
5292                              struct bfd_link_info *info,
5293                              asection *sec,
5294                              const Elf_Internal_Rela * relocs)
5295 {
5296   struct elf_aarch64_link_hash_table *htab;
5297   Elf_Internal_Shdr *symtab_hdr;
5298   struct elf_link_hash_entry **sym_hashes;
5299   struct elf_aarch64_local_symbol *locals;
5300   const Elf_Internal_Rela *rel, *relend;
5301
5302   if (info->relocatable)
5303     return TRUE;
5304
5305   htab = elf_aarch64_hash_table (info);
5306
5307   if (htab == NULL)
5308     return FALSE;
5309
5310   elf_section_data (sec)->local_dynrel = NULL;
5311
5312   symtab_hdr = &elf_symtab_hdr (abfd);
5313   sym_hashes = elf_sym_hashes (abfd);
5314
5315   locals = elf_aarch64_locals (abfd);
5316
5317   relend = relocs + sec->reloc_count;
5318   for (rel = relocs; rel < relend; rel++)
5319     {
5320       unsigned long r_symndx;
5321       unsigned int r_type;
5322       struct elf_link_hash_entry *h = NULL;
5323
5324       r_symndx = ELFNN_R_SYM (rel->r_info);
5325
5326       if (r_symndx >= symtab_hdr->sh_info)
5327         {
5328
5329           h = sym_hashes[r_symndx - symtab_hdr->sh_info];
5330           while (h->root.type == bfd_link_hash_indirect
5331                  || h->root.type == bfd_link_hash_warning)
5332             h = (struct elf_link_hash_entry *) h->root.u.i.link;
5333         }
5334       else
5335         {
5336           Elf_Internal_Sym *isym;
5337
5338           /* A local symbol.  */
5339           isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5340                                         abfd, r_symndx);
5341
5342           /* Check relocation against local STT_GNU_IFUNC symbol.  */
5343           if (isym != NULL
5344               && ELF_ST_TYPE (isym->st_info) == STT_GNU_IFUNC)
5345             {
5346               h = elfNN_aarch64_get_local_sym_hash (htab, abfd, rel, FALSE);
5347               if (h == NULL)
5348                 abort ();
5349             }
5350         }
5351
5352       if (h)
5353         {
5354           struct elf_aarch64_link_hash_entry *eh;
5355           struct elf_dyn_relocs **pp;
5356           struct elf_dyn_relocs *p;
5357
5358           eh = (struct elf_aarch64_link_hash_entry *) h;
5359
5360           for (pp = &eh->dyn_relocs; (p = *pp) != NULL; pp = &p->next)
5361             if (p->sec == sec)
5362               {
5363                 /* Everything must go for SEC.  */
5364                 *pp = p->next;
5365                 break;
5366               }
5367         }
5368
5369       r_type = ELFNN_R_TYPE (rel->r_info);
5370       switch (aarch64_tls_transition (abfd,info, r_type, h ,r_symndx))
5371         {
5372         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5373         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5374         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5375         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5376         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
5377         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
5378         case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
5379         case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
5380         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
5381         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
5382         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
5383         case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
5384         case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
5385         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
5386         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
5387         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
5388         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
5389         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
5390         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
5391         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
5392         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
5393           if (h != NULL)
5394             {
5395               if (h->got.refcount > 0)
5396                 h->got.refcount -= 1;
5397
5398               if (h->type == STT_GNU_IFUNC)
5399                 {
5400                   if (h->plt.refcount > 0)
5401                     h->plt.refcount -= 1;
5402                 }
5403             }
5404           else if (locals != NULL)
5405             {
5406               if (locals[r_symndx].got_refcount > 0)
5407                 locals[r_symndx].got_refcount -= 1;
5408             }
5409           break;
5410
5411         case BFD_RELOC_AARCH64_CALL26:
5412         case BFD_RELOC_AARCH64_JUMP26:
5413           /* If this is a local symbol then we resolve it
5414              directly without creating a PLT entry.  */
5415           if (h == NULL)
5416             continue;
5417
5418           if (h->plt.refcount > 0)
5419             h->plt.refcount -= 1;
5420           break;
5421
5422         case BFD_RELOC_AARCH64_MOVW_G0_NC:
5423         case BFD_RELOC_AARCH64_MOVW_G1_NC:
5424         case BFD_RELOC_AARCH64_MOVW_G2_NC:
5425         case BFD_RELOC_AARCH64_MOVW_G3:
5426         case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
5427         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5428         case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
5429         case BFD_RELOC_AARCH64_NN:
5430           if (h != NULL && info->executable)
5431             {
5432               if (h->plt.refcount > 0)
5433                 h->plt.refcount -= 1;
5434             }
5435           break;
5436
5437         default:
5438           break;
5439         }
5440     }
5441
5442   return TRUE;
5443 }
5444
5445 /* Adjust a symbol defined by a dynamic object and referenced by a
5446    regular object.  The current definition is in some section of the
5447    dynamic object, but we're not including those sections.  We have to
5448    change the definition to something the rest of the link can
5449    understand.  */
5450
5451 static bfd_boolean
5452 elfNN_aarch64_adjust_dynamic_symbol (struct bfd_link_info *info,
5453                                      struct elf_link_hash_entry *h)
5454 {
5455   struct elf_aarch64_link_hash_table *htab;
5456   asection *s;
5457
5458   /* If this is a function, put it in the procedure linkage table.  We
5459      will fill in the contents of the procedure linkage table later,
5460      when we know the address of the .got section.  */
5461   if (h->type == STT_FUNC || h->type == STT_GNU_IFUNC || h->needs_plt)
5462     {
5463       if (h->plt.refcount <= 0
5464           || (h->type != STT_GNU_IFUNC
5465               && (SYMBOL_CALLS_LOCAL (info, h)
5466                   || (ELF_ST_VISIBILITY (h->other) != STV_DEFAULT
5467                       && h->root.type == bfd_link_hash_undefweak))))
5468         {
5469           /* This case can occur if we saw a CALL26 reloc in
5470              an input file, but the symbol wasn't referred to
5471              by a dynamic object or all references were
5472              garbage collected. In which case we can end up
5473              resolving.  */
5474           h->plt.offset = (bfd_vma) - 1;
5475           h->needs_plt = 0;
5476         }
5477
5478       return TRUE;
5479     }
5480   else
5481     /* It's possible that we incorrectly decided a .plt reloc was
5482        needed for an R_X86_64_PC32 reloc to a non-function sym in
5483        check_relocs.  We can't decide accurately between function and
5484        non-function syms in check-relocs;  Objects loaded later in
5485        the link may change h->type.  So fix it now.  */
5486     h->plt.offset = (bfd_vma) - 1;
5487
5488
5489   /* If this is a weak symbol, and there is a real definition, the
5490      processor independent code will have arranged for us to see the
5491      real definition first, and we can just use the same value.  */
5492   if (h->u.weakdef != NULL)
5493     {
5494       BFD_ASSERT (h->u.weakdef->root.type == bfd_link_hash_defined
5495                   || h->u.weakdef->root.type == bfd_link_hash_defweak);
5496       h->root.u.def.section = h->u.weakdef->root.u.def.section;
5497       h->root.u.def.value = h->u.weakdef->root.u.def.value;
5498       if (ELIMINATE_COPY_RELOCS || info->nocopyreloc)
5499         h->non_got_ref = h->u.weakdef->non_got_ref;
5500       return TRUE;
5501     }
5502
5503   /* If we are creating a shared library, we must presume that the
5504      only references to the symbol are via the global offset table.
5505      For such cases we need not do anything here; the relocations will
5506      be handled correctly by relocate_section.  */
5507   if (info->shared)
5508     return TRUE;
5509
5510   /* If there are no references to this symbol that do not use the
5511      GOT, we don't need to generate a copy reloc.  */
5512   if (!h->non_got_ref)
5513     return TRUE;
5514
5515   /* If -z nocopyreloc was given, we won't generate them either.  */
5516   if (info->nocopyreloc)
5517     {
5518       h->non_got_ref = 0;
5519       return TRUE;
5520     }
5521
5522   /* We must allocate the symbol in our .dynbss section, which will
5523      become part of the .bss section of the executable.  There will be
5524      an entry for this symbol in the .dynsym section.  The dynamic
5525      object will contain position independent code, so all references
5526      from the dynamic object to this symbol will go through the global
5527      offset table.  The dynamic linker will use the .dynsym entry to
5528      determine the address it must put in the global offset table, so
5529      both the dynamic object and the regular object will refer to the
5530      same memory location for the variable.  */
5531
5532   htab = elf_aarch64_hash_table (info);
5533
5534   /* We must generate a R_AARCH64_COPY reloc to tell the dynamic linker
5535      to copy the initial value out of the dynamic object and into the
5536      runtime process image.  */
5537   if ((h->root.u.def.section->flags & SEC_ALLOC) != 0 && h->size != 0)
5538     {
5539       htab->srelbss->size += RELOC_SIZE (htab);
5540       h->needs_copy = 1;
5541     }
5542
5543   s = htab->sdynbss;
5544
5545   return _bfd_elf_adjust_dynamic_copy (h, s);
5546
5547 }
5548
5549 static bfd_boolean
5550 elfNN_aarch64_allocate_local_symbols (bfd *abfd, unsigned number)
5551 {
5552   struct elf_aarch64_local_symbol *locals;
5553   locals = elf_aarch64_locals (abfd);
5554   if (locals == NULL)
5555     {
5556       locals = (struct elf_aarch64_local_symbol *)
5557         bfd_zalloc (abfd, number * sizeof (struct elf_aarch64_local_symbol));
5558       if (locals == NULL)
5559         return FALSE;
5560       elf_aarch64_locals (abfd) = locals;
5561     }
5562   return TRUE;
5563 }
5564
5565 /* Create the .got section to hold the global offset table.  */
5566
5567 static bfd_boolean
5568 aarch64_elf_create_got_section (bfd *abfd, struct bfd_link_info *info)
5569 {
5570   const struct elf_backend_data *bed = get_elf_backend_data (abfd);
5571   flagword flags;
5572   asection *s;
5573   struct elf_link_hash_entry *h;
5574   struct elf_link_hash_table *htab = elf_hash_table (info);
5575
5576   /* This function may be called more than once.  */
5577   s = bfd_get_linker_section (abfd, ".got");
5578   if (s != NULL)
5579     return TRUE;
5580
5581   flags = bed->dynamic_sec_flags;
5582
5583   s = bfd_make_section_anyway_with_flags (abfd,
5584                                           (bed->rela_plts_and_copies_p
5585                                            ? ".rela.got" : ".rel.got"),
5586                                           (bed->dynamic_sec_flags
5587                                            | SEC_READONLY));
5588   if (s == NULL
5589       || ! bfd_set_section_alignment (abfd, s, bed->s->log_file_align))
5590     return FALSE;
5591   htab->srelgot = s;
5592
5593   s = bfd_make_section_anyway_with_flags (abfd, ".got", flags);
5594   if (s == NULL
5595       || !bfd_set_section_alignment (abfd, s, bed->s->log_file_align))
5596     return FALSE;
5597   htab->sgot = s;
5598   htab->sgot->size += GOT_ENTRY_SIZE;
5599
5600   if (bed->want_got_sym)
5601     {
5602       /* Define the symbol _GLOBAL_OFFSET_TABLE_ at the start of the .got
5603          (or .got.plt) section.  We don't do this in the linker script
5604          because we don't want to define the symbol if we are not creating
5605          a global offset table.  */
5606       h = _bfd_elf_define_linkage_sym (abfd, info, s,
5607                                        "_GLOBAL_OFFSET_TABLE_");
5608       elf_hash_table (info)->hgot = h;
5609       if (h == NULL)
5610         return FALSE;
5611     }
5612
5613   if (bed->want_got_plt)
5614     {
5615       s = bfd_make_section_anyway_with_flags (abfd, ".got.plt", flags);
5616       if (s == NULL
5617           || !bfd_set_section_alignment (abfd, s,
5618                                          bed->s->log_file_align))
5619         return FALSE;
5620       htab->sgotplt = s;
5621     }
5622
5623   /* The first bit of the global offset table is the header.  */
5624   s->size += bed->got_header_size;
5625
5626   return TRUE;
5627 }
5628
5629 /* Look through the relocs for a section during the first phase.  */
5630
5631 static bfd_boolean
5632 elfNN_aarch64_check_relocs (bfd *abfd, struct bfd_link_info *info,
5633                             asection *sec, const Elf_Internal_Rela *relocs)
5634 {
5635   Elf_Internal_Shdr *symtab_hdr;
5636   struct elf_link_hash_entry **sym_hashes;
5637   const Elf_Internal_Rela *rel;
5638   const Elf_Internal_Rela *rel_end;
5639   asection *sreloc;
5640
5641   struct elf_aarch64_link_hash_table *htab;
5642
5643   if (info->relocatable)
5644     return TRUE;
5645
5646   BFD_ASSERT (is_aarch64_elf (abfd));
5647
5648   htab = elf_aarch64_hash_table (info);
5649   sreloc = NULL;
5650
5651   symtab_hdr = &elf_symtab_hdr (abfd);
5652   sym_hashes = elf_sym_hashes (abfd);
5653
5654   rel_end = relocs + sec->reloc_count;
5655   for (rel = relocs; rel < rel_end; rel++)
5656     {
5657       struct elf_link_hash_entry *h;
5658       unsigned long r_symndx;
5659       unsigned int r_type;
5660       bfd_reloc_code_real_type bfd_r_type;
5661       Elf_Internal_Sym *isym;
5662
5663       r_symndx = ELFNN_R_SYM (rel->r_info);
5664       r_type = ELFNN_R_TYPE (rel->r_info);
5665
5666       if (r_symndx >= NUM_SHDR_ENTRIES (symtab_hdr))
5667         {
5668           (*_bfd_error_handler) (_("%B: bad symbol index: %d"), abfd,
5669                                  r_symndx);
5670           return FALSE;
5671         }
5672
5673       if (r_symndx < symtab_hdr->sh_info)
5674         {
5675           /* A local symbol.  */
5676           isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5677                                         abfd, r_symndx);
5678           if (isym == NULL)
5679             return FALSE;
5680
5681           /* Check relocation against local STT_GNU_IFUNC symbol.  */
5682           if (ELF_ST_TYPE (isym->st_info) == STT_GNU_IFUNC)
5683             {
5684               h = elfNN_aarch64_get_local_sym_hash (htab, abfd, rel,
5685                                                     TRUE);
5686               if (h == NULL)
5687                 return FALSE;
5688
5689               /* Fake a STT_GNU_IFUNC symbol.  */
5690               h->type = STT_GNU_IFUNC;
5691               h->def_regular = 1;
5692               h->ref_regular = 1;
5693               h->forced_local = 1;
5694               h->root.type = bfd_link_hash_defined;
5695             }
5696           else
5697             h = NULL;
5698         }
5699       else
5700         {
5701           h = sym_hashes[r_symndx - symtab_hdr->sh_info];
5702           while (h->root.type == bfd_link_hash_indirect
5703                  || h->root.type == bfd_link_hash_warning)
5704             h = (struct elf_link_hash_entry *) h->root.u.i.link;
5705
5706           /* PR15323, ref flags aren't set for references in the same
5707              object.  */
5708           h->root.non_ir_ref = 1;
5709         }
5710
5711       /* Could be done earlier, if h were already available.  */
5712       bfd_r_type = aarch64_tls_transition (abfd, info, r_type, h, r_symndx);
5713
5714       if (h != NULL)
5715         {
5716           /* Create the ifunc sections for static executables.  If we
5717              never see an indirect function symbol nor we are building
5718              a static executable, those sections will be empty and
5719              won't appear in output.  */
5720           switch (bfd_r_type)
5721             {
5722             default:
5723               break;
5724
5725             case BFD_RELOC_AARCH64_NN:
5726             case BFD_RELOC_AARCH64_CALL26:
5727             case BFD_RELOC_AARCH64_JUMP26:
5728             case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5729             case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5730             case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5731             case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5732             case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5733             case BFD_RELOC_AARCH64_ADD_LO12:
5734               if (htab->root.dynobj == NULL)
5735                 htab->root.dynobj = abfd;
5736               if (!_bfd_elf_create_ifunc_sections (htab->root.dynobj, info))
5737                 return FALSE;
5738               break;
5739             }
5740
5741           /* It is referenced by a non-shared object. */
5742           h->ref_regular = 1;
5743           h->root.non_ir_ref = 1;
5744         }
5745
5746       switch (bfd_r_type)
5747         {
5748         case BFD_RELOC_AARCH64_NN:
5749
5750           /* We don't need to handle relocs into sections not going into
5751              the "real" output.  */
5752           if ((sec->flags & SEC_ALLOC) == 0)
5753             break;
5754
5755           if (h != NULL)
5756             {
5757               if (!info->shared)
5758                 h->non_got_ref = 1;
5759
5760               h->plt.refcount += 1;
5761               h->pointer_equality_needed = 1;
5762             }
5763
5764           /* No need to do anything if we're not creating a shared
5765              object.  */
5766           if (! info->shared)
5767             break;
5768
5769           {
5770             struct elf_dyn_relocs *p;
5771             struct elf_dyn_relocs **head;
5772
5773             /* We must copy these reloc types into the output file.
5774                Create a reloc section in dynobj and make room for
5775                this reloc.  */
5776             if (sreloc == NULL)
5777               {
5778                 if (htab->root.dynobj == NULL)
5779                   htab->root.dynobj = abfd;
5780
5781                 sreloc = _bfd_elf_make_dynamic_reloc_section
5782                   (sec, htab->root.dynobj, LOG_FILE_ALIGN, abfd, /*rela? */ TRUE);
5783
5784                 if (sreloc == NULL)
5785                   return FALSE;
5786               }
5787
5788             /* If this is a global symbol, we count the number of
5789                relocations we need for this symbol.  */
5790             if (h != NULL)
5791               {
5792                 struct elf_aarch64_link_hash_entry *eh;
5793                 eh = (struct elf_aarch64_link_hash_entry *) h;
5794                 head = &eh->dyn_relocs;
5795               }
5796             else
5797               {
5798                 /* Track dynamic relocs needed for local syms too.
5799                    We really need local syms available to do this
5800                    easily.  Oh well.  */
5801
5802                 asection *s;
5803                 void **vpp;
5804
5805                 isym = bfd_sym_from_r_symndx (&htab->sym_cache,
5806                                               abfd, r_symndx);
5807                 if (isym == NULL)
5808                   return FALSE;
5809
5810                 s = bfd_section_from_elf_index (abfd, isym->st_shndx);
5811                 if (s == NULL)
5812                   s = sec;
5813
5814                 /* Beware of type punned pointers vs strict aliasing
5815                    rules.  */
5816                 vpp = &(elf_section_data (s)->local_dynrel);
5817                 head = (struct elf_dyn_relocs **) vpp;
5818               }
5819
5820             p = *head;
5821             if (p == NULL || p->sec != sec)
5822               {
5823                 bfd_size_type amt = sizeof *p;
5824                 p = ((struct elf_dyn_relocs *)
5825                      bfd_zalloc (htab->root.dynobj, amt));
5826                 if (p == NULL)
5827                   return FALSE;
5828                 p->next = *head;
5829                 *head = p;
5830                 p->sec = sec;
5831               }
5832
5833             p->count += 1;
5834
5835           }
5836           break;
5837
5838           /* RR: We probably want to keep a consistency check that
5839              there are no dangling GOT_PAGE relocs.  */
5840         case BFD_RELOC_AARCH64_ADR_GOT_PAGE:
5841         case BFD_RELOC_AARCH64_GOT_LD_PREL19:
5842         case BFD_RELOC_AARCH64_LD32_GOT_LO12_NC:
5843         case BFD_RELOC_AARCH64_LD64_GOT_LO12_NC:
5844         case BFD_RELOC_AARCH64_TLSDESC_ADD_LO12_NC:
5845         case BFD_RELOC_AARCH64_TLSDESC_ADR_PAGE21:
5846         case BFD_RELOC_AARCH64_TLSDESC_LD32_LO12_NC:
5847         case BFD_RELOC_AARCH64_TLSDESC_LD64_LO12_NC:
5848         case BFD_RELOC_AARCH64_TLSGD_ADD_LO12_NC:
5849         case BFD_RELOC_AARCH64_TLSGD_ADR_PAGE21:
5850         case BFD_RELOC_AARCH64_TLSIE_ADR_GOTTPREL_PAGE21:
5851         case BFD_RELOC_AARCH64_TLSIE_LD32_GOTTPREL_LO12_NC:
5852         case BFD_RELOC_AARCH64_TLSIE_LD64_GOTTPREL_LO12_NC:
5853         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_HI12:
5854         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12:
5855         case BFD_RELOC_AARCH64_TLSLE_ADD_TPREL_LO12_NC:
5856         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0:
5857         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G0_NC:
5858         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1:
5859         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G1_NC:
5860         case BFD_RELOC_AARCH64_TLSLE_MOVW_TPREL_G2:
5861           {
5862             unsigned got_type;
5863             unsigned old_got_type;
5864
5865             got_type = aarch64_reloc_got_type (bfd_r_type);
5866
5867             if (h)
5868               {
5869                 h->got.refcount += 1;
5870                 old_got_type = elf_aarch64_hash_entry (h)->got_type;
5871               }
5872             else
5873               {
5874                 struct elf_aarch64_local_symbol *locals;
5875
5876                 if (!elfNN_aarch64_allocate_local_symbols
5877                     (abfd, symtab_hdr->sh_info))
5878                   return FALSE;
5879
5880                 locals = elf_aarch64_locals (abfd);
5881                 BFD_ASSERT (r_symndx < symtab_hdr->sh_info);
5882                 locals[r_symndx].got_refcount += 1;
5883                 old_got_type = locals[r_symndx].got_type;
5884               }
5885
5886             /* If a variable is accessed with both general dynamic TLS
5887                methods, two slots may be created.  */
5888             if (GOT_TLS_GD_ANY_P (old_got_type) && GOT_TLS_GD_ANY_P (got_type))
5889               got_type |= old_got_type;
5890
5891             /* We will already have issued an error message if there
5892                is a TLS/non-TLS mismatch, based on the symbol type.
5893                So just combine any TLS types needed.  */
5894             if (old_got_type != GOT_UNKNOWN && old_got_type != GOT_NORMAL
5895                 && got_type != GOT_NORMAL)
5896               got_type |= old_got_type;
5897
5898             /* If the symbol is accessed by both IE and GD methods, we
5899                are able to relax.  Turn off the GD flag, without
5900                messing up with any other kind of TLS types that may be
5901                involved.  */
5902             if ((got_type & GOT_TLS_IE) && GOT_TLS_GD_ANY_P (got_type))
5903               got_type &= ~ (GOT_TLSDESC_GD | GOT_TLS_GD);
5904
5905             if (old_got_type != got_type)
5906               {
5907                 if (h != NULL)
5908                   elf_aarch64_hash_entry (h)->got_type = got_type;
5909                 else
5910                   {
5911                     struct elf_aarch64_local_symbol *locals;
5912                     locals = elf_aarch64_locals (abfd);
5913                     BFD_ASSERT (r_symndx < symtab_hdr->sh_info);
5914                     locals[r_symndx].got_type = got_type;
5915                   }
5916               }
5917
5918             if (htab->root.dynobj == NULL)
5919               htab->root.dynobj = abfd;
5920             if (! aarch64_elf_create_got_section (htab->root.dynobj, info))
5921               return FALSE;
5922             break;
5923           }
5924
5925         case BFD_RELOC_AARCH64_MOVW_G0_NC:
5926         case BFD_RELOC_AARCH64_MOVW_G1_NC:
5927         case BFD_RELOC_AARCH64_MOVW_G2_NC:
5928         case BFD_RELOC_AARCH64_MOVW_G3:
5929           if (info->shared)
5930             {
5931               int howto_index = bfd_r_type - BFD_RELOC_AARCH64_RELOC_START;
5932               (*_bfd_error_handler)
5933                 (_("%B: relocation %s against `%s' can not be used when making "
5934                    "a shared object; recompile with -fPIC"),
5935                  abfd, elfNN_aarch64_howto_table[howto_index].name,
5936                  (h) ? h->root.root.string : "a local symbol");
5937               bfd_set_error (bfd_error_bad_value);
5938               return FALSE;
5939             }
5940
5941         case BFD_RELOC_AARCH64_ADR_HI21_NC_PCREL:
5942         case BFD_RELOC_AARCH64_ADR_HI21_PCREL:
5943         case BFD_RELOC_AARCH64_ADR_LO21_PCREL:
5944           if (h != NULL && info->executable)
5945             {
5946               /* If this reloc is in a read-only section, we might
5947                  need a copy reloc.  We can't check reliably at this
5948                  stage whether the section is read-only, as input
5949                  sections have not yet been mapped to output sections.
5950                  Tentatively set the flag for now, and correct in
5951                  adjust_dynamic_symbol.  */
5952               h->non_got_ref = 1;
5953               h->plt.refcount += 1;
5954               h->pointer_equality_needed = 1;
5955             }
5956           /* FIXME:: RR need to handle these in shared libraries
5957              and essentially bomb out as these being non-PIC
5958              relocations in shared libraries.  */
5959           break;
5960
5961         case BFD_RELOC_AARCH64_CALL26:
5962         case BFD_RELOC_AARCH64_JUMP26:
5963           /* If this is a local symbol then we resolve it
5964              directly without creating a PLT entry.  */
5965           if (h == NULL)
5966             continue;
5967
5968           h->needs_plt = 1;
5969           if (h->plt.refcount <= 0)
5970             h->plt.refcount = 1;
5971           else
5972             h->plt.refcount += 1;
5973           break;
5974
5975         default:
5976           break;
5977         }
5978     }
5979
5980   return TRUE;
5981 }
5982
5983 /* Treat mapping symbols as special target symbols.  */
5984
5985 static bfd_boolean
5986 elfNN_aarch64_is_target_special_symbol (bfd *abfd ATTRIBUTE_UNUSED,
5987                                         asymbol *sym)
5988 {
5989   return bfd_is_aarch64_special_symbol_name (sym->name,
5990                                              BFD_AARCH64_SPECIAL_SYM_TYPE_ANY);
5991 }
5992
5993 /* This is a copy of elf_find_function () from elf.c except that
5994    AArch64 mapping symbols are ignored when looking for function names.  */
5995
5996 static bfd_boolean
5997 aarch64_elf_find_function (bfd *abfd ATTRIBUTE_UNUSED,
5998                            asymbol **symbols,
5999                            asection *section,
6000                            bfd_vma offset,
6001                            const char **filename_ptr,
6002                            const char **functionname_ptr)
6003 {
6004   const char *filename = NULL;
6005   asymbol *func = NULL;
6006   bfd_vma low_func = 0;
6007   asymbol **p;
6008
6009   for (p = symbols; *p != NULL; p++)
6010     {
6011       elf_symbol_type *q;
6012
6013       q = (elf_symbol_type *) * p;
6014
6015       switch (ELF_ST_TYPE (q->internal_elf_sym.st_info))
6016         {
6017         default:
6018           break;
6019         case STT_FILE:
6020           filename = bfd_asymbol_name (&q->symbol);
6021           break;
6022         case STT_FUNC:
6023         case STT_NOTYPE:
6024           /* Skip mapping symbols.  */
6025           if ((q->symbol.flags & BSF_LOCAL)
6026               && (bfd_is_aarch64_special_symbol_name
6027                   (q->symbol.name, BFD_AARCH64_SPECIAL_SYM_TYPE_ANY)))
6028             continue;
6029           /* Fall through.  */
6030           if (bfd_get_section (&q->symbol) == section
6031               && q->symbol.value >= low_func && q->symbol.value <= offset)
6032             {
6033               func = (asymbol *) q;
6034               low_func = q->symbol.value;
6035             }
6036           break;
6037         }
6038     }
6039
6040   if (func == NULL)
6041     return FALSE;
6042
6043   if (filename_ptr)
6044     *filename_ptr = filename;
6045   if (functionname_ptr)
6046     *functionname_ptr = bfd_asymbol_name (func);
6047
6048   return TRUE;
6049 }
6050
6051
6052 /* Find the nearest line to a particular section and offset, for error
6053    reporting.   This code is a duplicate of the code in elf.c, except
6054    that it uses aarch64_elf_find_function.  */
6055
6056 static bfd_boolean
6057 elfNN_aarch64_find_nearest_line (bfd *abfd,
6058                                  asymbol **symbols,
6059                                  asection *section,
6060                                  bfd_vma offset,
6061                                  const char **filename_ptr,
6062                                  const char **functionname_ptr,
6063                                  unsigned int *line_ptr,
6064                                  unsigned int *discriminator_ptr)
6065 {
6066   bfd_boolean found = FALSE;
6067
6068   if (_bfd_dwarf2_find_nearest_line (abfd, symbols, NULL, section, offset,
6069                                      filename_ptr, functionname_ptr,
6070                                      line_ptr, discriminator_ptr,
6071                                      dwarf_debug_sections, 0,
6072                                      &elf_tdata (abfd)->dwarf2_find_line_info))
6073     {
6074       if (!*functionname_ptr)
6075         aarch64_elf_find_function (abfd, symbols, section, offset,
6076                                    *filename_ptr ? NULL : filename_ptr,
6077                                    functionname_ptr);
6078
6079       return TRUE;
6080     }
6081
6082   /* Skip _bfd_dwarf1_find_nearest_line since no known AArch64
6083      toolchain uses DWARF1.  */
6084
6085   if (!_bfd_stab_section_find_nearest_line (abfd, symbols, section, offset,
6086                                             &found, filename_ptr,
6087                                             functionname_ptr, line_ptr,
6088                                             &elf_tdata (abfd)->line_info))
6089     return FALSE;
6090
6091   if (found && (*functionname_ptr || *line_ptr))
6092     return TRUE;
6093
6094   if (symbols == NULL)
6095     return FALSE;
6096
6097   if (!aarch64_elf_find_function (abfd, symbols, section, offset,
6098                                   filename_ptr, functionname_ptr))
6099     return FALSE;
6100
6101   *line_ptr = 0;
6102   return TRUE;
6103 }
6104
6105 static bfd_boolean
6106 elfNN_aarch64_find_inliner_info (bfd *abfd,
6107                                  const char **filename_ptr,
6108                                  const char **functionname_ptr,
6109                                  unsigned int *line_ptr)
6110 {
6111   bfd_boolean found;
6112   found = _bfd_dwarf2_find_inliner_info
6113     (abfd, filename_ptr,
6114      functionname_ptr, line_ptr, &elf_tdata (abfd)->dwarf2_find_line_info);
6115   return found;
6116 }
6117
6118
6119 static void
6120 elfNN_aarch64_post_process_headers (bfd *abfd,
6121                                     struct bfd_link_info *link_info)
6122 {
6123   Elf_Internal_Ehdr *i_ehdrp;   /* ELF file header, internal form.  */
6124
6125   i_ehdrp = elf_elfheader (abfd);
6126   i_ehdrp->e_ident[EI_ABIVERSION] = AARCH64_ELF_ABI_VERSION;
6127
6128   _bfd_elf_post_process_headers (abfd, link_info);
6129 }
6130
6131 static enum elf_reloc_type_class
6132 elfNN_aarch64_reloc_type_class (const struct bfd_link_info *info ATTRIBUTE_UNUSED,
6133                                 const asection *rel_sec ATTRIBUTE_UNUSED,
6134                                 const Elf_Internal_Rela *rela)
6135 {
6136   switch ((int) ELFNN_R_TYPE (rela->r_info))
6137     {
6138     case AARCH64_R (RELATIVE):
6139       return reloc_class_relative;
6140     case AARCH64_R (JUMP_SLOT):
6141       return reloc_class_plt;
6142     case AARCH64_R (COPY):
6143       return reloc_class_copy;
6144     default:
6145       return reloc_class_normal;
6146     }
6147 }
6148
6149 /* Handle an AArch64 specific section when reading an object file.  This is
6150    called when bfd_section_from_shdr finds a section with an unknown
6151    type.  */
6152
6153 static bfd_boolean
6154 elfNN_aarch64_section_from_shdr (bfd *abfd,
6155                                  Elf_Internal_Shdr *hdr,
6156                                  const char *name, int shindex)
6157 {
6158   /* There ought to be a place to keep ELF backend specific flags, but
6159      at the moment there isn't one.  We just keep track of the
6160      sections by their name, instead.  Fortunately, the ABI gives
6161      names for all the AArch64 specific sections, so we will probably get
6162      away with this.  */
6163   switch (hdr->sh_type)
6164     {
6165     case SHT_AARCH64_ATTRIBUTES:
6166       break;
6167
6168     default:
6169       return FALSE;
6170     }
6171
6172   if (!_bfd_elf_make_section_from_shdr (abfd, hdr, name, shindex))
6173     return FALSE;
6174
6175   return TRUE;
6176 }
6177
6178 /* A structure used to record a list of sections, independently
6179    of the next and prev fields in the asection structure.  */
6180 typedef struct section_list
6181 {
6182   asection *sec;
6183   struct section_list *next;
6184   struct section_list *prev;
6185 }
6186 section_list;
6187
6188 /* Unfortunately we need to keep a list of sections for which
6189    an _aarch64_elf_section_data structure has been allocated.  This
6190    is because it is possible for functions like elfNN_aarch64_write_section
6191    to be called on a section which has had an elf_data_structure
6192    allocated for it (and so the used_by_bfd field is valid) but
6193    for which the AArch64 extended version of this structure - the
6194    _aarch64_elf_section_data structure - has not been allocated.  */
6195 static section_list *sections_with_aarch64_elf_section_data = NULL;
6196
6197 static void
6198 record_section_with_aarch64_elf_section_data (asection *sec)
6199 {
6200   struct section_list *entry;
6201
6202   entry = bfd_malloc (sizeof (*entry));
6203   if (entry == NULL)
6204     return;
6205   entry->sec = sec;
6206   entry->next = sections_with_aarch64_elf_section_data;
6207   entry->prev = NULL;
6208   if (entry->next != NULL)
6209     entry->next->prev = entry;
6210   sections_with_aarch64_elf_section_data = entry;
6211 }
6212
6213 static struct section_list *
6214 find_aarch64_elf_section_entry (asection *sec)
6215 {
6216   struct section_list *entry;
6217   static struct section_list *last_entry = NULL;
6218
6219   /* This is a short cut for the typical case where the sections are added
6220      to the sections_with_aarch64_elf_section_data list in forward order and
6221      then looked up here in backwards order.  This makes a real difference
6222      to the ld-srec/sec64k.exp linker test.  */
6223   entry = sections_with_aarch64_elf_section_data;
6224   if (last_entry != NULL)
6225     {
6226       if (last_entry->sec == sec)
6227         entry = last_entry;
6228       else if (last_entry->next != NULL && last_entry->next->sec == sec)
6229         entry = last_entry->next;
6230     }
6231
6232   for (; entry; entry = entry->next)
6233     if (entry->sec == sec)
6234       break;
6235
6236   if (entry)
6237     /* Record the entry prior to this one - it is the entry we are
6238        most likely to want to locate next time.  Also this way if we
6239        have been called from
6240        unrecord_section_with_aarch64_elf_section_data () we will not
6241        be caching a pointer that is about to be freed.  */
6242     last_entry = entry->prev;
6243
6244   return entry;
6245 }
6246
6247 static void
6248 unrecord_section_with_aarch64_elf_section_data (asection *sec)
6249 {
6250   struct section_list *entry;
6251
6252   entry = find_aarch64_elf_section_entry (sec);
6253
6254   if (entry)
6255     {
6256       if (entry->prev != NULL)
6257         entry->prev->next = entry->next;
6258       if (entry->next != NULL)
6259         entry->next->prev = entry->prev;
6260       if (entry == sections_with_aarch64_elf_section_data)
6261         sections_with_aarch64_elf_section_data = entry->next;
6262       free (entry);
6263     }
6264 }
6265
6266
6267 typedef struct
6268 {
6269   void *finfo;
6270   struct bfd_link_info *info;
6271   asection *sec;
6272   int sec_shndx;
6273   int (*func) (void *, const char *, Elf_Internal_Sym *,
6274                asection *, struct elf_link_hash_entry *);
6275 } output_arch_syminfo;
6276
6277 enum map_symbol_type
6278 {
6279   AARCH64_MAP_INSN,
6280   AARCH64_MAP_DATA
6281 };
6282
6283
6284 /* Output a single mapping symbol.  */
6285
6286 static bfd_boolean
6287 elfNN_aarch64_output_map_sym (output_arch_syminfo *osi,
6288                               enum map_symbol_type type, bfd_vma offset)
6289 {
6290   static const char *names[2] = { "$x", "$d" };
6291   Elf_Internal_Sym sym;
6292
6293   sym.st_value = (osi->sec->output_section->vma
6294                   + osi->sec->output_offset + offset);
6295   sym.st_size = 0;
6296   sym.st_other = 0;
6297   sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_NOTYPE);
6298   sym.st_shndx = osi->sec_shndx;
6299   return osi->func (osi->finfo, names[type], &sym, osi->sec, NULL) == 1;
6300 }
6301
6302
6303
6304 /* Output mapping symbols for PLT entries associated with H.  */
6305
6306 static bfd_boolean
6307 elfNN_aarch64_output_plt_map (struct elf_link_hash_entry *h, void *inf)
6308 {
6309   output_arch_syminfo *osi = (output_arch_syminfo *) inf;
6310   bfd_vma addr;
6311
6312   if (h->root.type == bfd_link_hash_indirect)
6313     return TRUE;
6314
6315   if (h->root.type == bfd_link_hash_warning)
6316     /* When warning symbols are created, they **replace** the "real"
6317        entry in the hash table, thus we never get to see the real
6318        symbol in a hash traversal.  So look at it now.  */
6319     h = (struct elf_link_hash_entry *) h->root.u.i.link;
6320
6321   if (h->plt.offset == (bfd_vma) - 1)
6322     return TRUE;
6323
6324   addr = h->plt.offset;
6325   if (addr == 32)
6326     {
6327       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
6328         return FALSE;
6329     }
6330   return TRUE;
6331 }
6332
6333
6334 /* Output a single local symbol for a generated stub.  */
6335
6336 static bfd_boolean
6337 elfNN_aarch64_output_stub_sym (output_arch_syminfo *osi, const char *name,
6338                                bfd_vma offset, bfd_vma size)
6339 {
6340   Elf_Internal_Sym sym;
6341
6342   sym.st_value = (osi->sec->output_section->vma
6343                   + osi->sec->output_offset + offset);
6344   sym.st_size = size;
6345   sym.st_other = 0;
6346   sym.st_info = ELF_ST_INFO (STB_LOCAL, STT_FUNC);
6347   sym.st_shndx = osi->sec_shndx;
6348   return osi->func (osi->finfo, name, &sym, osi->sec, NULL) == 1;
6349 }
6350
6351 static bfd_boolean
6352 aarch64_map_one_stub (struct bfd_hash_entry *gen_entry, void *in_arg)
6353 {
6354   struct elf_aarch64_stub_hash_entry *stub_entry;
6355   asection *stub_sec;
6356   bfd_vma addr;
6357   char *stub_name;
6358   output_arch_syminfo *osi;
6359
6360   /* Massage our args to the form they really have.  */
6361   stub_entry = (struct elf_aarch64_stub_hash_entry *) gen_entry;
6362   osi = (output_arch_syminfo *) in_arg;
6363
6364   stub_sec = stub_entry->stub_sec;
6365
6366   /* Ensure this stub is attached to the current section being
6367      processed.  */
6368   if (stub_sec != osi->sec)
6369     return TRUE;
6370
6371   addr = (bfd_vma) stub_entry->stub_offset;
6372
6373   stub_name = stub_entry->output_name;
6374
6375   switch (stub_entry->stub_type)
6376     {
6377     case aarch64_stub_adrp_branch:
6378       if (!elfNN_aarch64_output_stub_sym (osi, stub_name, addr,
6379                                           sizeof (aarch64_adrp_branch_stub)))
6380         return FALSE;
6381       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
6382         return FALSE;
6383       break;
6384     case aarch64_stub_long_branch:
6385       if (!elfNN_aarch64_output_stub_sym
6386           (osi, stub_name, addr, sizeof (aarch64_long_branch_stub)))
6387         return FALSE;
6388       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
6389         return FALSE;
6390       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_DATA, addr + 16))
6391         return FALSE;
6392       break;
6393     case aarch64_stub_erratum_835769_veneer:
6394       if (!elfNN_aarch64_output_stub_sym (osi, stub_name, addr,
6395                                           sizeof (aarch64_erratum_835769_stub)))
6396         return FALSE;
6397       if (!elfNN_aarch64_output_map_sym (osi, AARCH64_MAP_INSN, addr))
6398         return FALSE;
6399       break;
6400     default:
6401       BFD_FAIL ();
6402     }
6403
6404   return TRUE;
6405 }
6406
6407 /* Output mapping symbols for linker generated sections.  */
6408
6409 static bfd_boolean
6410 elfNN_aarch64_output_arch_local_syms (bfd *output_bfd,
6411                                       struct bfd_link_info *info,
6412                                       void *finfo,
6413                                       int (*func) (void *, const char *,
6414                                                    Elf_Internal_Sym *,
6415                                                    asection *,
6416                                                    struct elf_link_hash_entry
6417                                                    *))
6418 {
6419   output_arch_syminfo osi;
6420   struct elf_aarch64_link_hash_table *htab;
6421
6422   htab = elf_aarch64_hash_table (info);
6423
6424   osi.finfo = finfo;
6425   osi.info = info;
6426   osi.func = func;
6427
6428   /* Long calls stubs.  */
6429   if (htab->stub_bfd && htab->stub_bfd->sections)
6430     {
6431       asection *stub_sec;
6432
6433       for (stub_sec = htab->stub_bfd->sections;
6434            stub_sec != NULL; stub_sec = stub_sec->next)
6435         {
6436           /* Ignore non-stub sections.  */
6437           if (!strstr (stub_sec->name, STUB_SUFFIX))
6438             continue;
6439
6440           osi.sec = stub_sec;
6441
6442           osi.sec_shndx = _bfd_elf_section_from_bfd_section
6443             (output_bfd, osi.sec->output_section);
6444
6445           bfd_hash_traverse (&htab->stub_hash_table, aarch64_map_one_stub,
6446                              &osi);
6447         }
6448     }
6449
6450   /* Finally, output mapping symbols for the PLT.  */
6451   if (!htab->root.splt || htab->root.splt->size == 0)
6452     return TRUE;
6453
6454   /* For now live without mapping symbols for the plt.  */
6455   osi.sec_shndx = _bfd_elf_section_from_bfd_section
6456     (output_bfd, htab->root.splt->output_section);
6457   osi.sec = htab->root.splt;
6458
6459   elf_link_hash_traverse (&htab->root, elfNN_aarch64_output_plt_map,
6460                           (void *) &osi);
6461
6462   return TRUE;
6463
6464 }
6465
6466 /* Allocate target specific section data.  */
6467
6468 static bfd_boolean
6469 elfNN_aarch64_new_section_hook (bfd *abfd, asection *sec)
6470 {
6471   if (!sec->used_by_bfd)
6472     {
6473       _aarch64_elf_section_data *sdata;
6474       bfd_size_type amt = sizeof (*sdata);
6475
6476       sdata = bfd_zalloc (abfd, amt);
6477       if (sdata == NULL)
6478         return FALSE;
6479       sec->used_by_bfd = sdata;
6480     }
6481
6482   record_section_with_aarch64_elf_section_data (sec);
6483
6484   return _bfd_elf_new_section_hook (abfd, sec);
6485 }
6486
6487
6488 static void
6489 unrecord_section_via_map_over_sections (bfd *abfd ATTRIBUTE_UNUSED,
6490                                         asection *sec,
6491                                         void *ignore ATTRIBUTE_UNUSED)
6492 {
6493   unrecord_section_with_aarch64_elf_section_data (sec);
6494 }
6495
6496 static bfd_boolean
6497 elfNN_aarch64_close_and_cleanup (bfd *abfd)
6498 {
6499   if (abfd->sections)
6500     bfd_map_over_sections (abfd,
6501                            unrecord_section_via_map_over_sections, NULL);
6502
6503   return _bfd_elf_close_and_cleanup (abfd);
6504 }
6505
6506 static bfd_boolean
6507 elfNN_aarch64_bfd_free_cached_info (bfd *abfd)
6508 {
6509   if (abfd->sections)
6510     bfd_map_over_sections (abfd,
6511                            unrecord_section_via_map_over_sections, NULL);
6512
6513   return _bfd_free_cached_info (abfd);
6514 }
6515
6516 /* Create dynamic sections. This is different from the ARM backend in that
6517    the got, plt, gotplt and their relocation sections are all created in the
6518    standard part of the bfd elf backend.  */
6519
6520 static bfd_boolean
6521 elfNN_aarch64_create_dynamic_sections (bfd *dynobj,
6522                                        struct bfd_link_info *info)
6523 {
6524   struct elf_aarch64_link_hash_table *htab;
6525
6526   /* We need to create .got section.  */
6527   if (!aarch64_elf_create_got_section (dynobj, info))
6528     return FALSE;
6529
6530   if (!_bfd_elf_create_dynamic_sections (dynobj, info))
6531     return FALSE;
6532
6533   htab = elf_aarch64_hash_table (info);
6534   htab->sdynbss = bfd_get_linker_section (dynobj, ".dynbss");
6535   if (!info->shared)
6536     htab->srelbss = bfd_get_linker_section (dynobj, ".rela.bss");
6537
6538   if (!htab->sdynbss || (!info->shared && !htab->srelbss))
6539     abort ();
6540
6541   return TRUE;
6542 }
6543
6544
6545 /* Allocate space in .plt, .got and associated reloc sections for
6546    dynamic relocs.  */
6547
6548 static bfd_boolean
6549 elfNN_aarch64_allocate_dynrelocs (struct elf_link_hash_entry *h, void *inf)
6550 {
6551   struct bfd_link_info *info;
6552   struct elf_aarch64_link_hash_table *htab;
6553   struct elf_aarch64_link_hash_entry *eh;
6554   struct elf_dyn_relocs *p;
6555
6556   /* An example of a bfd_link_hash_indirect symbol is versioned
6557      symbol. For example: __gxx_personality_v0(bfd_link_hash_indirect)
6558      -> __gxx_personality_v0(bfd_link_hash_defined)
6559
6560      There is no need to process bfd_link_hash_indirect symbols here
6561      because we will also be presented with the concrete instance of
6562      the symbol and elfNN_aarch64_copy_indirect_symbol () will have been
6563      called to copy all relevant data from the generic to the concrete
6564      symbol instance.
6565    */
6566   if (h->root.type == bfd_link_hash_indirect)
6567     return TRUE;
6568
6569   if (h->root.type == bfd_link_hash_warning)
6570     h = (struct elf_link_hash_entry *) h->root.u.i.link;
6571
6572   info = (struct bfd_link_info *) inf;
6573   htab = elf_aarch64_hash_table (info);
6574
6575   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle it
6576      here if it is defined and referenced in a non-shared object.  */
6577   if (h->type == STT_GNU_IFUNC
6578       && h->def_regular)
6579     return TRUE;
6580   else if (htab->root.dynamic_sections_created && h->plt.refcount > 0)
6581     {
6582       /* Make sure this symbol is output as a dynamic symbol.
6583          Undefined weak syms won't yet be marked as dynamic.  */
6584       if (h->dynindx == -1 && !h->forced_local)
6585         {
6586           if (!bfd_elf_link_record_dynamic_symbol (info, h))
6587             return FALSE;
6588         }
6589
6590       if (info->shared || WILL_CALL_FINISH_DYNAMIC_SYMBOL (1, 0, h))
6591         {
6592           asection *s = htab->root.splt;
6593
6594           /* If this is the first .plt entry, make room for the special
6595              first entry.  */
6596           if (s->size == 0)
6597             s->size += htab->plt_header_size;
6598
6599           h->plt.offset = s->size;
6600
6601           /* If this symbol is not defined in a regular file, and we are
6602              not generating a shared library, then set the symbol to this
6603              location in the .plt.  This is required to make function
6604              pointers compare as equal between the normal executable and
6605              the shared library.  */
6606           if (!info->shared && !h->def_regular)
6607             {
6608               h->root.u.def.section = s;
6609               h->root.u.def.value = h->plt.offset;
6610             }
6611
6612           /* Make room for this entry. For now we only create the
6613              small model PLT entries. We later need to find a way
6614              of relaxing into these from the large model PLT entries.  */
6615           s->size += PLT_SMALL_ENTRY_SIZE;
6616
6617           /* We also need to make an entry in the .got.plt section, which
6618              will be placed in the .got section by the linker script.  */
6619           htab->root.sgotplt->size += GOT_ENTRY_SIZE;
6620
6621           /* We also need to make an entry in the .rela.plt section.  */
6622           htab->root.srelplt->size += RELOC_SIZE (htab);
6623
6624           /* We need to ensure that all GOT entries that serve the PLT
6625              are consecutive with the special GOT slots [0] [1] and
6626              [2]. Any addtional relocations, such as
6627              R_AARCH64_TLSDESC, must be placed after the PLT related
6628              entries.  We abuse the reloc_count such that during
6629              sizing we adjust reloc_count to indicate the number of
6630              PLT related reserved entries.  In subsequent phases when
6631              filling in the contents of the reloc entries, PLT related
6632              entries are placed by computing their PLT index (0
6633              .. reloc_count). While other none PLT relocs are placed
6634              at the slot indicated by reloc_count and reloc_count is
6635              updated.  */
6636
6637           htab->root.srelplt->reloc_count++;
6638         }
6639       else
6640         {
6641           h->plt.offset = (bfd_vma) - 1;
6642           h->needs_plt = 0;
6643         }
6644     }
6645   else
6646     {
6647       h->plt.offset = (bfd_vma) - 1;
6648       h->needs_plt = 0;
6649     }
6650
6651   eh = (struct elf_aarch64_link_hash_entry *) h;
6652   eh->tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
6653
6654   if (h->got.refcount > 0)
6655     {
6656       bfd_boolean dyn;
6657       unsigned got_type = elf_aarch64_hash_entry (h)->got_type;
6658
6659       h->got.offset = (bfd_vma) - 1;
6660
6661       dyn = htab->root.dynamic_sections_created;
6662
6663       /* Make sure this symbol is output as a dynamic symbol.
6664          Undefined weak syms won't yet be marked as dynamic.  */
6665       if (dyn && h->dynindx == -1 && !h->forced_local)
6666         {
6667           if (!bfd_elf_link_record_dynamic_symbol (info, h))
6668             return FALSE;
6669         }
6670
6671       if (got_type == GOT_UNKNOWN)
6672         {
6673         }
6674       else if (got_type == GOT_NORMAL)
6675         {
6676           h->got.offset = htab->root.sgot->size;
6677           htab->root.sgot->size += GOT_ENTRY_SIZE;
6678           if ((ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
6679                || h->root.type != bfd_link_hash_undefweak)
6680               && (info->shared
6681                   || WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, 0, h)))
6682             {
6683               htab->root.srelgot->size += RELOC_SIZE (htab);
6684             }
6685         }
6686       else
6687         {
6688           int indx;
6689           if (got_type & GOT_TLSDESC_GD)
6690             {
6691               eh->tlsdesc_got_jump_table_offset =
6692                 (htab->root.sgotplt->size
6693                  - aarch64_compute_jump_table_size (htab));
6694               htab->root.sgotplt->size += GOT_ENTRY_SIZE * 2;
6695               h->got.offset = (bfd_vma) - 2;
6696             }
6697
6698           if (got_type & GOT_TLS_GD)
6699             {
6700               h->got.offset = htab->root.sgot->size;
6701               htab->root.sgot->size += GOT_ENTRY_SIZE * 2;
6702             }
6703
6704           if (got_type & GOT_TLS_IE)
6705             {
6706               h->got.offset = htab->root.sgot->size;
6707               htab->root.sgot->size += GOT_ENTRY_SIZE;
6708             }
6709
6710           indx = h && h->dynindx != -1 ? h->dynindx : 0;
6711           if ((ELF_ST_VISIBILITY (h->other) == STV_DEFAULT
6712                || h->root.type != bfd_link_hash_undefweak)
6713               && (info->shared
6714                   || indx != 0
6715                   || WILL_CALL_FINISH_DYNAMIC_SYMBOL (dyn, 0, h)))
6716             {
6717               if (got_type & GOT_TLSDESC_GD)
6718                 {
6719                   htab->root.srelplt->size += RELOC_SIZE (htab);
6720                   /* Note reloc_count not incremented here!  We have
6721                      already adjusted reloc_count for this relocation
6722                      type.  */
6723
6724                   /* TLSDESC PLT is now needed, but not yet determined.  */
6725                   htab->tlsdesc_plt = (bfd_vma) - 1;
6726                 }
6727
6728               if (got_type & GOT_TLS_GD)
6729                 htab->root.srelgot->size += RELOC_SIZE (htab) * 2;
6730
6731               if (got_type & GOT_TLS_IE)
6732                 htab->root.srelgot->size += RELOC_SIZE (htab);
6733             }
6734         }
6735     }
6736   else
6737     {
6738       h->got.offset = (bfd_vma) - 1;
6739     }
6740
6741   if (eh->dyn_relocs == NULL)
6742     return TRUE;
6743
6744   /* In the shared -Bsymbolic case, discard space allocated for
6745      dynamic pc-relative relocs against symbols which turn out to be
6746      defined in regular objects.  For the normal shared case, discard
6747      space for pc-relative relocs that have become local due to symbol
6748      visibility changes.  */
6749
6750   if (info->shared)
6751     {
6752       /* Relocs that use pc_count are those that appear on a call
6753          insn, or certain REL relocs that can generated via assembly.
6754          We want calls to protected symbols to resolve directly to the
6755          function rather than going via the plt.  If people want
6756          function pointer comparisons to work as expected then they
6757          should avoid writing weird assembly.  */
6758       if (SYMBOL_CALLS_LOCAL (info, h))
6759         {
6760           struct elf_dyn_relocs **pp;
6761
6762           for (pp = &eh->dyn_relocs; (p = *pp) != NULL;)
6763             {
6764               p->count -= p->pc_count;
6765               p->pc_count = 0;
6766               if (p->count == 0)
6767                 *pp = p->next;
6768               else
6769                 pp = &p->next;
6770             }
6771         }
6772
6773       /* Also discard relocs on undefined weak syms with non-default
6774          visibility.  */
6775       if (eh->dyn_relocs != NULL && h->root.type == bfd_link_hash_undefweak)
6776         {
6777           if (ELF_ST_VISIBILITY (h->other) != STV_DEFAULT)
6778             eh->dyn_relocs = NULL;
6779
6780           /* Make sure undefined weak symbols are output as a dynamic
6781              symbol in PIEs.  */
6782           else if (h->dynindx == -1
6783                    && !h->forced_local
6784                    && !bfd_elf_link_record_dynamic_symbol (info, h))
6785             return FALSE;
6786         }
6787
6788     }
6789   else if (ELIMINATE_COPY_RELOCS)
6790     {
6791       /* For the non-shared case, discard space for relocs against
6792          symbols which turn out to need copy relocs or are not
6793          dynamic.  */
6794
6795       if (!h->non_got_ref
6796           && ((h->def_dynamic
6797                && !h->def_regular)
6798               || (htab->root.dynamic_sections_created
6799                   && (h->root.type == bfd_link_hash_undefweak
6800                       || h->root.type == bfd_link_hash_undefined))))
6801         {
6802           /* Make sure this symbol is output as a dynamic symbol.
6803              Undefined weak syms won't yet be marked as dynamic.  */
6804           if (h->dynindx == -1
6805               && !h->forced_local
6806               && !bfd_elf_link_record_dynamic_symbol (info, h))
6807             return FALSE;
6808
6809           /* If that succeeded, we know we'll be keeping all the
6810              relocs.  */
6811           if (h->dynindx != -1)
6812             goto keep;
6813         }
6814
6815       eh->dyn_relocs = NULL;
6816
6817     keep:;
6818     }
6819
6820   /* Finally, allocate space.  */
6821   for (p = eh->dyn_relocs; p != NULL; p = p->next)
6822     {
6823       asection *sreloc;
6824
6825       sreloc = elf_section_data (p->sec)->sreloc;
6826
6827       BFD_ASSERT (sreloc != NULL);
6828
6829       sreloc->size += p->count * RELOC_SIZE (htab);
6830     }
6831
6832   return TRUE;
6833 }
6834
6835 /* Allocate space in .plt, .got and associated reloc sections for
6836    ifunc dynamic relocs.  */
6837
6838 static bfd_boolean
6839 elfNN_aarch64_allocate_ifunc_dynrelocs (struct elf_link_hash_entry *h,
6840                                         void *inf)
6841 {
6842   struct bfd_link_info *info;
6843   struct elf_aarch64_link_hash_table *htab;
6844   struct elf_aarch64_link_hash_entry *eh;
6845
6846   /* An example of a bfd_link_hash_indirect symbol is versioned
6847      symbol. For example: __gxx_personality_v0(bfd_link_hash_indirect)
6848      -> __gxx_personality_v0(bfd_link_hash_defined)
6849
6850      There is no need to process bfd_link_hash_indirect symbols here
6851      because we will also be presented with the concrete instance of
6852      the symbol and elfNN_aarch64_copy_indirect_symbol () will have been
6853      called to copy all relevant data from the generic to the concrete
6854      symbol instance.
6855    */
6856   if (h->root.type == bfd_link_hash_indirect)
6857     return TRUE;
6858
6859   if (h->root.type == bfd_link_hash_warning)
6860     h = (struct elf_link_hash_entry *) h->root.u.i.link;
6861
6862   info = (struct bfd_link_info *) inf;
6863   htab = elf_aarch64_hash_table (info);
6864
6865   eh = (struct elf_aarch64_link_hash_entry *) h;
6866
6867   /* Since STT_GNU_IFUNC symbol must go through PLT, we handle it
6868      here if it is defined and referenced in a non-shared object.  */
6869   if (h->type == STT_GNU_IFUNC
6870       && h->def_regular)
6871     return _bfd_elf_allocate_ifunc_dyn_relocs (info, h,
6872                                                &eh->dyn_relocs,
6873                                                htab->plt_entry_size,
6874                                                htab->plt_header_size,
6875                                                GOT_ENTRY_SIZE);
6876   return TRUE;
6877 }
6878
6879 /* Allocate space in .plt, .got and associated reloc sections for
6880    local dynamic relocs.  */
6881
6882 static bfd_boolean
6883 elfNN_aarch64_allocate_local_dynrelocs (void **slot, void *inf)
6884 {
6885   struct elf_link_hash_entry *h
6886     = (struct elf_link_hash_entry *) *slot;
6887
6888   if (h->type != STT_GNU_IFUNC
6889       || !h->def_regular
6890       || !h->ref_regular
6891       || !h->forced_local
6892       || h->root.type != bfd_link_hash_defined)
6893     abort ();
6894
6895   return elfNN_aarch64_allocate_dynrelocs (h, inf);
6896 }
6897
6898 /* Allocate space in .plt, .got and associated reloc sections for
6899    local ifunc dynamic relocs.  */
6900
6901 static bfd_boolean
6902 elfNN_aarch64_allocate_local_ifunc_dynrelocs (void **slot, void *inf)
6903 {
6904   struct elf_link_hash_entry *h
6905     = (struct elf_link_hash_entry *) *slot;
6906
6907   if (h->type != STT_GNU_IFUNC
6908       || !h->def_regular
6909       || !h->ref_regular
6910       || !h->forced_local
6911       || h->root.type != bfd_link_hash_defined)
6912     abort ();
6913
6914   return elfNN_aarch64_allocate_ifunc_dynrelocs (h, inf);
6915 }
6916
6917 /* This is the most important function of all . Innocuosly named
6918    though !  */
6919 static bfd_boolean
6920 elfNN_aarch64_size_dynamic_sections (bfd *output_bfd ATTRIBUTE_UNUSED,
6921                                      struct bfd_link_info *info)
6922 {
6923   struct elf_aarch64_link_hash_table *htab;
6924   bfd *dynobj;
6925   asection *s;
6926   bfd_boolean relocs;
6927   bfd *ibfd;
6928
6929   htab = elf_aarch64_hash_table ((info));
6930   dynobj = htab->root.dynobj;
6931
6932   BFD_ASSERT (dynobj != NULL);
6933
6934   if (htab->root.dynamic_sections_created)
6935     {
6936       if (info->executable)
6937         {
6938           s = bfd_get_linker_section (dynobj, ".interp");
6939           if (s == NULL)
6940             abort ();
6941           s->size = sizeof ELF_DYNAMIC_INTERPRETER;
6942           s->contents = (unsigned char *) ELF_DYNAMIC_INTERPRETER;
6943         }
6944     }
6945
6946   /* Set up .got offsets for local syms, and space for local dynamic
6947      relocs.  */
6948   for (ibfd = info->input_bfds; ibfd != NULL; ibfd = ibfd->link.next)
6949     {
6950       struct elf_aarch64_local_symbol *locals = NULL;
6951       Elf_Internal_Shdr *symtab_hdr;
6952       asection *srel;
6953       unsigned int i;
6954
6955       if (!is_aarch64_elf (ibfd))
6956         continue;
6957
6958       for (s = ibfd->sections; s != NULL; s = s->next)
6959         {
6960           struct elf_dyn_relocs *p;
6961
6962           for (p = (struct elf_dyn_relocs *)
6963                (elf_section_data (s)->local_dynrel); p != NULL; p = p->next)
6964             {
6965               if (!bfd_is_abs_section (p->sec)
6966                   && bfd_is_abs_section (p->sec->output_section))
6967                 {
6968                   /* Input section has been discarded, either because
6969                      it is a copy of a linkonce section or due to
6970                      linker script /DISCARD/, so we'll be discarding
6971                      the relocs too.  */
6972                 }
6973               else if (p->count != 0)
6974                 {
6975                   srel = elf_section_data (p->sec)->sreloc;
6976                   srel->size += p->count * RELOC_SIZE (htab);
6977                   if ((p->sec->output_section->flags & SEC_READONLY) != 0)
6978                     info->flags |= DF_TEXTREL;
6979                 }
6980             }
6981         }
6982
6983       locals = elf_aarch64_locals (ibfd);
6984       if (!locals)
6985         continue;
6986
6987       symtab_hdr = &elf_symtab_hdr (ibfd);
6988       srel = htab->root.srelgot;
6989       for (i = 0; i < symtab_hdr->sh_info; i++)
6990         {
6991           locals[i].got_offset = (bfd_vma) - 1;
6992           locals[i].tlsdesc_got_jump_table_offset = (bfd_vma) - 1;
6993           if (locals[i].got_refcount > 0)
6994             {
6995               unsigned got_type = locals[i].got_type;
6996               if (got_type & GOT_TLSDESC_GD)
6997                 {
6998                   locals[i].tlsdesc_got_jump_table_offset =
6999                     (htab->root.sgotplt->size
7000                      - aarch64_compute_jump_table_size (htab));
7001                   htab->root.sgotplt->size += GOT_ENTRY_SIZE * 2;
7002                   locals[i].got_offset = (bfd_vma) - 2;
7003                 }
7004
7005               if (got_type & GOT_TLS_GD)
7006                 {
7007                   locals[i].got_offset = htab->root.sgot->size;
7008                   htab->root.sgot->size += GOT_ENTRY_SIZE * 2;
7009                 }
7010
7011               if (got_type & GOT_TLS_IE)
7012                 {
7013                   locals[i].got_offset = htab->root.sgot->size;
7014                   htab->root.sgot->size += GOT_ENTRY_SIZE;
7015                 }
7016
7017               if (got_type == GOT_UNKNOWN)
7018                 {
7019                 }
7020
7021               if (got_type == GOT_NORMAL)
7022                 {
7023                 }
7024
7025               if (info->shared)
7026                 {
7027                   if (got_type & GOT_TLSDESC_GD)
7028                     {
7029                       htab->root.srelplt->size += RELOC_SIZE (htab);
7030                       /* Note RELOC_COUNT not incremented here! */
7031                       htab->tlsdesc_plt = (bfd_vma) - 1;
7032                     }
7033
7034                   if (got_type & GOT_TLS_GD)
7035                     htab->root.srelgot->size += RELOC_SIZE (htab) * 2;
7036
7037                   if (got_type & GOT_TLS_IE)
7038                     htab->root.srelgot->size += RELOC_SIZE (htab);
7039                 }
7040             }
7041           else
7042             {
7043               locals[i].got_refcount = (bfd_vma) - 1;
7044             }
7045         }
7046     }
7047
7048
7049   /* Allocate global sym .plt and .got entries, and space for global
7050      sym dynamic relocs.  */
7051   elf_link_hash_traverse (&htab->root, elfNN_aarch64_allocate_dynrelocs,
7052                           info);
7053
7054   /* Allocate global ifunc sym .plt and .got entries, and space for global
7055      ifunc sym dynamic relocs.  */
7056   elf_link_hash_traverse (&htab->root, elfNN_aarch64_allocate_ifunc_dynrelocs,
7057                           info);
7058
7059   /* Allocate .plt and .got entries, and space for local symbols.  */
7060   htab_traverse (htab->loc_hash_table,
7061                  elfNN_aarch64_allocate_local_dynrelocs,
7062                  info);
7063
7064   /* Allocate .plt and .got entries, and space for local ifunc symbols.  */
7065   htab_traverse (htab->loc_hash_table,
7066                  elfNN_aarch64_allocate_local_ifunc_dynrelocs,
7067                  info);
7068
7069   /* For every jump slot reserved in the sgotplt, reloc_count is
7070      incremented.  However, when we reserve space for TLS descriptors,
7071      it's not incremented, so in order to compute the space reserved
7072      for them, it suffices to multiply the reloc count by the jump
7073      slot size.  */
7074
7075   if (htab->root.srelplt)
7076     htab->sgotplt_jump_table_size = aarch64_compute_jump_table_size (htab);
7077
7078   if (htab->tlsdesc_plt)
7079     {
7080       if (htab->root.splt->size == 0)
7081         htab->root.splt->size += PLT_ENTRY_SIZE;
7082
7083       htab->tlsdesc_plt = htab->root.splt->size;
7084       htab->root.splt->size += PLT_TLSDESC_ENTRY_SIZE;
7085
7086       /* If we're not using lazy TLS relocations, don't generate the
7087          GOT entry required.  */
7088       if (!(info->flags & DF_BIND_NOW))
7089         {
7090           htab->dt_tlsdesc_got = htab->root.sgot->size;
7091           htab->root.sgot->size += GOT_ENTRY_SIZE;
7092         }
7093     }
7094
7095   /* Init mapping symbols information to use later to distingush between
7096      code and data while scanning for erratam 835769.  */
7097   if (htab->fix_erratum_835769)
7098     for (ibfd = info->input_bfds; ibfd != NULL; ibfd = ibfd->link.next)
7099       {
7100         if (!is_aarch64_elf (ibfd))
7101           continue;
7102         bfd_elfNN_aarch64_init_maps (ibfd);
7103       }
7104
7105   /* We now have determined the sizes of the various dynamic sections.
7106      Allocate memory for them.  */
7107   relocs = FALSE;
7108   for (s = dynobj->sections; s != NULL; s = s->next)
7109     {
7110       if ((s->flags & SEC_LINKER_CREATED) == 0)
7111         continue;
7112
7113       if (s == htab->root.splt
7114           || s == htab->root.sgot
7115           || s == htab->root.sgotplt
7116           || s == htab->root.iplt
7117           || s == htab->root.igotplt || s == htab->sdynbss)
7118         {
7119           /* Strip this section if we don't need it; see the
7120              comment below.  */
7121         }
7122       else if (CONST_STRNEQ (bfd_get_section_name (dynobj, s), ".rela"))
7123         {
7124           if (s->size != 0 && s != htab->root.srelplt)
7125             relocs = TRUE;
7126
7127           /* We use the reloc_count field as a counter if we need
7128              to copy relocs into the output file.  */
7129           if (s != htab->root.srelplt)
7130             s->reloc_count = 0;
7131         }
7132       else
7133         {
7134           /* It's not one of our sections, so don't allocate space.  */
7135           continue;
7136         }
7137
7138       if (s->size == 0)
7139         {
7140           /* If we don't need this section, strip it from the
7141              output file.  This is mostly to handle .rela.bss and
7142              .rela.plt.  We must create both sections in
7143              create_dynamic_sections, because they must be created
7144              before the linker maps input sections to output
7145              sections.  The linker does that before
7146              adjust_dynamic_symbol is called, and it is that
7147              function which decides whether anything needs to go
7148              into these sections.  */
7149
7150           s->flags |= SEC_EXCLUDE;
7151           continue;
7152         }
7153
7154       if ((s->flags & SEC_HAS_CONTENTS) == 0)
7155         continue;
7156
7157       /* Allocate memory for the section contents.  We use bfd_zalloc
7158          here in case unused entries are not reclaimed before the
7159          section's contents are written out.  This should not happen,
7160          but this way if it does, we get a R_AARCH64_NONE reloc instead
7161          of garbage.  */
7162       s->contents = (bfd_byte *) bfd_zalloc (dynobj, s->size);
7163       if (s->contents == NULL)
7164         return FALSE;
7165     }
7166
7167   if (htab->root.dynamic_sections_created)
7168     {
7169       /* Add some entries to the .dynamic section.  We fill in the
7170          values later, in elfNN_aarch64_finish_dynamic_sections, but we
7171          must add the entries now so that we get the correct size for
7172          the .dynamic section.  The DT_DEBUG entry is filled in by the
7173          dynamic linker and used by the debugger.  */
7174 #define add_dynamic_entry(TAG, VAL)                     \
7175       _bfd_elf_add_dynamic_entry (info, TAG, VAL)
7176
7177       if (info->executable)
7178         {
7179           if (!add_dynamic_entry (DT_DEBUG, 0))
7180             return FALSE;
7181         }
7182
7183       if (htab->root.splt->size != 0)
7184         {
7185           if (!add_dynamic_entry (DT_PLTGOT, 0)
7186               || !add_dynamic_entry (DT_PLTRELSZ, 0)
7187               || !add_dynamic_entry (DT_PLTREL, DT_RELA)
7188               || !add_dynamic_entry (DT_JMPREL, 0))
7189             return FALSE;
7190
7191           if (htab->tlsdesc_plt
7192               && (!add_dynamic_entry (DT_TLSDESC_PLT, 0)
7193                   || !add_dynamic_entry (DT_TLSDESC_GOT, 0)))
7194             return FALSE;
7195         }
7196
7197       if (relocs)
7198         {
7199           if (!add_dynamic_entry (DT_RELA, 0)
7200               || !add_dynamic_entry (DT_RELASZ, 0)
7201               || !add_dynamic_entry (DT_RELAENT, RELOC_SIZE (htab)))
7202             return FALSE;
7203
7204           /* If any dynamic relocs apply to a read-only section,
7205              then we need a DT_TEXTREL entry.  */
7206           if ((info->flags & DF_TEXTREL) != 0)
7207             {
7208               if (!add_dynamic_entry (DT_TEXTREL, 0))
7209                 return FALSE;
7210             }
7211         }
7212     }
7213 #undef add_dynamic_entry
7214
7215   return TRUE;
7216 }
7217
7218 static inline void
7219 elf_aarch64_update_plt_entry (bfd *output_bfd,
7220                               bfd_reloc_code_real_type r_type,
7221                               bfd_byte *plt_entry, bfd_vma value)
7222 {
7223   reloc_howto_type *howto = elfNN_aarch64_howto_from_bfd_reloc (r_type);
7224
7225   _bfd_aarch64_elf_put_addend (output_bfd, plt_entry, r_type, howto, value);
7226 }
7227
7228 static void
7229 elfNN_aarch64_create_small_pltn_entry (struct elf_link_hash_entry *h,
7230                                        struct elf_aarch64_link_hash_table
7231                                        *htab, bfd *output_bfd,
7232                                        struct bfd_link_info *info)
7233 {
7234   bfd_byte *plt_entry;
7235   bfd_vma plt_index;
7236   bfd_vma got_offset;
7237   bfd_vma gotplt_entry_address;
7238   bfd_vma plt_entry_address;
7239   Elf_Internal_Rela rela;
7240   bfd_byte *loc;
7241   asection *plt, *gotplt, *relplt;
7242
7243   /* When building a static executable, use .iplt, .igot.plt and
7244      .rela.iplt sections for STT_GNU_IFUNC symbols.  */
7245   if (htab->root.splt != NULL)
7246     {
7247       plt = htab->root.splt;
7248       gotplt = htab->root.sgotplt;
7249       relplt = htab->root.srelplt;
7250     }
7251   else
7252     {
7253       plt = htab->root.iplt;
7254       gotplt = htab->root.igotplt;
7255       relplt = htab->root.irelplt;
7256     }
7257
7258   /* Get the index in the procedure linkage table which
7259      corresponds to this symbol.  This is the index of this symbol
7260      in all the symbols for which we are making plt entries.  The
7261      first entry in the procedure linkage table is reserved.
7262
7263      Get the offset into the .got table of the entry that
7264      corresponds to this function.      Each .got entry is GOT_ENTRY_SIZE
7265      bytes. The first three are reserved for the dynamic linker.
7266
7267      For static executables, we don't reserve anything.  */
7268
7269   if (plt == htab->root.splt)
7270     {
7271       plt_index = (h->plt.offset - htab->plt_header_size) / htab->plt_entry_size;
7272       got_offset = (plt_index + 3) * GOT_ENTRY_SIZE;
7273     }
7274   else
7275     {
7276       plt_index = h->plt.offset / htab->plt_entry_size;
7277       got_offset = plt_index * GOT_ENTRY_SIZE;
7278     }
7279
7280   plt_entry = plt->contents + h->plt.offset;
7281   plt_entry_address = plt->output_section->vma
7282     + plt->output_offset + h->plt.offset;
7283   gotplt_entry_address = gotplt->output_section->vma +
7284     gotplt->output_offset + got_offset;
7285
7286   /* Copy in the boiler-plate for the PLTn entry.  */
7287   memcpy (plt_entry, elfNN_aarch64_small_plt_entry, PLT_SMALL_ENTRY_SIZE);
7288
7289   /* Fill in the top 21 bits for this: ADRP x16, PLT_GOT + n * 8.
7290      ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
7291   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7292                                 plt_entry,
7293                                 PG (gotplt_entry_address) -
7294                                 PG (plt_entry_address));
7295
7296   /* Fill in the lo12 bits for the load from the pltgot.  */
7297   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_LDSTNN_LO12,
7298                                 plt_entry + 4,
7299                                 PG_OFFSET (gotplt_entry_address));
7300
7301   /* Fill in the lo12 bits for the add from the pltgot entry.  */
7302   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADD_LO12,
7303                                 plt_entry + 8,
7304                                 PG_OFFSET (gotplt_entry_address));
7305
7306   /* All the GOTPLT Entries are essentially initialized to PLT0.  */
7307   bfd_put_NN (output_bfd,
7308               plt->output_section->vma + plt->output_offset,
7309               gotplt->contents + got_offset);
7310
7311   rela.r_offset = gotplt_entry_address;
7312
7313   if (h->dynindx == -1
7314       || ((info->executable
7315            || ELF_ST_VISIBILITY (h->other) != STV_DEFAULT)
7316           && h->def_regular
7317           && h->type == STT_GNU_IFUNC))
7318     {
7319       /* If an STT_GNU_IFUNC symbol is locally defined, generate
7320          R_AARCH64_IRELATIVE instead of R_AARCH64_JUMP_SLOT.  */
7321       rela.r_info = ELFNN_R_INFO (0, AARCH64_R (IRELATIVE));
7322       rela.r_addend = (h->root.u.def.value
7323                        + h->root.u.def.section->output_section->vma
7324                        + h->root.u.def.section->output_offset);
7325     }
7326   else
7327     {
7328       /* Fill in the entry in the .rela.plt section.  */
7329       rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (JUMP_SLOT));
7330       rela.r_addend = 0;
7331     }
7332
7333   /* Compute the relocation entry to used based on PLT index and do
7334      not adjust reloc_count. The reloc_count has already been adjusted
7335      to account for this entry.  */
7336   loc = relplt->contents + plt_index * RELOC_SIZE (htab);
7337   bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
7338 }
7339
7340 /* Size sections even though they're not dynamic.  We use it to setup
7341    _TLS_MODULE_BASE_, if needed.  */
7342
7343 static bfd_boolean
7344 elfNN_aarch64_always_size_sections (bfd *output_bfd,
7345                                     struct bfd_link_info *info)
7346 {
7347   asection *tls_sec;
7348
7349   if (info->relocatable)
7350     return TRUE;
7351
7352   tls_sec = elf_hash_table (info)->tls_sec;
7353
7354   if (tls_sec)
7355     {
7356       struct elf_link_hash_entry *tlsbase;
7357
7358       tlsbase = elf_link_hash_lookup (elf_hash_table (info),
7359                                       "_TLS_MODULE_BASE_", TRUE, TRUE, FALSE);
7360
7361       if (tlsbase)
7362         {
7363           struct bfd_link_hash_entry *h = NULL;
7364           const struct elf_backend_data *bed =
7365             get_elf_backend_data (output_bfd);
7366
7367           if (!(_bfd_generic_link_add_one_symbol
7368                 (info, output_bfd, "_TLS_MODULE_BASE_", BSF_LOCAL,
7369                  tls_sec, 0, NULL, FALSE, bed->collect, &h)))
7370             return FALSE;
7371
7372           tlsbase->type = STT_TLS;
7373           tlsbase = (struct elf_link_hash_entry *) h;
7374           tlsbase->def_regular = 1;
7375           tlsbase->other = STV_HIDDEN;
7376           (*bed->elf_backend_hide_symbol) (info, tlsbase, TRUE);
7377         }
7378     }
7379
7380   return TRUE;
7381 }
7382
7383 /* Finish up dynamic symbol handling.  We set the contents of various
7384    dynamic sections here.  */
7385 static bfd_boolean
7386 elfNN_aarch64_finish_dynamic_symbol (bfd *output_bfd,
7387                                      struct bfd_link_info *info,
7388                                      struct elf_link_hash_entry *h,
7389                                      Elf_Internal_Sym *sym)
7390 {
7391   struct elf_aarch64_link_hash_table *htab;
7392   htab = elf_aarch64_hash_table (info);
7393
7394   if (h->plt.offset != (bfd_vma) - 1)
7395     {
7396       asection *plt, *gotplt, *relplt;
7397
7398       /* This symbol has an entry in the procedure linkage table.  Set
7399          it up.  */
7400
7401       /* When building a static executable, use .iplt, .igot.plt and
7402          .rela.iplt sections for STT_GNU_IFUNC symbols.  */
7403       if (htab->root.splt != NULL)
7404         {
7405           plt = htab->root.splt;
7406           gotplt = htab->root.sgotplt;
7407           relplt = htab->root.srelplt;
7408         }
7409       else
7410         {
7411           plt = htab->root.iplt;
7412           gotplt = htab->root.igotplt;
7413           relplt = htab->root.irelplt;
7414         }
7415
7416       /* This symbol has an entry in the procedure linkage table.  Set
7417          it up.  */
7418       if ((h->dynindx == -1
7419            && !((h->forced_local || info->executable)
7420                 && h->def_regular
7421                 && h->type == STT_GNU_IFUNC))
7422           || plt == NULL
7423           || gotplt == NULL
7424           || relplt == NULL)
7425         abort ();
7426
7427       elfNN_aarch64_create_small_pltn_entry (h, htab, output_bfd, info);
7428       if (!h->def_regular)
7429         {
7430           /* Mark the symbol as undefined, rather than as defined in
7431              the .plt section.  Leave the value alone.  This is a clue
7432              for the dynamic linker, to make function pointer
7433              comparisons work between an application and shared
7434              library.  */
7435           sym->st_shndx = SHN_UNDEF;
7436         }
7437     }
7438
7439   if (h->got.offset != (bfd_vma) - 1
7440       && elf_aarch64_hash_entry (h)->got_type == GOT_NORMAL)
7441     {
7442       Elf_Internal_Rela rela;
7443       bfd_byte *loc;
7444
7445       /* This symbol has an entry in the global offset table.  Set it
7446          up.  */
7447       if (htab->root.sgot == NULL || htab->root.srelgot == NULL)
7448         abort ();
7449
7450       rela.r_offset = (htab->root.sgot->output_section->vma
7451                        + htab->root.sgot->output_offset
7452                        + (h->got.offset & ~(bfd_vma) 1));
7453
7454       if (h->def_regular
7455           && h->type == STT_GNU_IFUNC)
7456         {
7457           if (info->shared)
7458             {
7459               /* Generate R_AARCH64_GLOB_DAT.  */
7460               goto do_glob_dat;
7461             }
7462           else
7463             {
7464               asection *plt;
7465
7466               if (!h->pointer_equality_needed)
7467                 abort ();
7468
7469               /* For non-shared object, we can't use .got.plt, which
7470                  contains the real function address if we need pointer
7471                  equality.  We load the GOT entry with the PLT entry.  */
7472               plt = htab->root.splt ? htab->root.splt : htab->root.iplt;
7473               bfd_put_NN (output_bfd, (plt->output_section->vma
7474                                        + plt->output_offset
7475                                        + h->plt.offset),
7476                           htab->root.sgot->contents
7477                           + (h->got.offset & ~(bfd_vma) 1));
7478               return TRUE;
7479             }
7480         }
7481       else if (info->shared && SYMBOL_REFERENCES_LOCAL (info, h))
7482         {
7483           if (!h->def_regular)
7484             return FALSE;
7485
7486           BFD_ASSERT ((h->got.offset & 1) != 0);
7487           rela.r_info = ELFNN_R_INFO (0, AARCH64_R (RELATIVE));
7488           rela.r_addend = (h->root.u.def.value
7489                            + h->root.u.def.section->output_section->vma
7490                            + h->root.u.def.section->output_offset);
7491         }
7492       else
7493         {
7494 do_glob_dat:
7495           BFD_ASSERT ((h->got.offset & 1) == 0);
7496           bfd_put_NN (output_bfd, (bfd_vma) 0,
7497                       htab->root.sgot->contents + h->got.offset);
7498           rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (GLOB_DAT));
7499           rela.r_addend = 0;
7500         }
7501
7502       loc = htab->root.srelgot->contents;
7503       loc += htab->root.srelgot->reloc_count++ * RELOC_SIZE (htab);
7504       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
7505     }
7506
7507   if (h->needs_copy)
7508     {
7509       Elf_Internal_Rela rela;
7510       bfd_byte *loc;
7511
7512       /* This symbol needs a copy reloc.  Set it up.  */
7513
7514       if (h->dynindx == -1
7515           || (h->root.type != bfd_link_hash_defined
7516               && h->root.type != bfd_link_hash_defweak)
7517           || htab->srelbss == NULL)
7518         abort ();
7519
7520       rela.r_offset = (h->root.u.def.value
7521                        + h->root.u.def.section->output_section->vma
7522                        + h->root.u.def.section->output_offset);
7523       rela.r_info = ELFNN_R_INFO (h->dynindx, AARCH64_R (COPY));
7524       rela.r_addend = 0;
7525       loc = htab->srelbss->contents;
7526       loc += htab->srelbss->reloc_count++ * RELOC_SIZE (htab);
7527       bfd_elfNN_swap_reloca_out (output_bfd, &rela, loc);
7528     }
7529
7530   /* Mark _DYNAMIC and _GLOBAL_OFFSET_TABLE_ as absolute.  SYM may
7531      be NULL for local symbols.  */
7532   if (sym != NULL
7533       && (h == elf_hash_table (info)->hdynamic
7534           || h == elf_hash_table (info)->hgot))
7535     sym->st_shndx = SHN_ABS;
7536
7537   return TRUE;
7538 }
7539
7540 /* Finish up local dynamic symbol handling.  We set the contents of
7541    various dynamic sections here.  */
7542
7543 static bfd_boolean
7544 elfNN_aarch64_finish_local_dynamic_symbol (void **slot, void *inf)
7545 {
7546   struct elf_link_hash_entry *h
7547     = (struct elf_link_hash_entry *) *slot;
7548   struct bfd_link_info *info
7549     = (struct bfd_link_info *) inf;
7550
7551   return elfNN_aarch64_finish_dynamic_symbol (info->output_bfd,
7552                                               info, h, NULL);
7553 }
7554
7555 static void
7556 elfNN_aarch64_init_small_plt0_entry (bfd *output_bfd ATTRIBUTE_UNUSED,
7557                                      struct elf_aarch64_link_hash_table
7558                                      *htab)
7559 {
7560   /* Fill in PLT0. Fixme:RR Note this doesn't distinguish between
7561      small and large plts and at the minute just generates
7562      the small PLT.  */
7563
7564   /* PLT0 of the small PLT looks like this in ELF64 -
7565      stp x16, x30, [sp, #-16]!          // Save the reloc and lr on stack.
7566      adrp x16, PLT_GOT + 16             // Get the page base of the GOTPLT
7567      ldr  x17, [x16, #:lo12:PLT_GOT+16] // Load the address of the
7568                                         // symbol resolver
7569      add  x16, x16, #:lo12:PLT_GOT+16   // Load the lo12 bits of the
7570                                         // GOTPLT entry for this.
7571      br   x17
7572      PLT0 will be slightly different in ELF32 due to different got entry
7573      size.
7574    */
7575   bfd_vma plt_got_2nd_ent;      /* Address of GOT[2].  */
7576   bfd_vma plt_base;
7577
7578
7579   memcpy (htab->root.splt->contents, elfNN_aarch64_small_plt0_entry,
7580           PLT_ENTRY_SIZE);
7581   elf_section_data (htab->root.splt->output_section)->this_hdr.sh_entsize =
7582     PLT_ENTRY_SIZE;
7583
7584   plt_got_2nd_ent = (htab->root.sgotplt->output_section->vma
7585                   + htab->root.sgotplt->output_offset
7586                   + GOT_ENTRY_SIZE * 2);
7587
7588   plt_base = htab->root.splt->output_section->vma +
7589     htab->root.splt->output_offset;
7590
7591   /* Fill in the top 21 bits for this: ADRP x16, PLT_GOT + n * 8.
7592      ADRP:   ((PG(S+A)-PG(P)) >> 12) & 0x1fffff */
7593   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7594                                 htab->root.splt->contents + 4,
7595                                 PG (plt_got_2nd_ent) - PG (plt_base + 4));
7596
7597   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_LDSTNN_LO12,
7598                                 htab->root.splt->contents + 8,
7599                                 PG_OFFSET (plt_got_2nd_ent));
7600
7601   elf_aarch64_update_plt_entry (output_bfd, BFD_RELOC_AARCH64_ADD_LO12,
7602                                 htab->root.splt->contents + 12,
7603                                 PG_OFFSET (plt_got_2nd_ent));
7604 }
7605
7606 static bfd_boolean
7607 elfNN_aarch64_finish_dynamic_sections (bfd *output_bfd,
7608                                        struct bfd_link_info *info)
7609 {
7610   struct elf_aarch64_link_hash_table *htab;
7611   bfd *dynobj;
7612   asection *sdyn;
7613
7614   htab = elf_aarch64_hash_table (info);
7615   dynobj = htab->root.dynobj;
7616   sdyn = bfd_get_linker_section (dynobj, ".dynamic");
7617
7618   if (htab->root.dynamic_sections_created)
7619     {
7620       ElfNN_External_Dyn *dyncon, *dynconend;
7621
7622       if (sdyn == NULL || htab->root.sgot == NULL)
7623         abort ();
7624
7625       dyncon = (ElfNN_External_Dyn *) sdyn->contents;
7626       dynconend = (ElfNN_External_Dyn *) (sdyn->contents + sdyn->size);
7627       for (; dyncon < dynconend; dyncon++)
7628         {
7629           Elf_Internal_Dyn dyn;
7630           asection *s;
7631
7632           bfd_elfNN_swap_dyn_in (dynobj, dyncon, &dyn);
7633
7634           switch (dyn.d_tag)
7635             {
7636             default:
7637               continue;
7638
7639             case DT_PLTGOT:
7640               s = htab->root.sgotplt;
7641               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset;
7642               break;
7643
7644             case DT_JMPREL:
7645               dyn.d_un.d_ptr = htab->root.srelplt->output_section->vma;
7646               break;
7647
7648             case DT_PLTRELSZ:
7649               s = htab->root.srelplt;
7650               dyn.d_un.d_val = s->size;
7651               break;
7652
7653             case DT_RELASZ:
7654               /* The procedure linkage table relocs (DT_JMPREL) should
7655                  not be included in the overall relocs (DT_RELA).
7656                  Therefore, we override the DT_RELASZ entry here to
7657                  make it not include the JMPREL relocs.  Since the
7658                  linker script arranges for .rela.plt to follow all
7659                  other relocation sections, we don't have to worry
7660                  about changing the DT_RELA entry.  */
7661               if (htab->root.srelplt != NULL)
7662                 {
7663                   s = htab->root.srelplt;
7664                   dyn.d_un.d_val -= s->size;
7665                 }
7666               break;
7667
7668             case DT_TLSDESC_PLT:
7669               s = htab->root.splt;
7670               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset
7671                 + htab->tlsdesc_plt;
7672               break;
7673
7674             case DT_TLSDESC_GOT:
7675               s = htab->root.sgot;
7676               dyn.d_un.d_ptr = s->output_section->vma + s->output_offset
7677                 + htab->dt_tlsdesc_got;
7678               break;
7679             }
7680
7681           bfd_elfNN_swap_dyn_out (output_bfd, &dyn, dyncon);
7682         }
7683
7684     }
7685
7686   /* Fill in the special first entry in the procedure linkage table.  */
7687   if (htab->root.splt && htab->root.splt->size > 0)
7688     {
7689       elfNN_aarch64_init_small_plt0_entry (output_bfd, htab);
7690
7691       elf_section_data (htab->root.splt->output_section)->
7692         this_hdr.sh_entsize = htab->plt_entry_size;
7693
7694
7695       if (htab->tlsdesc_plt)
7696         {
7697           bfd_put_NN (output_bfd, (bfd_vma) 0,
7698                       htab->root.sgot->contents + htab->dt_tlsdesc_got);
7699
7700           memcpy (htab->root.splt->contents + htab->tlsdesc_plt,
7701                   elfNN_aarch64_tlsdesc_small_plt_entry,
7702                   sizeof (elfNN_aarch64_tlsdesc_small_plt_entry));
7703
7704           {
7705             bfd_vma adrp1_addr =
7706               htab->root.splt->output_section->vma
7707               + htab->root.splt->output_offset + htab->tlsdesc_plt + 4;
7708
7709             bfd_vma adrp2_addr = adrp1_addr + 4;
7710
7711             bfd_vma got_addr =
7712               htab->root.sgot->output_section->vma
7713               + htab->root.sgot->output_offset;
7714
7715             bfd_vma pltgot_addr =
7716               htab->root.sgotplt->output_section->vma
7717               + htab->root.sgotplt->output_offset;
7718
7719             bfd_vma dt_tlsdesc_got = got_addr + htab->dt_tlsdesc_got;
7720
7721             bfd_byte *plt_entry =
7722               htab->root.splt->contents + htab->tlsdesc_plt;
7723
7724             /* adrp x2, DT_TLSDESC_GOT */
7725             elf_aarch64_update_plt_entry (output_bfd,
7726                                           BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7727                                           plt_entry + 4,
7728                                           (PG (dt_tlsdesc_got)
7729                                            - PG (adrp1_addr)));
7730
7731             /* adrp x3, 0 */
7732             elf_aarch64_update_plt_entry (output_bfd,
7733                                           BFD_RELOC_AARCH64_ADR_HI21_PCREL,
7734                                           plt_entry + 8,
7735                                           (PG (pltgot_addr)
7736                                            - PG (adrp2_addr)));
7737
7738             /* ldr x2, [x2, #0] */
7739             elf_aarch64_update_plt_entry (output_bfd,
7740                                           BFD_RELOC_AARCH64_LDSTNN_LO12,
7741                                           plt_entry + 12,
7742                                           PG_OFFSET (dt_tlsdesc_got));
7743
7744             /* add x3, x3, 0 */
7745             elf_aarch64_update_plt_entry (output_bfd,
7746                                           BFD_RELOC_AARCH64_ADD_LO12,
7747                                           plt_entry + 16,
7748                                           PG_OFFSET (pltgot_addr));
7749           }
7750         }
7751     }
7752
7753   if (htab->root.sgotplt)
7754     {
7755       if (bfd_is_abs_section (htab->root.sgotplt->output_section))
7756         {
7757           (*_bfd_error_handler)
7758             (_("discarded output section: `%A'"), htab->root.sgotplt);
7759           return FALSE;
7760         }
7761
7762       /* Fill in the first three entries in the global offset table.  */
7763       if (htab->root.sgotplt->size > 0)
7764         {
7765           bfd_put_NN (output_bfd, (bfd_vma) 0, htab->root.sgotplt->contents);
7766
7767           /* Write GOT[1] and GOT[2], needed for the dynamic linker.  */
7768           bfd_put_NN (output_bfd,
7769                       (bfd_vma) 0,
7770                       htab->root.sgotplt->contents + GOT_ENTRY_SIZE);
7771           bfd_put_NN (output_bfd,
7772                       (bfd_vma) 0,
7773                       htab->root.sgotplt->contents + GOT_ENTRY_SIZE * 2);
7774         }
7775
7776       if (htab->root.sgot)
7777         {
7778           if (htab->root.sgot->size > 0)
7779             {
7780               bfd_vma addr =
7781                 sdyn ? sdyn->output_section->vma + sdyn->output_offset : 0;
7782               bfd_put_NN (output_bfd, addr, htab->root.sgot->contents);
7783             }
7784         }
7785
7786       elf_section_data (htab->root.sgotplt->output_section)->
7787         this_hdr.sh_entsize = GOT_ENTRY_SIZE;
7788     }
7789
7790   if (htab->root.sgot && htab->root.sgot->size > 0)
7791     elf_section_data (htab->root.sgot->output_section)->this_hdr.sh_entsize
7792       = GOT_ENTRY_SIZE;
7793
7794   /* Fill PLT and GOT entries for local STT_GNU_IFUNC symbols.  */
7795   htab_traverse (htab->loc_hash_table,
7796                  elfNN_aarch64_finish_local_dynamic_symbol,
7797                  info);
7798
7799   return TRUE;
7800 }
7801
7802 /* Return address for Ith PLT stub in section PLT, for relocation REL
7803    or (bfd_vma) -1 if it should not be included.  */
7804
7805 static bfd_vma
7806 elfNN_aarch64_plt_sym_val (bfd_vma i, const asection *plt,
7807                            const arelent *rel ATTRIBUTE_UNUSED)
7808 {
7809   return plt->vma + PLT_ENTRY_SIZE + i * PLT_SMALL_ENTRY_SIZE;
7810 }
7811
7812
7813 /* We use this so we can override certain functions
7814    (though currently we don't).  */
7815
7816 const struct elf_size_info elfNN_aarch64_size_info =
7817 {
7818   sizeof (ElfNN_External_Ehdr),
7819   sizeof (ElfNN_External_Phdr),
7820   sizeof (ElfNN_External_Shdr),
7821   sizeof (ElfNN_External_Rel),
7822   sizeof (ElfNN_External_Rela),
7823   sizeof (ElfNN_External_Sym),
7824   sizeof (ElfNN_External_Dyn),
7825   sizeof (Elf_External_Note),
7826   4,                            /* Hash table entry size.  */
7827   1,                            /* Internal relocs per external relocs.  */
7828   ARCH_SIZE,                    /* Arch size.  */
7829   LOG_FILE_ALIGN,               /* Log_file_align.  */
7830   ELFCLASSNN, EV_CURRENT,
7831   bfd_elfNN_write_out_phdrs,
7832   bfd_elfNN_write_shdrs_and_ehdr,
7833   bfd_elfNN_checksum_contents,
7834   bfd_elfNN_write_relocs,
7835   bfd_elfNN_swap_symbol_in,
7836   bfd_elfNN_swap_symbol_out,
7837   bfd_elfNN_slurp_reloc_table,
7838   bfd_elfNN_slurp_symbol_table,
7839   bfd_elfNN_swap_dyn_in,
7840   bfd_elfNN_swap_dyn_out,
7841   bfd_elfNN_swap_reloc_in,
7842   bfd_elfNN_swap_reloc_out,
7843   bfd_elfNN_swap_reloca_in,
7844   bfd_elfNN_swap_reloca_out
7845 };
7846
7847 #define ELF_ARCH                        bfd_arch_aarch64
7848 #define ELF_MACHINE_CODE                EM_AARCH64
7849 #define ELF_MAXPAGESIZE                 0x10000
7850 #define ELF_MINPAGESIZE                 0x1000
7851 #define ELF_COMMONPAGESIZE              0x1000
7852
7853 #define bfd_elfNN_close_and_cleanup             \
7854   elfNN_aarch64_close_and_cleanup
7855
7856 #define bfd_elfNN_bfd_free_cached_info          \
7857   elfNN_aarch64_bfd_free_cached_info
7858
7859 #define bfd_elfNN_bfd_is_target_special_symbol  \
7860   elfNN_aarch64_is_target_special_symbol
7861
7862 #define bfd_elfNN_bfd_link_hash_table_create    \
7863   elfNN_aarch64_link_hash_table_create
7864
7865 #define bfd_elfNN_bfd_merge_private_bfd_data    \
7866   elfNN_aarch64_merge_private_bfd_data
7867
7868 #define bfd_elfNN_bfd_print_private_bfd_data    \
7869   elfNN_aarch64_print_private_bfd_data
7870
7871 #define bfd_elfNN_bfd_reloc_type_lookup         \
7872   elfNN_aarch64_reloc_type_lookup
7873
7874 #define bfd_elfNN_bfd_reloc_name_lookup         \
7875   elfNN_aarch64_reloc_name_lookup
7876
7877 #define bfd_elfNN_bfd_set_private_flags         \
7878   elfNN_aarch64_set_private_flags
7879
7880 #define bfd_elfNN_find_inliner_info             \
7881   elfNN_aarch64_find_inliner_info
7882
7883 #define bfd_elfNN_find_nearest_line             \
7884   elfNN_aarch64_find_nearest_line
7885
7886 #define bfd_elfNN_mkobject                      \
7887   elfNN_aarch64_mkobject
7888
7889 #define bfd_elfNN_new_section_hook              \
7890   elfNN_aarch64_new_section_hook
7891
7892 #define elf_backend_adjust_dynamic_symbol       \
7893   elfNN_aarch64_adjust_dynamic_symbol
7894
7895 #define elf_backend_always_size_sections        \
7896   elfNN_aarch64_always_size_sections
7897
7898 #define elf_backend_check_relocs                \
7899   elfNN_aarch64_check_relocs
7900
7901 #define elf_backend_copy_indirect_symbol        \
7902   elfNN_aarch64_copy_indirect_symbol
7903
7904 /* Create .dynbss, and .rela.bss sections in DYNOBJ, and set up shortcuts
7905    to them in our hash.  */
7906 #define elf_backend_create_dynamic_sections     \
7907   elfNN_aarch64_create_dynamic_sections
7908
7909 #define elf_backend_init_index_section          \
7910   _bfd_elf_init_2_index_sections
7911
7912 #define elf_backend_finish_dynamic_sections     \
7913   elfNN_aarch64_finish_dynamic_sections
7914
7915 #define elf_backend_finish_dynamic_symbol       \
7916   elfNN_aarch64_finish_dynamic_symbol
7917
7918 #define elf_backend_gc_sweep_hook               \
7919   elfNN_aarch64_gc_sweep_hook
7920
7921 #define elf_backend_object_p                    \
7922   elfNN_aarch64_object_p
7923
7924 #define elf_backend_output_arch_local_syms      \
7925   elfNN_aarch64_output_arch_local_syms
7926
7927 #define elf_backend_plt_sym_val                 \
7928   elfNN_aarch64_plt_sym_val
7929
7930 #define elf_backend_post_process_headers        \
7931   elfNN_aarch64_post_process_headers
7932
7933 #define elf_backend_relocate_section            \
7934   elfNN_aarch64_relocate_section
7935
7936 #define elf_backend_reloc_type_class            \
7937   elfNN_aarch64_reloc_type_class
7938
7939 #define elf_backend_section_from_shdr           \
7940   elfNN_aarch64_section_from_shdr
7941
7942 #define elf_backend_size_dynamic_sections       \
7943   elfNN_aarch64_size_dynamic_sections
7944
7945 #define elf_backend_size_info                   \
7946   elfNN_aarch64_size_info
7947
7948 #define elf_backend_write_section               \
7949   elfNN_aarch64_write_section
7950
7951 #define elf_backend_can_refcount       1
7952 #define elf_backend_can_gc_sections    1
7953 #define elf_backend_plt_readonly       1
7954 #define elf_backend_want_got_plt       1
7955 #define elf_backend_want_plt_sym       0
7956 #define elf_backend_may_use_rel_p      0
7957 #define elf_backend_may_use_rela_p     1
7958 #define elf_backend_default_use_rela_p 1
7959 #define elf_backend_rela_normal        1
7960 #define elf_backend_got_header_size (GOT_ENTRY_SIZE * 3)
7961 #define elf_backend_default_execstack  0
7962
7963 #undef  elf_backend_obj_attrs_section
7964 #define elf_backend_obj_attrs_section           ".ARM.attributes"
7965
7966 #include "elfNN-target.h"