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