~ubuntu-branches/ubuntu/precise/ghc/precise
» Revision
11
: .pc/linker-partially-stripped-objects/rts/Linker.c
« back to all changes in this revision
Viewing changes to .pc/linker-partially-stripped-objects/rts/Linker.c
- browse files at revision 11
- compare with another revision
- download diff
- download tarball
- view history from revision 11
- Committer: Bazaar Package Importer
- Author(s): Iain Lane
- Date: 2011-08-10 11:50:56 UTC
- Revision ID: james.westby@ubuntu.com-20110810115056-10omvh0gszquj5cn
Tags: 7.0.3-1ubuntu3
Cherry-pick upstream commit cfbf0eb to support partially stripped object
files in the GHCi linker. Fixes loading the ghc package in GHCi and
associated compilation failures. Patch by Duncan Coutts
<duncan@well-typed.com>. (LP: #820847)
files in the GHCi linker. Fixes loading the ghc package in GHCi and
associated compilation failures. Patch by Duncan Coutts
<duncan@well-typed.com>. (LP: #820847)
- files added:
- .pc/linker-partially-stripped-objects
- .pc/linker-partially-stripped-objects/rts
- files modified:
- .pc/applied-patches
added
removed
.pc/linker-partially-stripped-objects/rts/Linker.c
1
/* -----------------------------------------------------------------------------
2
*
3
* (c) The GHC Team, 2000-2004
4
*
5
* RTS Object Linker
6
*
7
* ---------------------------------------------------------------------------*/
8
9
#if 0
10
#include "PosixSource.h"
11
#endif
12
13
/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14
MREMAP_MAYMOVE from <sys/mman.h>.
15
*/
16
#if defined(__linux__) || defined(__GLIBC__)
17
#define _GNU_SOURCE 1
18
#endif
19
20
#include "Rts.h"
21
#include "HsFFI.h"
22
23
#include "sm/Storage.h"
24
#include "Stats.h"
25
#include "Hash.h"
26
#include "LinkerInternals.h"
27
#include "RtsUtils.h"
28
#include "Trace.h"
29
#include "StgPrimFloat.h" // for __int_encodeFloat etc.
30
#include "Stable.h"
31
32
#if !defined(mingw32_HOST_OS)
33
#include "posix/Signals.h"
34
#endif
35
36
// get protos for is*()
37
#include <ctype.h>
38
39
#ifdef HAVE_SYS_TYPES_H
40
#include <sys/types.h>
41
#endif
42
43
#include <inttypes.h>
44
#include <stdlib.h>
45
#include <string.h>
46
#include <stdio.h>
47
#include <assert.h>
48
49
#ifdef HAVE_SYS_STAT_H
50
#include <sys/stat.h>
51
#endif
52
53
#if defined(HAVE_DLFCN_H)
54
#include <dlfcn.h>
55
#endif
56
57
#if defined(cygwin32_HOST_OS)
58
#ifdef HAVE_DIRENT_H
59
#include <dirent.h>
60
#endif
61
62
#ifdef HAVE_SYS_TIME_H
63
#include <sys/time.h>
64
#endif
65
#include <regex.h>
66
#include <sys/fcntl.h>
67
#include <sys/termios.h>
68
#include <sys/utime.h>
69
#include <sys/utsname.h>
70
#include <sys/wait.h>
71
#endif
72
73
#if !defined(powerpc_HOST_ARCH) && \
74
( defined(linux_HOST_OS ) || defined(freebsd_HOST_OS) || \
75
defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS ) || \
76
defined(openbsd_HOST_OS ) || defined(darwin_HOST_OS ) || \
77
defined(kfreebsdgnu_HOST_OS) )
78
/* Don't use mmap on powerpc_HOST_ARCH as mmap doesn't support
79
* reallocating but we need to allocate jump islands just after each
80
* object images. Otherwise relative branches to jump islands can fail
81
* due to 24-bits displacement overflow.
82
*/
83
#define USE_MMAP
84
#include <fcntl.h>
85
#include <sys/mman.h>
86
87
#ifdef HAVE_UNISTD_H
88
#include <unistd.h>
89
#endif
90
91
#endif
92
93
#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
94
# define OBJFORMAT_ELF
95
# include <regex.h> // regex is already used by dlopen() so this is OK
96
// to use here without requiring an additional lib
97
#elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
98
# define OBJFORMAT_PEi386
99
# include <windows.h>
100
# include <math.h>
101
#elif defined(darwin_HOST_OS)
102
# define OBJFORMAT_MACHO
103
# include <regex.h>
104
# include <mach-o/loader.h>
105
# include <mach-o/nlist.h>
106
# include <mach-o/reloc.h>
107
#if !defined(HAVE_DLFCN_H)
108
# include <mach-o/dyld.h>
109
#endif
110
#if defined(powerpc_HOST_ARCH)
111
# include <mach-o/ppc/reloc.h>
112
#endif
113
#if defined(x86_64_HOST_ARCH)
114
# include <mach-o/x86_64/reloc.h>
115
#endif
116
#endif
117
118
#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
119
#define ALWAYS_PIC
120
#endif
121
122
/* Hash table mapping symbol names to Symbol */
123
static /*Str*/HashTable *symhash;
124
125
/* Hash table mapping symbol names to StgStablePtr */
126
static /*Str*/HashTable *stablehash;
127
128
/* List of currently loaded objects */
129
ObjectCode *objects = NULL; /* initially empty */
130
131
static HsInt loadOc( ObjectCode* oc );
132
static ObjectCode* mkOc( char *path, char *image, int imageSize,
133
char *archiveMemberName
134
#ifndef USE_MMAP
135
#ifdef powerpc_HOST_ARCH
136
, int misalignment
137
#endif
138
#endif
139
);
140
141
#if defined(OBJFORMAT_ELF)
142
static int ocVerifyImage_ELF ( ObjectCode* oc );
143
static int ocGetNames_ELF ( ObjectCode* oc );
144
static int ocResolve_ELF ( ObjectCode* oc );
145
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
146
static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
147
#endif
148
#elif defined(OBJFORMAT_PEi386)
149
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
150
static int ocGetNames_PEi386 ( ObjectCode* oc );
151
static int ocResolve_PEi386 ( ObjectCode* oc );
152
static void *lookupSymbolInDLLs ( unsigned char *lbl );
153
static void zapTrailingAtSign ( unsigned char *sym );
154
#elif defined(OBJFORMAT_MACHO)
155
static int ocVerifyImage_MachO ( ObjectCode* oc );
156
static int ocGetNames_MachO ( ObjectCode* oc );
157
static int ocResolve_MachO ( ObjectCode* oc );
158
159
#if !defined USE_MMAP && defined(darwin_HOST_OS)
160
static int machoGetMisalignment( FILE * );
161
#endif
162
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
163
static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
164
#endif
165
#ifdef powerpc_HOST_ARCH
166
static void machoInitSymbolsWithoutUnderscore( void );
167
#endif
168
#endif
169
170
/* on x86_64 we have a problem with relocating symbol references in
171
* code that was compiled without -fPIC. By default, the small memory
172
* model is used, which assumes that symbol references can fit in a
173
* 32-bit slot. The system dynamic linker makes this work for
174
* references to shared libraries by either (a) allocating a jump
175
* table slot for code references, or (b) moving the symbol at load
176
* time (and copying its contents, if necessary) for data references.
177
*
178
* We unfortunately can't tell whether symbol references are to code
179
* or data. So for now we assume they are code (the vast majority
180
* are), and allocate jump-table slots. Unfortunately this will
181
* SILENTLY generate crashing code for data references. This hack is
182
* enabled by X86_64_ELF_NONPIC_HACK.
183
*
184
* One workaround is to use shared Haskell libraries. This is
185
* coming. Another workaround is to keep the static libraries but
186
* compile them with -fPIC, because that will generate PIC references
187
* to data which can be relocated. The PIC code is still too green to
188
* do this systematically, though.
189
*
190
* See bug #781
191
* See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
192
*
193
* Naming Scheme for Symbol Macros
194
*
195
* SymI_*: symbol is internal to the RTS. It resides in an object
196
* file/library that is statically.
197
* SymE_*: symbol is external to the RTS library. It might be linked
198
* dynamically.
199
*
200
* Sym*_HasProto : the symbol prototype is imported in an include file
201
* or defined explicitly
202
* Sym*_NeedsProto: the symbol is undefined and we add a dummy
203
* default proto extern void sym(void);
204
*/
205
#define X86_64_ELF_NONPIC_HACK 1
206
207
/* Link objects into the lower 2Gb on x86_64. GHC assumes the
208
* small memory model on this architecture (see gcc docs,
209
* -mcmodel=small).
210
*
211
* MAP_32BIT not available on OpenBSD/amd64
212
*/
213
#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
214
#define TRY_MAP_32BIT MAP_32BIT
215
#else
216
#define TRY_MAP_32BIT 0
217
#endif
218
219
/*
220
* Due to the small memory model (see above), on x86_64 we have to map
221
* all our non-PIC object files into the low 2Gb of the address space
222
* (why 2Gb and not 4Gb? Because all addresses must be reachable
223
* using a 32-bit signed PC-relative offset). On Linux we can do this
224
* using the MAP_32BIT flag to mmap(), however on other OSs
225
* (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
226
* can't do this. So on these systems, we have to pick a base address
227
* in the low 2Gb of the address space and try to allocate memory from
228
* there.
229
*
230
* We pick a default address based on the OS, but also make this
231
* configurable via an RTS flag (+RTS -xm)
232
*/
233
#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
234
235
#if defined(MAP_32BIT)
236
// Try to use MAP_32BIT
237
#define MMAP_32BIT_BASE_DEFAULT 0
238
#else
239
// A guess: 1Gb.
240
#define MMAP_32BIT_BASE_DEFAULT 0x40000000
241
#endif
242
243
static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
244
#endif
245
246
/* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
247
#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
248
#define MAP_ANONYMOUS MAP_ANON
249
#endif
250
251
/* -----------------------------------------------------------------------------
252
* Built-in symbols from the RTS
253
*/
254
255
typedef struct _RtsSymbolVal {
256
char *lbl;
257
void *addr;
258
} RtsSymbolVal;
259
260
#define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
261
SymI_HasProto(stg_mkWeakForeignEnvzh) \
262
SymI_HasProto(stg_makeStableNamezh) \
263
SymI_HasProto(stg_finalizzeWeakzh)
264
265
#if !defined (mingw32_HOST_OS)
266
#define RTS_POSIX_ONLY_SYMBOLS \
267
SymI_HasProto(__hscore_get_saved_termios) \
268
SymI_HasProto(__hscore_set_saved_termios) \
269
SymI_HasProto(shutdownHaskellAndSignal) \
270
SymI_HasProto(lockFile) \
271
SymI_HasProto(unlockFile) \
272
SymI_HasProto(signal_handlers) \
273
SymI_HasProto(stg_sig_install) \
274
SymI_HasProto(rtsTimerSignal) \
275
SymI_NeedsProto(nocldstop)
276
#endif
277
278
#if defined (cygwin32_HOST_OS)
279
#define RTS_MINGW_ONLY_SYMBOLS /**/
280
/* Don't have the ability to read import libs / archives, so
281
* we have to stupidly list a lot of what libcygwin.a
282
* exports; sigh.
283
*/
284
#define RTS_CYGWIN_ONLY_SYMBOLS \
285
SymI_HasProto(regfree) \
286
SymI_HasProto(regexec) \
287
SymI_HasProto(regerror) \
288
SymI_HasProto(regcomp) \
289
SymI_HasProto(__errno) \
290
SymI_HasProto(access) \
291
SymI_HasProto(chmod) \
292
SymI_HasProto(chdir) \
293
SymI_HasProto(close) \
294
SymI_HasProto(creat) \
295
SymI_HasProto(dup) \
296
SymI_HasProto(dup2) \
297
SymI_HasProto(fstat) \
298
SymI_HasProto(fcntl) \
299
SymI_HasProto(getcwd) \
300
SymI_HasProto(getenv) \
301
SymI_HasProto(lseek) \
302
SymI_HasProto(open) \
303
SymI_HasProto(fpathconf) \
304
SymI_HasProto(pathconf) \
305
SymI_HasProto(stat) \
306
SymI_HasProto(pow) \
307
SymI_HasProto(tanh) \
308
SymI_HasProto(cosh) \
309
SymI_HasProto(sinh) \
310
SymI_HasProto(atan) \
311
SymI_HasProto(acos) \
312
SymI_HasProto(asin) \
313
SymI_HasProto(tan) \
314
SymI_HasProto(cos) \
315
SymI_HasProto(sin) \
316
SymI_HasProto(exp) \
317
SymI_HasProto(log) \
318
SymI_HasProto(sqrt) \
319
SymI_HasProto(localtime_r) \
320
SymI_HasProto(gmtime_r) \
321
SymI_HasProto(mktime) \
322
SymI_NeedsProto(_imp___tzname) \
323
SymI_HasProto(gettimeofday) \
324
SymI_HasProto(timezone) \
325
SymI_HasProto(tcgetattr) \
326
SymI_HasProto(tcsetattr) \
327
SymI_HasProto(memcpy) \
328
SymI_HasProto(memmove) \
329
SymI_HasProto(realloc) \
330
SymI_HasProto(malloc) \
331
SymI_HasProto(free) \
332
SymI_HasProto(fork) \
333
SymI_HasProto(lstat) \
334
SymI_HasProto(isatty) \
335
SymI_HasProto(mkdir) \
336
SymI_HasProto(opendir) \
337
SymI_HasProto(readdir) \
338
SymI_HasProto(rewinddir) \
339
SymI_HasProto(closedir) \
340
SymI_HasProto(link) \
341
SymI_HasProto(mkfifo) \
342
SymI_HasProto(pipe) \
343
SymI_HasProto(read) \
344
SymI_HasProto(rename) \
345
SymI_HasProto(rmdir) \
346
SymI_HasProto(select) \
347
SymI_HasProto(system) \
348
SymI_HasProto(write) \
349
SymI_HasProto(strcmp) \
350
SymI_HasProto(strcpy) \
351
SymI_HasProto(strncpy) \
352
SymI_HasProto(strerror) \
353
SymI_HasProto(sigaddset) \
354
SymI_HasProto(sigemptyset) \
355
SymI_HasProto(sigprocmask) \
356
SymI_HasProto(umask) \
357
SymI_HasProto(uname) \
358
SymI_HasProto(unlink) \
359
SymI_HasProto(utime) \
360
SymI_HasProto(waitpid)
361
362
#elif !defined(mingw32_HOST_OS)
363
#define RTS_MINGW_ONLY_SYMBOLS /**/
364
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
365
#else /* defined(mingw32_HOST_OS) */
366
#define RTS_POSIX_ONLY_SYMBOLS /**/
367
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
368
369
#if HAVE_GETTIMEOFDAY
370
#define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
371
#else
372
#define RTS_MINGW_GETTIMEOFDAY_SYM /**/
373
#endif
374
375
#if HAVE___MINGW_VFPRINTF
376
#define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
377
#else
378
#define RTS___MINGW_VFPRINTF_SYM /**/
379
#endif
380
381
/* These are statically linked from the mingw libraries into the ghc
382
executable, so we have to employ this hack. */
383
#define RTS_MINGW_ONLY_SYMBOLS \
384
SymI_HasProto(stg_asyncReadzh) \
385
SymI_HasProto(stg_asyncWritezh) \
386
SymI_HasProto(stg_asyncDoProczh) \
387
SymI_HasProto(memset) \
388
SymI_HasProto(inet_ntoa) \
389
SymI_HasProto(inet_addr) \
390
SymI_HasProto(htonl) \
391
SymI_HasProto(recvfrom) \
392
SymI_HasProto(listen) \
393
SymI_HasProto(bind) \
394
SymI_HasProto(shutdown) \
395
SymI_HasProto(connect) \
396
SymI_HasProto(htons) \
397
SymI_HasProto(ntohs) \
398
SymI_HasProto(getservbyname) \
399
SymI_HasProto(getservbyport) \
400
SymI_HasProto(getprotobynumber) \
401
SymI_HasProto(getprotobyname) \
402
SymI_HasProto(gethostbyname) \
403
SymI_HasProto(gethostbyaddr) \
404
SymI_HasProto(gethostname) \
405
SymI_HasProto(strcpy) \
406
SymI_HasProto(strncpy) \
407
SymI_HasProto(abort) \
408
SymI_NeedsProto(_alloca) \
409
SymI_HasProto(isxdigit) \
410
SymI_HasProto(isupper) \
411
SymI_HasProto(ispunct) \
412
SymI_HasProto(islower) \
413
SymI_HasProto(isspace) \
414
SymI_HasProto(isprint) \
415
SymI_HasProto(isdigit) \
416
SymI_HasProto(iscntrl) \
417
SymI_HasProto(isalpha) \
418
SymI_HasProto(isalnum) \
419
SymI_HasProto(isascii) \
420
RTS___MINGW_VFPRINTF_SYM \
421
SymI_HasProto(strcmp) \
422
SymI_HasProto(memmove) \
423
SymI_HasProto(realloc) \
424
SymI_HasProto(malloc) \
425
SymI_HasProto(pow) \
426
SymI_HasProto(tanh) \
427
SymI_HasProto(cosh) \
428
SymI_HasProto(sinh) \
429
SymI_HasProto(atan) \
430
SymI_HasProto(acos) \
431
SymI_HasProto(asin) \
432
SymI_HasProto(tan) \
433
SymI_HasProto(cos) \
434
SymI_HasProto(sin) \
435
SymI_HasProto(exp) \
436
SymI_HasProto(log) \
437
SymI_HasProto(sqrt) \
438
SymI_HasProto(powf) \
439
SymI_HasProto(tanhf) \
440
SymI_HasProto(coshf) \
441
SymI_HasProto(sinhf) \
442
SymI_HasProto(atanf) \
443
SymI_HasProto(acosf) \
444
SymI_HasProto(asinf) \
445
SymI_HasProto(tanf) \
446
SymI_HasProto(cosf) \
447
SymI_HasProto(sinf) \
448
SymI_HasProto(expf) \
449
SymI_HasProto(logf) \
450
SymI_HasProto(sqrtf) \
451
SymI_HasProto(erf) \
452
SymI_HasProto(erfc) \
453
SymI_HasProto(erff) \
454
SymI_HasProto(erfcf) \
455
SymI_HasProto(memcpy) \
456
SymI_HasProto(rts_InstallConsoleEvent) \
457
SymI_HasProto(rts_ConsoleHandlerDone) \
458
SymI_NeedsProto(mktime) \
459
SymI_NeedsProto(_imp___timezone) \
460
SymI_NeedsProto(_imp___tzname) \
461
SymI_NeedsProto(_imp__tzname) \
462
SymI_NeedsProto(_imp___iob) \
463
SymI_NeedsProto(_imp___osver) \
464
SymI_NeedsProto(localtime) \
465
SymI_NeedsProto(gmtime) \
466
SymI_NeedsProto(opendir) \
467
SymI_NeedsProto(readdir) \
468
SymI_NeedsProto(rewinddir) \
469
SymI_NeedsProto(_imp____mb_cur_max) \
470
SymI_NeedsProto(_imp___pctype) \
471
SymI_NeedsProto(__chkstk) \
472
RTS_MINGW_GETTIMEOFDAY_SYM \
473
SymI_NeedsProto(closedir)
474
#endif
475
476
477
#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
478
#define RTS_DARWIN_ONLY_SYMBOLS \
479
SymI_NeedsProto(asprintf$LDBLStub) \
480
SymI_NeedsProto(err$LDBLStub) \
481
SymI_NeedsProto(errc$LDBLStub) \
482
SymI_NeedsProto(errx$LDBLStub) \
483
SymI_NeedsProto(fprintf$LDBLStub) \
484
SymI_NeedsProto(fscanf$LDBLStub) \
485
SymI_NeedsProto(fwprintf$LDBLStub) \
486
SymI_NeedsProto(fwscanf$LDBLStub) \
487
SymI_NeedsProto(printf$LDBLStub) \
488
SymI_NeedsProto(scanf$LDBLStub) \
489
SymI_NeedsProto(snprintf$LDBLStub) \
490
SymI_NeedsProto(sprintf$LDBLStub) \
491
SymI_NeedsProto(sscanf$LDBLStub) \
492
SymI_NeedsProto(strtold$LDBLStub) \
493
SymI_NeedsProto(swprintf$LDBLStub) \
494
SymI_NeedsProto(swscanf$LDBLStub) \
495
SymI_NeedsProto(syslog$LDBLStub) \
496
SymI_NeedsProto(vasprintf$LDBLStub) \
497
SymI_NeedsProto(verr$LDBLStub) \
498
SymI_NeedsProto(verrc$LDBLStub) \
499
SymI_NeedsProto(verrx$LDBLStub) \
500
SymI_NeedsProto(vfprintf$LDBLStub) \
501
SymI_NeedsProto(vfscanf$LDBLStub) \
502
SymI_NeedsProto(vfwprintf$LDBLStub) \
503
SymI_NeedsProto(vfwscanf$LDBLStub) \
504
SymI_NeedsProto(vprintf$LDBLStub) \
505
SymI_NeedsProto(vscanf$LDBLStub) \
506
SymI_NeedsProto(vsnprintf$LDBLStub) \
507
SymI_NeedsProto(vsprintf$LDBLStub) \
508
SymI_NeedsProto(vsscanf$LDBLStub) \
509
SymI_NeedsProto(vswprintf$LDBLStub) \
510
SymI_NeedsProto(vswscanf$LDBLStub) \
511
SymI_NeedsProto(vsyslog$LDBLStub) \
512
SymI_NeedsProto(vwarn$LDBLStub) \
513
SymI_NeedsProto(vwarnc$LDBLStub) \
514
SymI_NeedsProto(vwarnx$LDBLStub) \
515
SymI_NeedsProto(vwprintf$LDBLStub) \
516
SymI_NeedsProto(vwscanf$LDBLStub) \
517
SymI_NeedsProto(warn$LDBLStub) \
518
SymI_NeedsProto(warnc$LDBLStub) \
519
SymI_NeedsProto(warnx$LDBLStub) \
520
SymI_NeedsProto(wcstold$LDBLStub) \
521
SymI_NeedsProto(wprintf$LDBLStub) \
522
SymI_NeedsProto(wscanf$LDBLStub)
523
#else
524
#define RTS_DARWIN_ONLY_SYMBOLS
525
#endif
526
527
#ifndef SMP
528
# define MAIN_CAP_SYM SymI_HasProto(MainCapability)
529
#else
530
# define MAIN_CAP_SYM
531
#endif
532
533
#if !defined(mingw32_HOST_OS)
534
#define RTS_USER_SIGNALS_SYMBOLS \
535
SymI_HasProto(setIOManagerControlFd) \
536
SymI_HasProto(setIOManagerWakeupFd) \
537
SymI_HasProto(ioManagerWakeup) \
538
SymI_HasProto(blockUserSignals) \
539
SymI_HasProto(unblockUserSignals)
540
#else
541
#define RTS_USER_SIGNALS_SYMBOLS \
542
SymI_HasProto(ioManagerWakeup) \
543
SymI_HasProto(sendIOManagerEvent) \
544
SymI_HasProto(readIOManagerEvent) \
545
SymI_HasProto(getIOManagerEvent) \
546
SymI_HasProto(console_handler)
547
#endif
548
549
#define RTS_LIBFFI_SYMBOLS \
550
SymE_NeedsProto(ffi_prep_cif) \
551
SymE_NeedsProto(ffi_call) \
552
SymE_NeedsProto(ffi_type_void) \
553
SymE_NeedsProto(ffi_type_float) \
554
SymE_NeedsProto(ffi_type_double) \
555
SymE_NeedsProto(ffi_type_sint64) \
556
SymE_NeedsProto(ffi_type_uint64) \
557
SymE_NeedsProto(ffi_type_sint32) \
558
SymE_NeedsProto(ffi_type_uint32) \
559
SymE_NeedsProto(ffi_type_sint16) \
560
SymE_NeedsProto(ffi_type_uint16) \
561
SymE_NeedsProto(ffi_type_sint8) \
562
SymE_NeedsProto(ffi_type_uint8) \
563
SymE_NeedsProto(ffi_type_pointer)
564
565
#ifdef TABLES_NEXT_TO_CODE
566
#define RTS_RET_SYMBOLS /* nothing */
567
#else
568
#define RTS_RET_SYMBOLS \
569
SymI_HasProto(stg_enter_ret) \
570
SymI_HasProto(stg_gc_fun_ret) \
571
SymI_HasProto(stg_ap_v_ret) \
572
SymI_HasProto(stg_ap_f_ret) \
573
SymI_HasProto(stg_ap_d_ret) \
574
SymI_HasProto(stg_ap_l_ret) \
575
SymI_HasProto(stg_ap_n_ret) \
576
SymI_HasProto(stg_ap_p_ret) \
577
SymI_HasProto(stg_ap_pv_ret) \
578
SymI_HasProto(stg_ap_pp_ret) \
579
SymI_HasProto(stg_ap_ppv_ret) \
580
SymI_HasProto(stg_ap_ppp_ret) \
581
SymI_HasProto(stg_ap_pppv_ret) \
582
SymI_HasProto(stg_ap_pppp_ret) \
583
SymI_HasProto(stg_ap_ppppp_ret) \
584
SymI_HasProto(stg_ap_pppppp_ret)
585
#endif
586
587
/* Modules compiled with -ticky may mention ticky counters */
588
/* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
589
#define RTS_TICKY_SYMBOLS \
590
SymI_NeedsProto(ticky_entry_ctrs) \
591
SymI_NeedsProto(top_ct) \
592
\
593
SymI_HasProto(ENT_VIA_NODE_ctr) \
594
SymI_HasProto(ENT_STATIC_THK_ctr) \
595
SymI_HasProto(ENT_DYN_THK_ctr) \
596
SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
597
SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
598
SymI_HasProto(ENT_STATIC_CON_ctr) \
599
SymI_HasProto(ENT_DYN_CON_ctr) \
600
SymI_HasProto(ENT_STATIC_IND_ctr) \
601
SymI_HasProto(ENT_DYN_IND_ctr) \
602
SymI_HasProto(ENT_PERM_IND_ctr) \
603
SymI_HasProto(ENT_PAP_ctr) \
604
SymI_HasProto(ENT_AP_ctr) \
605
SymI_HasProto(ENT_AP_STACK_ctr) \
606
SymI_HasProto(ENT_BH_ctr) \
607
SymI_HasProto(UNKNOWN_CALL_ctr) \
608
SymI_HasProto(SLOW_CALL_v_ctr) \
609
SymI_HasProto(SLOW_CALL_f_ctr) \
610
SymI_HasProto(SLOW_CALL_d_ctr) \
611
SymI_HasProto(SLOW_CALL_l_ctr) \
612
SymI_HasProto(SLOW_CALL_n_ctr) \
613
SymI_HasProto(SLOW_CALL_p_ctr) \
614
SymI_HasProto(SLOW_CALL_pv_ctr) \
615
SymI_HasProto(SLOW_CALL_pp_ctr) \
616
SymI_HasProto(SLOW_CALL_ppv_ctr) \
617
SymI_HasProto(SLOW_CALL_ppp_ctr) \
618
SymI_HasProto(SLOW_CALL_pppv_ctr) \
619
SymI_HasProto(SLOW_CALL_pppp_ctr) \
620
SymI_HasProto(SLOW_CALL_ppppp_ctr) \
621
SymI_HasProto(SLOW_CALL_pppppp_ctr) \
622
SymI_HasProto(SLOW_CALL_OTHER_ctr) \
623
SymI_HasProto(ticky_slow_call_unevald) \
624
SymI_HasProto(SLOW_CALL_ctr) \
625
SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
626
SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
627
SymI_HasProto(KNOWN_CALL_ctr) \
628
SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
629
SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
630
SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
631
SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
632
SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
633
SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
634
SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
635
SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
636
SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
637
SymI_HasProto(UPDF_OMITTED_ctr) \
638
SymI_HasProto(UPDF_PUSHED_ctr) \
639
SymI_HasProto(CATCHF_PUSHED_ctr) \
640
SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
641
SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
642
SymI_HasProto(UPD_SQUEEZED_ctr) \
643
SymI_HasProto(UPD_CON_IN_NEW_ctr) \
644
SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
645
SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
646
SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
647
SymI_HasProto(ALLOC_HEAP_ctr) \
648
SymI_HasProto(ALLOC_HEAP_tot) \
649
SymI_HasProto(ALLOC_FUN_ctr) \
650
SymI_HasProto(ALLOC_FUN_adm) \
651
SymI_HasProto(ALLOC_FUN_gds) \
652
SymI_HasProto(ALLOC_FUN_slp) \
653
SymI_HasProto(UPD_NEW_IND_ctr) \
654
SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
655
SymI_HasProto(UPD_OLD_IND_ctr) \
656
SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
657
SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
658
SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
659
SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
660
SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
661
SymI_HasProto(GC_SEL_ABANDONED_ctr) \
662
SymI_HasProto(GC_SEL_MINOR_ctr) \
663
SymI_HasProto(GC_SEL_MAJOR_ctr) \
664
SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
665
SymI_HasProto(ALLOC_UP_THK_ctr) \
666
SymI_HasProto(ALLOC_SE_THK_ctr) \
667
SymI_HasProto(ALLOC_THK_adm) \
668
SymI_HasProto(ALLOC_THK_gds) \
669
SymI_HasProto(ALLOC_THK_slp) \
670
SymI_HasProto(ALLOC_CON_ctr) \
671
SymI_HasProto(ALLOC_CON_adm) \
672
SymI_HasProto(ALLOC_CON_gds) \
673
SymI_HasProto(ALLOC_CON_slp) \
674
SymI_HasProto(ALLOC_TUP_ctr) \
675
SymI_HasProto(ALLOC_TUP_adm) \
676
SymI_HasProto(ALLOC_TUP_gds) \
677
SymI_HasProto(ALLOC_TUP_slp) \
678
SymI_HasProto(ALLOC_BH_ctr) \
679
SymI_HasProto(ALLOC_BH_adm) \
680
SymI_HasProto(ALLOC_BH_gds) \
681
SymI_HasProto(ALLOC_BH_slp) \
682
SymI_HasProto(ALLOC_PRIM_ctr) \
683
SymI_HasProto(ALLOC_PRIM_adm) \
684
SymI_HasProto(ALLOC_PRIM_gds) \
685
SymI_HasProto(ALLOC_PRIM_slp) \
686
SymI_HasProto(ALLOC_PAP_ctr) \
687
SymI_HasProto(ALLOC_PAP_adm) \
688
SymI_HasProto(ALLOC_PAP_gds) \
689
SymI_HasProto(ALLOC_PAP_slp) \
690
SymI_HasProto(ALLOC_TSO_ctr) \
691
SymI_HasProto(ALLOC_TSO_adm) \
692
SymI_HasProto(ALLOC_TSO_gds) \
693
SymI_HasProto(ALLOC_TSO_slp) \
694
SymI_HasProto(RET_NEW_ctr) \
695
SymI_HasProto(RET_OLD_ctr) \
696
SymI_HasProto(RET_UNBOXED_TUP_ctr) \
697
SymI_HasProto(RET_SEMI_loads_avoided)
698
699
700
// On most platforms, the garbage collector rewrites references
701
// to small integer and char objects to a set of common, shared ones.
702
//
703
// We don't do this when compiling to Windows DLLs at the moment because
704
// it doesn't support cross package data references well.
705
//
706
#if defined(__PIC__) && defined(mingw32_HOST_OS)
707
#define RTS_INTCHAR_SYMBOLS
708
#else
709
#define RTS_INTCHAR_SYMBOLS \
710
SymI_HasProto(stg_CHARLIKE_closure) \
711
SymI_HasProto(stg_INTLIKE_closure)
712
#endif
713
714
715
#define RTS_SYMBOLS \
716
Maybe_Stable_Names \
717
RTS_TICKY_SYMBOLS \
718
SymI_HasProto(StgReturn) \
719
SymI_HasProto(stg_enter_info) \
720
SymI_HasProto(stg_gc_void_info) \
721
SymI_HasProto(__stg_gc_enter_1) \
722
SymI_HasProto(stg_gc_noregs) \
723
SymI_HasProto(stg_gc_unpt_r1_info) \
724
SymI_HasProto(stg_gc_unpt_r1) \
725
SymI_HasProto(stg_gc_unbx_r1_info) \
726
SymI_HasProto(stg_gc_unbx_r1) \
727
SymI_HasProto(stg_gc_f1_info) \
728
SymI_HasProto(stg_gc_f1) \
729
SymI_HasProto(stg_gc_d1_info) \
730
SymI_HasProto(stg_gc_d1) \
731
SymI_HasProto(stg_gc_l1_info) \
732
SymI_HasProto(stg_gc_l1) \
733
SymI_HasProto(__stg_gc_fun) \
734
SymI_HasProto(stg_gc_fun_info) \
735
SymI_HasProto(stg_gc_gen) \
736
SymI_HasProto(stg_gc_gen_info) \
737
SymI_HasProto(stg_gc_gen_hp) \
738
SymI_HasProto(stg_gc_ut) \
739
SymI_HasProto(stg_gen_yield) \
740
SymI_HasProto(stg_yield_noregs) \
741
SymI_HasProto(stg_yield_to_interpreter) \
742
SymI_HasProto(stg_gen_block) \
743
SymI_HasProto(stg_block_noregs) \
744
SymI_HasProto(stg_block_1) \
745
SymI_HasProto(stg_block_takemvar) \
746
SymI_HasProto(stg_block_putmvar) \
747
MAIN_CAP_SYM \
748
SymI_HasProto(MallocFailHook) \
749
SymI_HasProto(OnExitHook) \
750
SymI_HasProto(OutOfHeapHook) \
751
SymI_HasProto(StackOverflowHook) \
752
SymI_HasProto(addDLL) \
753
SymI_HasProto(__int_encodeDouble) \
754
SymI_HasProto(__word_encodeDouble) \
755
SymI_HasProto(__2Int_encodeDouble) \
756
SymI_HasProto(__int_encodeFloat) \
757
SymI_HasProto(__word_encodeFloat) \
758
SymI_HasProto(stg_atomicallyzh) \
759
SymI_HasProto(barf) \
760
SymI_HasProto(debugBelch) \
761
SymI_HasProto(errorBelch) \
762
SymI_HasProto(sysErrorBelch) \
763
SymI_HasProto(stg_getMaskingStatezh) \
764
SymI_HasProto(stg_maskAsyncExceptionszh) \
765
SymI_HasProto(stg_maskUninterruptiblezh) \
766
SymI_HasProto(stg_catchzh) \
767
SymI_HasProto(stg_catchRetryzh) \
768
SymI_HasProto(stg_catchSTMzh) \
769
SymI_HasProto(stg_checkzh) \
770
SymI_HasProto(closure_flags) \
771
SymI_HasProto(cmp_thread) \
772
SymI_HasProto(createAdjustor) \
773
SymI_HasProto(stg_decodeDoublezu2Intzh) \
774
SymI_HasProto(stg_decodeFloatzuIntzh) \
775
SymI_HasProto(defaultsHook) \
776
SymI_HasProto(stg_delayzh) \
777
SymI_HasProto(stg_deRefWeakzh) \
778
SymI_HasProto(stg_deRefStablePtrzh) \
779
SymI_HasProto(dirty_MUT_VAR) \
780
SymI_HasProto(stg_forkzh) \
781
SymI_HasProto(stg_forkOnzh) \
782
SymI_HasProto(forkProcess) \
783
SymI_HasProto(forkOS_createThread) \
784
SymI_HasProto(freeHaskellFunctionPtr) \
785
SymI_HasProto(getOrSetTypeableStore) \
786
SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
787
SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
788
SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
789
SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
790
SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
791
SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
792
SymI_HasProto(genSymZh) \
793
SymI_HasProto(genericRaise) \
794
SymI_HasProto(getProgArgv) \
795
SymI_HasProto(getFullProgArgv) \
796
SymI_HasProto(getStablePtr) \
797
SymI_HasProto(hs_init) \
798
SymI_HasProto(hs_exit) \
799
SymI_HasProto(hs_set_argv) \
800
SymI_HasProto(hs_add_root) \
801
SymI_HasProto(hs_perform_gc) \
802
SymI_HasProto(hs_free_stable_ptr) \
803
SymI_HasProto(hs_free_fun_ptr) \
804
SymI_HasProto(hs_hpc_rootModule) \
805
SymI_HasProto(hs_hpc_module) \
806
SymI_HasProto(initLinker) \
807
SymI_HasProto(stg_unpackClosurezh) \
808
SymI_HasProto(stg_getApStackValzh) \
809
SymI_HasProto(stg_getSparkzh) \
810
SymI_HasProto(stg_numSparkszh) \
811
SymI_HasProto(stg_isCurrentThreadBoundzh) \
812
SymI_HasProto(stg_isEmptyMVarzh) \
813
SymI_HasProto(stg_killThreadzh) \
814
SymI_HasProto(loadArchive) \
815
SymI_HasProto(loadObj) \
816
SymI_HasProto(insertStableSymbol) \
817
SymI_HasProto(insertSymbol) \
818
SymI_HasProto(lookupSymbol) \
819
SymI_HasProto(stg_makeStablePtrzh) \
820
SymI_HasProto(stg_mkApUpd0zh) \
821
SymI_HasProto(stg_myThreadIdzh) \
822
SymI_HasProto(stg_labelThreadzh) \
823
SymI_HasProto(stg_newArrayzh) \
824
SymI_HasProto(stg_newBCOzh) \
825
SymI_HasProto(stg_newByteArrayzh) \
826
SymI_HasProto_redirect(newCAF, newDynCAF) \
827
SymI_HasProto(stg_newMVarzh) \
828
SymI_HasProto(stg_newMutVarzh) \
829
SymI_HasProto(stg_newTVarzh) \
830
SymI_HasProto(stg_noDuplicatezh) \
831
SymI_HasProto(stg_atomicModifyMutVarzh) \
832
SymI_HasProto(stg_newPinnedByteArrayzh) \
833
SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
834
SymI_HasProto(newSpark) \
835
SymI_HasProto(performGC) \
836
SymI_HasProto(performMajorGC) \
837
SymI_HasProto(prog_argc) \
838
SymI_HasProto(prog_argv) \
839
SymI_HasProto(stg_putMVarzh) \
840
SymI_HasProto(stg_raisezh) \
841
SymI_HasProto(stg_raiseIOzh) \
842
SymI_HasProto(stg_readTVarzh) \
843
SymI_HasProto(stg_readTVarIOzh) \
844
SymI_HasProto(resumeThread) \
845
SymI_HasProto(resolveObjs) \
846
SymI_HasProto(stg_retryzh) \
847
SymI_HasProto(rts_apply) \
848
SymI_HasProto(rts_checkSchedStatus) \
849
SymI_HasProto(rts_eval) \
850
SymI_HasProto(rts_evalIO) \
851
SymI_HasProto(rts_evalLazyIO) \
852
SymI_HasProto(rts_evalStableIO) \
853
SymI_HasProto(rts_eval_) \
854
SymI_HasProto(rts_getBool) \
855
SymI_HasProto(rts_getChar) \
856
SymI_HasProto(rts_getDouble) \
857
SymI_HasProto(rts_getFloat) \
858
SymI_HasProto(rts_getInt) \
859
SymI_HasProto(rts_getInt8) \
860
SymI_HasProto(rts_getInt16) \
861
SymI_HasProto(rts_getInt32) \
862
SymI_HasProto(rts_getInt64) \
863
SymI_HasProto(rts_getPtr) \
864
SymI_HasProto(rts_getFunPtr) \
865
SymI_HasProto(rts_getStablePtr) \
866
SymI_HasProto(rts_getThreadId) \
867
SymI_HasProto(rts_getWord) \
868
SymI_HasProto(rts_getWord8) \
869
SymI_HasProto(rts_getWord16) \
870
SymI_HasProto(rts_getWord32) \
871
SymI_HasProto(rts_getWord64) \
872
SymI_HasProto(rts_lock) \
873
SymI_HasProto(rts_mkBool) \
874
SymI_HasProto(rts_mkChar) \
875
SymI_HasProto(rts_mkDouble) \
876
SymI_HasProto(rts_mkFloat) \
877
SymI_HasProto(rts_mkInt) \
878
SymI_HasProto(rts_mkInt8) \
879
SymI_HasProto(rts_mkInt16) \
880
SymI_HasProto(rts_mkInt32) \
881
SymI_HasProto(rts_mkInt64) \
882
SymI_HasProto(rts_mkPtr) \
883
SymI_HasProto(rts_mkFunPtr) \
884
SymI_HasProto(rts_mkStablePtr) \
885
SymI_HasProto(rts_mkString) \
886
SymI_HasProto(rts_mkWord) \
887
SymI_HasProto(rts_mkWord8) \
888
SymI_HasProto(rts_mkWord16) \
889
SymI_HasProto(rts_mkWord32) \
890
SymI_HasProto(rts_mkWord64) \
891
SymI_HasProto(rts_unlock) \
892
SymI_HasProto(rts_unsafeGetMyCapability) \
893
SymI_HasProto(rtsSupportsBoundThreads) \
894
SymI_HasProto(rts_isProfiled) \
895
SymI_HasProto(setProgArgv) \
896
SymI_HasProto(startupHaskell) \
897
SymI_HasProto(shutdownHaskell) \
898
SymI_HasProto(shutdownHaskellAndExit) \
899
SymI_HasProto(stable_ptr_table) \
900
SymI_HasProto(stackOverflow) \
901
SymI_HasProto(stg_CAF_BLACKHOLE_info) \
902
SymI_HasProto(stg_BLACKHOLE_info) \
903
SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
904
SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
905
SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
906
SymI_HasProto(startTimer) \
907
SymI_HasProto(stg_MVAR_CLEAN_info) \
908
SymI_HasProto(stg_MVAR_DIRTY_info) \
909
SymI_HasProto(stg_IND_STATIC_info) \
910
SymI_HasProto(stg_ARR_WORDS_info) \
911
SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
912
SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
913
SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
914
SymI_HasProto(stg_WEAK_info) \
915
SymI_HasProto(stg_ap_v_info) \
916
SymI_HasProto(stg_ap_f_info) \
917
SymI_HasProto(stg_ap_d_info) \
918
SymI_HasProto(stg_ap_l_info) \
919
SymI_HasProto(stg_ap_n_info) \
920
SymI_HasProto(stg_ap_p_info) \
921
SymI_HasProto(stg_ap_pv_info) \
922
SymI_HasProto(stg_ap_pp_info) \
923
SymI_HasProto(stg_ap_ppv_info) \
924
SymI_HasProto(stg_ap_ppp_info) \
925
SymI_HasProto(stg_ap_pppv_info) \
926
SymI_HasProto(stg_ap_pppp_info) \
927
SymI_HasProto(stg_ap_ppppp_info) \
928
SymI_HasProto(stg_ap_pppppp_info) \
929
SymI_HasProto(stg_ap_0_fast) \
930
SymI_HasProto(stg_ap_v_fast) \
931
SymI_HasProto(stg_ap_f_fast) \
932
SymI_HasProto(stg_ap_d_fast) \
933
SymI_HasProto(stg_ap_l_fast) \
934
SymI_HasProto(stg_ap_n_fast) \
935
SymI_HasProto(stg_ap_p_fast) \
936
SymI_HasProto(stg_ap_pv_fast) \
937
SymI_HasProto(stg_ap_pp_fast) \
938
SymI_HasProto(stg_ap_ppv_fast) \
939
SymI_HasProto(stg_ap_ppp_fast) \
940
SymI_HasProto(stg_ap_pppv_fast) \
941
SymI_HasProto(stg_ap_pppp_fast) \
942
SymI_HasProto(stg_ap_ppppp_fast) \
943
SymI_HasProto(stg_ap_pppppp_fast) \
944
SymI_HasProto(stg_ap_1_upd_info) \
945
SymI_HasProto(stg_ap_2_upd_info) \
946
SymI_HasProto(stg_ap_3_upd_info) \
947
SymI_HasProto(stg_ap_4_upd_info) \
948
SymI_HasProto(stg_ap_5_upd_info) \
949
SymI_HasProto(stg_ap_6_upd_info) \
950
SymI_HasProto(stg_ap_7_upd_info) \
951
SymI_HasProto(stg_exit) \
952
SymI_HasProto(stg_sel_0_upd_info) \
953
SymI_HasProto(stg_sel_10_upd_info) \
954
SymI_HasProto(stg_sel_11_upd_info) \
955
SymI_HasProto(stg_sel_12_upd_info) \
956
SymI_HasProto(stg_sel_13_upd_info) \
957
SymI_HasProto(stg_sel_14_upd_info) \
958
SymI_HasProto(stg_sel_15_upd_info) \
959
SymI_HasProto(stg_sel_1_upd_info) \
960
SymI_HasProto(stg_sel_2_upd_info) \
961
SymI_HasProto(stg_sel_3_upd_info) \
962
SymI_HasProto(stg_sel_4_upd_info) \
963
SymI_HasProto(stg_sel_5_upd_info) \
964
SymI_HasProto(stg_sel_6_upd_info) \
965
SymI_HasProto(stg_sel_7_upd_info) \
966
SymI_HasProto(stg_sel_8_upd_info) \
967
SymI_HasProto(stg_sel_9_upd_info) \
968
SymI_HasProto(stg_upd_frame_info) \
969
SymI_HasProto(stg_bh_upd_frame_info) \
970
SymI_HasProto(suspendThread) \
971
SymI_HasProto(stg_takeMVarzh) \
972
SymI_HasProto(stg_threadStatuszh) \
973
SymI_HasProto(stg_tryPutMVarzh) \
974
SymI_HasProto(stg_tryTakeMVarzh) \
975
SymI_HasProto(stg_unmaskAsyncExceptionszh) \
976
SymI_HasProto(unloadObj) \
977
SymI_HasProto(stg_unsafeThawArrayzh) \
978
SymI_HasProto(stg_waitReadzh) \
979
SymI_HasProto(stg_waitWritezh) \
980
SymI_HasProto(stg_writeTVarzh) \
981
SymI_HasProto(stg_yieldzh) \
982
SymI_NeedsProto(stg_interp_constr_entry) \
983
SymI_HasProto(stg_arg_bitmaps) \
984
SymI_HasProto(alloc_blocks_lim) \
985
SymI_HasProto(g0) \
986
SymI_HasProto(allocate) \
987
SymI_HasProto(allocateExec) \
988
SymI_HasProto(freeExec) \
989
SymI_HasProto(getAllocations) \
990
SymI_HasProto(revertCAFs) \
991
SymI_HasProto(RtsFlags) \
992
SymI_NeedsProto(rts_breakpoint_io_action) \
993
SymI_NeedsProto(rts_stop_next_breakpoint) \
994
SymI_NeedsProto(rts_stop_on_exception) \
995
SymI_HasProto(stopTimer) \
996
SymI_HasProto(n_capabilities) \
997
SymI_HasProto(stg_traceCcszh) \
998
SymI_HasProto(stg_traceEventzh) \
999
RTS_USER_SIGNALS_SYMBOLS \
1000
RTS_INTCHAR_SYMBOLS
1001
1002
1003
// 64-bit support functions in libgcc.a
1004
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
1005
#define RTS_LIBGCC_SYMBOLS \
1006
SymI_NeedsProto(__divdi3) \
1007
SymI_NeedsProto(__udivdi3) \
1008
SymI_NeedsProto(__moddi3) \
1009
SymI_NeedsProto(__umoddi3) \
1010
SymI_NeedsProto(__muldi3) \
1011
SymI_NeedsProto(__ashldi3) \
1012
SymI_NeedsProto(__ashrdi3) \
1013
SymI_NeedsProto(__lshrdi3)
1014
#else
1015
#define RTS_LIBGCC_SYMBOLS
1016
#endif
1017
1018
#if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
1019
// Symbols that don't have a leading underscore
1020
// on Mac OS X. They have to receive special treatment,
1021
// see machoInitSymbolsWithoutUnderscore()
1022
#define RTS_MACHO_NOUNDERLINE_SYMBOLS \
1023
SymI_NeedsProto(saveFP) \
1024
SymI_NeedsProto(restFP)
1025
#endif
1026
1027
/* entirely bogus claims about types of these symbols */
1028
#define SymI_NeedsProto(vvv) extern void vvv(void);
1029
#if defined(__PIC__) && defined(mingw32_HOST_OS)
1030
#define SymE_HasProto(vvv) SymE_HasProto(vvv);
1031
#define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
1032
#else
1033
#define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
1034
#define SymE_HasProto(vvv) SymI_HasProto(vvv)
1035
#endif
1036
#define SymI_HasProto(vvv) /**/
1037
#define SymI_HasProto_redirect(vvv,xxx) /**/
1038
RTS_SYMBOLS
1039
RTS_RET_SYMBOLS
1040
RTS_POSIX_ONLY_SYMBOLS
1041
RTS_MINGW_ONLY_SYMBOLS
1042
RTS_CYGWIN_ONLY_SYMBOLS
1043
RTS_DARWIN_ONLY_SYMBOLS
1044
RTS_LIBGCC_SYMBOLS
1045
RTS_LIBFFI_SYMBOLS
1046
#undef SymI_NeedsProto
1047
#undef SymI_HasProto
1048
#undef SymI_HasProto_redirect
1049
#undef SymE_HasProto
1050
#undef SymE_NeedsProto
1051
1052
#ifdef LEADING_UNDERSCORE
1053
#define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
1054
#else
1055
#define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
1056
#endif
1057
1058
#define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1059
(void*)(&(vvv)) },
1060
#define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1061
(void*)DLL_IMPORT_DATA_REF(vvv) },
1062
1063
#define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
1064
#define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
1065
1066
// SymI_HasProto_redirect allows us to redirect references to one symbol to
1067
// another symbol. See newCAF/newDynCAF for an example.
1068
#define SymI_HasProto_redirect(vvv,xxx) \
1069
{ MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1070
(void*)(&(xxx)) },
1071
1072
static RtsSymbolVal rtsSyms[] = {
1073
RTS_SYMBOLS
1074
RTS_RET_SYMBOLS
1075
RTS_POSIX_ONLY_SYMBOLS
1076
RTS_MINGW_ONLY_SYMBOLS
1077
RTS_CYGWIN_ONLY_SYMBOLS
1078
RTS_DARWIN_ONLY_SYMBOLS
1079
RTS_LIBGCC_SYMBOLS
1080
RTS_LIBFFI_SYMBOLS
1081
#if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
1082
// dyld stub code contains references to this,
1083
// but it should never be called because we treat
1084
// lazy pointers as nonlazy.
1085
{ "dyld_stub_binding_helper", (void*)0xDEADBEEF },
1086
#endif
1087
{ 0, 0 } /* sentinel */
1088
};
1089
1090
1091
1092
/* -----------------------------------------------------------------------------
1093
* Insert symbols into hash tables, checking for duplicates.
1094
*/
1095
1096
static void ghciInsertStrHashTable ( char* obj_name,
1097
HashTable *table,
1098
char* key,
1099
void *data
1100
)
1101
{
1102
if (lookupHashTable(table, (StgWord)key) == NULL)
1103
{
1104
insertStrHashTable(table, (StgWord)key, data);
1105
return;
1106
}
1107
debugBelch(
1108
"\n\n"
1109
"GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
1110
" %s\n"
1111
"whilst processing object file\n"
1112
" %s\n"
1113
"This could be caused by:\n"
1114
" * Loading two different object files which export the same symbol\n"
1115
" * Specifying the same object file twice on the GHCi command line\n"
1116
" * An incorrect `package.conf' entry, causing some object to be\n"
1117
" loaded twice.\n"
1118
"GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
1119
"\n",
1120
(char*)key,
1121
obj_name
1122
);
1123
stg_exit(1);
1124
}
1125
/* -----------------------------------------------------------------------------
1126
* initialize the object linker
1127
*/
1128
1129
1130
static int linker_init_done = 0 ;
1131
1132
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1133
static void *dl_prog_handle;
1134
static regex_t re_invalid;
1135
static regex_t re_realso;
1136
#ifdef THREADED_RTS
1137
static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
1138
#endif
1139
#endif
1140
1141
void
1142
initLinker( void )
1143
{
1144
RtsSymbolVal *sym;
1145
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1146
int compileResult;
1147
#endif
1148
1149
IF_DEBUG(linker, debugBelch("initLinker: start\n"));
1150
1151
/* Make initLinker idempotent, so we can call it
1152
before evey relevant operation; that means we
1153
don't need to initialise the linker separately */
1154
if (linker_init_done == 1) {
1155
IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
1156
return;
1157
} else {
1158
linker_init_done = 1;
1159
}
1160
1161
#if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
1162
initMutex(&dl_mutex);
1163
#endif
1164
stablehash = allocStrHashTable();
1165
symhash = allocStrHashTable();
1166
1167
/* populate the symbol table with stuff from the RTS */
1168
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1169
ghciInsertStrHashTable("(GHCi built-in symbols)",
1170
symhash, sym->lbl, sym->addr);
1171
IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
1172
}
1173
# if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1174
machoInitSymbolsWithoutUnderscore();
1175
# endif
1176
1177
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1178
# if defined(RTLD_DEFAULT)
1179
dl_prog_handle = RTLD_DEFAULT;
1180
# else
1181
dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1182
# endif /* RTLD_DEFAULT */
1183
1184
compileResult = regcomp(&re_invalid,
1185
"(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
1186
REG_EXTENDED);
1187
ASSERT( compileResult == 0 );
1188
compileResult = regcomp(&re_realso,
1189
"GROUP *\\( *(([^ )])+)",
1190
REG_EXTENDED);
1191
ASSERT( compileResult == 0 );
1192
# endif
1193
1194
#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1195
if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1196
// User-override for mmap_32bit_base
1197
mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1198
}
1199
#endif
1200
1201
#if defined(mingw32_HOST_OS)
1202
/*
1203
* These two libraries cause problems when added to the static link,
1204
* but are necessary for resolving symbols in GHCi, hence we load
1205
* them manually here.
1206
*/
1207
addDLL("msvcrt");
1208
addDLL("kernel32");
1209
#endif
1210
1211
IF_DEBUG(linker, debugBelch("initLinker: done\n"));
1212
return;
1213
}
1214
1215
void
1216
exitLinker( void ) {
1217
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1218
if (linker_init_done == 1) {
1219
regfree(&re_invalid);
1220
regfree(&re_realso);
1221
#ifdef THREADED_RTS
1222
closeMutex(&dl_mutex);
1223
#endif
1224
}
1225
#endif
1226
}
1227
1228
/* -----------------------------------------------------------------------------
1229
* Loading DLL or .so dynamic libraries
1230
* -----------------------------------------------------------------------------
1231
*
1232
* Add a DLL from which symbols may be found. In the ELF case, just
1233
* do RTLD_GLOBAL-style add, so no further messing around needs to
1234
* happen in order that symbols in the loaded .so are findable --
1235
* lookupSymbol() will subsequently see them by dlsym on the program's
1236
* dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1237
*
1238
* In the PEi386 case, open the DLLs and put handles to them in a
1239
* linked list. When looking for a symbol, try all handles in the
1240
* list. This means that we need to load even DLLs that are guaranteed
1241
* to be in the ghc.exe image already, just so we can get a handle
1242
* to give to loadSymbol, so that we can find the symbols. For such
1243
* libraries, the LoadLibrary call should be a no-op except for returning
1244
* the handle.
1245
*
1246
*/
1247
1248
#if defined(OBJFORMAT_PEi386)
1249
/* A record for storing handles into DLLs. */
1250
1251
typedef
1252
struct _OpenedDLL {
1253
char* name;
1254
struct _OpenedDLL* next;
1255
HINSTANCE instance;
1256
}
1257
OpenedDLL;
1258
1259
/* A list thereof. */
1260
static OpenedDLL* opened_dlls = NULL;
1261
#endif
1262
1263
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1264
1265
static const char *
1266
internal_dlopen(const char *dll_name)
1267
{
1268
void *hdl;
1269
const char *errmsg;
1270
char *errmsg_copy;
1271
1272
// omitted: RTLD_NOW
1273
// see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1274
IF_DEBUG(linker,
1275
debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1276
1277
//-------------- Begin critical section ------------------
1278
// This critical section is necessary because dlerror() is not
1279
// required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1280
// Also, the error message returned must be copied to preserve it
1281
// (see POSIX also)
1282
1283
ACQUIRE_LOCK(&dl_mutex);
1284
hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1285
1286
errmsg = NULL;
1287
if (hdl == NULL) {
1288
/* dlopen failed; return a ptr to the error msg. */
1289
errmsg = dlerror();
1290
if (errmsg == NULL) errmsg = "addDLL: unknown error";
1291
errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1292
strcpy(errmsg_copy, errmsg);
1293
errmsg = errmsg_copy;
1294
}
1295
RELEASE_LOCK(&dl_mutex);
1296
//--------------- End critical section -------------------
1297
1298
return errmsg;
1299
}
1300
# endif
1301
1302
const char *
1303
addDLL( char *dll_name )
1304
{
1305
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1306
/* ------------------- ELF DLL loader ------------------- */
1307
1308
#define NMATCH 5
1309
regmatch_t match[NMATCH];
1310
const char *errmsg;
1311
FILE* fp;
1312
size_t match_length;
1313
#define MAXLINE 1000
1314
char line[MAXLINE];
1315
int result;
1316
1317
initLinker();
1318
1319
IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1320
errmsg = internal_dlopen(dll_name);
1321
1322
if (errmsg == NULL) {
1323
return NULL;
1324
}
1325
1326
// GHC Trac ticket #2615
1327
// On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1328
// contain linker scripts rather than ELF-format object code. This
1329
// code handles the situation by recognizing the real object code
1330
// file name given in the linker script.
1331
//
1332
// If an "invalid ELF header" error occurs, it is assumed that the
1333
// .so file contains a linker script instead of ELF object code.
1334
// In this case, the code looks for the GROUP ( ... ) linker
1335
// directive. If one is found, the first file name inside the
1336
// parentheses is treated as the name of a dynamic library and the
1337
// code attempts to dlopen that file. If this is also unsuccessful,
1338
// an error message is returned.
1339
1340
// see if the error message is due to an invalid ELF header
1341
IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1342
result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1343
IF_DEBUG(linker, debugBelch("result = %i\n", result));
1344
if (result == 0) {
1345
// success -- try to read the named file as a linker script
1346
match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1347
MAXLINE-1);
1348
strncpy(line, (errmsg+(match[1].rm_so)),match_length);
1349
line[match_length] = '\0'; // make sure string is null-terminated
1350
IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
1351
if ((fp = fopen(line, "r")) == NULL) {
1352
return errmsg; // return original error if open fails
1353
}
1354
// try to find a GROUP ( ... ) command
1355
while (fgets(line, MAXLINE, fp) != NULL) {
1356
IF_DEBUG(linker, debugBelch("input line = %s", line));
1357
if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
1358
// success -- try to dlopen the first named file
1359
IF_DEBUG(linker, debugBelch("match%s\n",""));
1360
line[match[1].rm_eo] = '\0';
1361
errmsg = internal_dlopen(line+match[1].rm_so);
1362
break;
1363
}
1364
// if control reaches here, no GROUP ( ... ) directive was found
1365
// and the original error message is returned to the caller
1366
}
1367
fclose(fp);
1368
}
1369
return errmsg;
1370
1371
# elif defined(OBJFORMAT_PEi386)
1372
/* ------------------- Win32 DLL loader ------------------- */
1373
1374
char* buf;
1375
OpenedDLL* o_dll;
1376
HINSTANCE instance;
1377
1378
initLinker();
1379
1380
/* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1381
1382
/* See if we've already got it, and ignore if so. */
1383
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1384
if (0 == strcmp(o_dll->name, dll_name))
1385
return NULL;
1386
}
1387
1388
/* The file name has no suffix (yet) so that we can try
1389
both foo.dll and foo.drv
1390
1391
The documentation for LoadLibrary says:
1392
If no file name extension is specified in the lpFileName
1393
parameter, the default library extension .dll is
1394
appended. However, the file name string can include a trailing
1395
point character (.) to indicate that the module name has no
1396
extension. */
1397
1398
buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1399
sprintf(buf, "%s.DLL", dll_name);
1400
instance = LoadLibrary(buf);
1401
if (instance == NULL) {
1402
if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1403
// KAA: allow loading of drivers (like winspool.drv)
1404
sprintf(buf, "%s.DRV", dll_name);
1405
instance = LoadLibrary(buf);
1406
if (instance == NULL) {
1407
if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1408
// #1883: allow loading of unix-style libfoo.dll DLLs
1409
sprintf(buf, "lib%s.DLL", dll_name);
1410
instance = LoadLibrary(buf);
1411
if (instance == NULL) {
1412
goto error;
1413
}
1414
}
1415
}
1416
stgFree(buf);
1417
1418
/* Add this DLL to the list of DLLs in which to search for symbols. */
1419
o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1420
o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1421
strcpy(o_dll->name, dll_name);
1422
o_dll->instance = instance;
1423
o_dll->next = opened_dlls;
1424
opened_dlls = o_dll;
1425
1426
return NULL;
1427
1428
error:
1429
stgFree(buf);
1430
sysErrorBelch(dll_name);
1431
1432
/* LoadLibrary failed; return a ptr to the error msg. */
1433
return "addDLL: could not load DLL";
1434
1435
# else
1436
barf("addDLL: not implemented on this platform");
1437
# endif
1438
}
1439
1440
/* -----------------------------------------------------------------------------
1441
* insert a stable symbol in the hash table
1442
*/
1443
1444
void
1445
insertStableSymbol(char* obj_name, char* key, StgPtr p)
1446
{
1447
ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1448
}
1449
1450
1451
/* -----------------------------------------------------------------------------
1452
* insert a symbol in the hash table
1453
*/
1454
void
1455
insertSymbol(char* obj_name, char* key, void* data)
1456
{
1457
ghciInsertStrHashTable(obj_name, symhash, key, data);
1458
}
1459
1460
/* -----------------------------------------------------------------------------
1461
* lookup a symbol in the hash table
1462
*/
1463
void *
1464
lookupSymbol( char *lbl )
1465
{
1466
void *val;
1467
IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
1468
initLinker() ;
1469
ASSERT(symhash != NULL);
1470
val = lookupStrHashTable(symhash, lbl);
1471
1472
if (val == NULL) {
1473
IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
1474
# if defined(OBJFORMAT_ELF)
1475
return dlsym(dl_prog_handle, lbl);
1476
# elif defined(OBJFORMAT_MACHO)
1477
# if HAVE_DLFCN_H
1478
/* On OS X 10.3 and later, we use dlsym instead of the old legacy
1479
interface.
1480
1481
HACK: On OS X, global symbols are prefixed with an underscore.
1482
However, dlsym wants us to omit the leading underscore from the
1483
symbol name. For now, we simply strip it off here (and ONLY
1484
here).
1485
*/
1486
IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
1487
ASSERT(lbl[0] == '_');
1488
return dlsym(dl_prog_handle, lbl+1);
1489
# else
1490
if(NSIsSymbolNameDefined(lbl)) {
1491
NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1492
return NSAddressOfSymbol(symbol);
1493
} else {
1494
return NULL;
1495
}
1496
# endif /* HAVE_DLFCN_H */
1497
# elif defined(OBJFORMAT_PEi386)
1498
void* sym;
1499
1500
sym = lookupSymbolInDLLs((unsigned char*)lbl);
1501
if (sym != NULL) { return sym; };
1502
1503
// Also try looking up the symbol without the @N suffix. Some
1504
// DLLs have the suffixes on their symbols, some don't.
1505
zapTrailingAtSign ( (unsigned char*)lbl );
1506
sym = lookupSymbolInDLLs((unsigned char*)lbl);
1507
if (sym != NULL) { return sym; };
1508
return NULL;
1509
1510
# else
1511
ASSERT(2+2 == 5);
1512
return NULL;
1513
# endif
1514
} else {
1515
IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
1516
return val;
1517
}
1518
}
1519
1520
/* -----------------------------------------------------------------------------
1521
* Debugging aid: look in GHCi's object symbol tables for symbols
1522
* within DELTA bytes of the specified address, and show their names.
1523
*/
1524
#ifdef DEBUG
1525
void ghci_enquire ( char* addr );
1526
1527
void ghci_enquire ( char* addr )
1528
{
1529
int i;
1530
char* sym;
1531
char* a;
1532
const int DELTA = 64;
1533
ObjectCode* oc;
1534
1535
initLinker();
1536
1537
for (oc = objects; oc; oc = oc->next) {
1538
for (i = 0; i < oc->n_symbols; i++) {
1539
sym = oc->symbols[i];
1540
if (sym == NULL) continue;
1541
a = NULL;
1542
if (a == NULL) {
1543
a = lookupStrHashTable(symhash, sym);
1544
}
1545
if (a == NULL) {
1546
// debugBelch("ghci_enquire: can't find %s\n", sym);
1547
}
1548
else if (addr-DELTA <= a && a <= addr+DELTA) {
1549
debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1550
}
1551
}
1552
}
1553
}
1554
#endif
1555
1556
#ifdef USE_MMAP
1557
#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1558
1559
static void *
1560
mmapForLinker (size_t bytes, nat flags, int fd)
1561
{
1562
void *map_addr = NULL;
1563
void *result;
1564
int pagesize, size;
1565
static nat fixed = 0;
1566
1567
pagesize = getpagesize();
1568
size = ROUND_UP(bytes, pagesize);
1569
1570
#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1571
mmap_again:
1572
1573
if (mmap_32bit_base != 0) {
1574
map_addr = mmap_32bit_base;
1575
}
1576
#endif
1577
1578
result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
1579
MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
1580
1581
if (result == MAP_FAILED) {
1582
sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
1583
errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1584
stg_exit(EXIT_FAILURE);
1585
}
1586
1587
#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1588
if (mmap_32bit_base != 0) {
1589
if (result == map_addr) {
1590
mmap_32bit_base = (StgWord8*)map_addr + size;
1591
} else {
1592
if ((W_)result > 0x80000000) {
1593
// oops, we were given memory over 2Gb
1594
#if defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS)
1595
// Some platforms require MAP_FIXED. This is normally
1596
// a bad idea, because MAP_FIXED will overwrite
1597
// existing mappings.
1598
munmap(result,size);
1599
fixed = MAP_FIXED;
1600
goto mmap_again;
1601
#else
1602
barf("loadObj: failed to mmap() memory below 2Gb; asked for %lu bytes at %p. Try specifying an address with +RTS -xm<addr> -RTS", size, map_addr, result);
1603
#endif
1604
} else {
1605
// hmm, we were given memory somewhere else, but it's
1606
// still under 2Gb so we can use it. Next time, ask
1607
// for memory right after the place we just got some
1608
mmap_32bit_base = (StgWord8*)result + size;
1609
}
1610
}
1611
} else {
1612
if ((W_)result > 0x80000000) {
1613
// oops, we were given memory over 2Gb
1614
// ... try allocating memory somewhere else?;
1615
debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
1616
munmap(result, size);
1617
1618
// Set a base address and try again... (guess: 1Gb)
1619
mmap_32bit_base = (void*)0x40000000;
1620
goto mmap_again;
1621
}
1622
}
1623
#endif
1624
1625
return result;
1626
}
1627
#endif // USE_MMAP
1628
1629
static ObjectCode*
1630
mkOc( char *path, char *image, int imageSize,
1631
char *archiveMemberName
1632
#ifndef USE_MMAP
1633
#ifdef powerpc_HOST_ARCH
1634
, int misalignment
1635
#endif
1636
#endif
1637
) {
1638
ObjectCode* oc;
1639
1640
oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
1641
1642
# if defined(OBJFORMAT_ELF)
1643
oc->formatName = "ELF";
1644
# elif defined(OBJFORMAT_PEi386)
1645
oc->formatName = "PEi386";
1646
# elif defined(OBJFORMAT_MACHO)
1647
oc->formatName = "Mach-O";
1648
# else
1649
stgFree(oc);
1650
barf("loadObj: not implemented on this platform");
1651
# endif
1652
1653
oc->image = image;
1654
/* sigh, strdup() isn't a POSIX function, so do it the long way */
1655
oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1656
strcpy(oc->fileName, path);
1657
1658
if (archiveMemberName) {
1659
oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
1660
strcpy(oc->archiveMemberName, archiveMemberName);
1661
}
1662
else {
1663
oc->archiveMemberName = NULL;
1664
}
1665
1666
oc->fileSize = imageSize;
1667
oc->symbols = NULL;
1668
oc->sections = NULL;
1669
oc->proddables = NULL;
1670
1671
#ifndef USE_MMAP
1672
#ifdef powerpc_HOST_ARCH
1673
oc->misalignment = misalignment;
1674
#endif
1675
#endif
1676
1677
/* chain it onto the list of objects */
1678
oc->next = objects;
1679
objects = oc;
1680
1681
return oc;
1682
}
1683
1684
HsInt
1685
loadArchive( char *path )
1686
{
1687
ObjectCode* oc;
1688
char *image;
1689
int memberSize;
1690
FILE *f;
1691
int n;
1692
size_t thisFileNameSize;
1693
char *fileName;
1694
size_t fileNameSize;
1695
int isObject, isGnuIndex;
1696
char tmp[12];
1697
char *gnuFileIndex;
1698
int gnuFileIndexSize;
1699
#if !defined(USE_MMAP) && defined(powerpc_HOST_ARCH)
1700
int misalignment;
1701
#endif
1702
1703
IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
1704
1705
gnuFileIndex = NULL;
1706
gnuFileIndexSize = 0;
1707
1708
fileNameSize = 32;
1709
fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
1710
1711
f = fopen(path, "rb");
1712
if (!f)
1713
barf("loadObj: can't read `%s'", path);
1714
1715
n = fread ( tmp, 1, 8, f );
1716
if (strncmp(tmp, "!<arch>\n", 8) != 0)
1717
barf("loadArchive: Not an archive: `%s'", path);
1718
1719
while(1) {
1720
n = fread ( fileName, 1, 16, f );
1721
if (n != 16) {
1722
if (feof(f)) {
1723
break;
1724
}
1725
else {
1726
barf("loadArchive: Failed reading file name from `%s'", path);
1727
}
1728
}
1729
n = fread ( tmp, 1, 12, f );
1730
if (n != 12)
1731
barf("loadArchive: Failed reading mod time from `%s'", path);
1732
n = fread ( tmp, 1, 6, f );
1733
if (n != 6)
1734
barf("loadArchive: Failed reading owner from `%s'", path);
1735
n = fread ( tmp, 1, 6, f );
1736
if (n != 6)
1737
barf("loadArchive: Failed reading group from `%s'", path);
1738
n = fread ( tmp, 1, 8, f );
1739
if (n != 8)
1740
barf("loadArchive: Failed reading mode from `%s'", path);
1741
n = fread ( tmp, 1, 10, f );
1742
if (n != 10)
1743
barf("loadArchive: Failed reading size from `%s'", path);
1744
tmp[10] = '\0';
1745
for (n = 0; isdigit(tmp[n]); n++);
1746
tmp[n] = '\0';
1747
memberSize = atoi(tmp);
1748
n = fread ( tmp, 1, 2, f );
1749
if (strncmp(tmp, "\x60\x0A", 2) != 0)
1750
barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
1751
path, ftell(f), tmp[0], tmp[1]);
1752
1753
isGnuIndex = 0;
1754
/* Check for BSD-variant large filenames */
1755
if (0 == strncmp(fileName, "#1/", 3)) {
1756
fileName[16] = '\0';
1757
if (isdigit(fileName[3])) {
1758
for (n = 4; isdigit(fileName[n]); n++);
1759
fileName[n] = '\0';
1760
thisFileNameSize = atoi(fileName + 3);
1761
memberSize -= thisFileNameSize;
1762
if (thisFileNameSize >= fileNameSize) {
1763
/* Double it to avoid potentially continually
1764
increasing it by 1 */
1765
fileNameSize = thisFileNameSize * 2;
1766
fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1767
}
1768
n = fread ( fileName, 1, thisFileNameSize, f );
1769
if (n != (int)thisFileNameSize) {
1770
barf("loadArchive: Failed reading filename from `%s'",
1771
path);
1772
}
1773
fileName[thisFileNameSize] = 0;
1774
}
1775
else {
1776
barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
1777
}
1778
}
1779
/* Check for GNU file index file */
1780
else if (0 == strncmp(fileName, "//", 2)) {
1781
fileName[0] = '\0';
1782
thisFileNameSize = 0;
1783
isGnuIndex = 1;
1784
}
1785
/* Check for a file in the GNU file index */
1786
else if (fileName[0] == '/') {
1787
if (isdigit(fileName[1])) {
1788
int i;
1789
1790
for (n = 2; isdigit(fileName[n]); n++);
1791
fileName[n] = '\0';
1792
n = atoi(fileName + 1);
1793
1794
if (gnuFileIndex == NULL) {
1795
barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
1796
}
1797
if (n < 0 || n > gnuFileIndexSize) {
1798
barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
1799
}
1800
if (n != 0 && gnuFileIndex[n - 1] != '\n') {
1801
barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
1802
}
1803
for (i = n; gnuFileIndex[i] != '/'; i++);
1804
thisFileNameSize = i - n;
1805
if (thisFileNameSize >= fileNameSize) {
1806
/* Double it to avoid potentially continually
1807
increasing it by 1 */
1808
fileNameSize = thisFileNameSize * 2;
1809
fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1810
}
1811
memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
1812
fileName[thisFileNameSize] = '\0';
1813
}
1814
else if (fileName[1] == ' ') {
1815
fileName[0] = '\0';
1816
thisFileNameSize = 0;
1817
}
1818
else {
1819
barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
1820
}
1821
}
1822
/* Finally, the case where the filename field actually contains
1823
the filename */
1824
else {
1825
/* GNU ar terminates filenames with a '/', this allowing
1826
spaces in filenames. So first look to see if there is a
1827
terminating '/'. */
1828
for (thisFileNameSize = 0;
1829
thisFileNameSize < 16;
1830
thisFileNameSize++) {
1831
if (fileName[thisFileNameSize] == '/') {
1832
fileName[thisFileNameSize] = '\0';
1833
break;
1834
}
1835
}
1836
/* If we didn't find a '/', then a space teminates the
1837
filename. Note that if we don't find one, then
1838
thisFileNameSize ends up as 16, and we already have the
1839
'\0' at the end. */
1840
if (thisFileNameSize == 16) {
1841
for (thisFileNameSize = 0;
1842
thisFileNameSize < 16;
1843
thisFileNameSize++) {
1844
if (fileName[thisFileNameSize] == ' ') {
1845
fileName[thisFileNameSize] = '\0';
1846
break;
1847
}
1848
}
1849
}
1850
}
1851
1852
IF_DEBUG(linker,
1853
debugBelch("loadArchive: Found member file `%s'\n", fileName));
1854
1855
isObject = thisFileNameSize >= 2
1856
&& fileName[thisFileNameSize - 2] == '.'
1857
&& fileName[thisFileNameSize - 1] == 'o';
1858
1859
if (isObject) {
1860
char *archiveMemberName;
1861
1862
IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
1863
1864
/* We can't mmap from the archive directly, as object
1865
files need to be 8-byte aligned but files in .ar
1866
archives are 2-byte aligned. When possible we use mmap
1867
to get some anonymous memory, as on 64-bit platforms if
1868
we use malloc then we can be given memory above 2^32.
1869
In the mmap case we're probably wasting lots of space;
1870
we could do better. */
1871
#if defined(USE_MMAP)
1872
image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
1873
#elif defined(darwin_HOST_OS)
1874
/* See loadObj() */
1875
misalignment = machoGetMisalignment(f);
1876
image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
1877
image += misalignment;
1878
#else
1879
image = stgMallocBytes(memberSize, "loadArchive(image)");
1880
#endif
1881
n = fread ( image, 1, memberSize, f );
1882
if (n != memberSize) {
1883
barf("loadArchive: error whilst reading `%s'", path);
1884
}
1885
1886
archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
1887
"loadArchive(file)");
1888
sprintf(archiveMemberName, "%s(%.*s)",
1889
path, (int)thisFileNameSize, fileName);
1890
1891
oc = mkOc(path, image, memberSize, archiveMemberName
1892
#ifndef USE_MMAP
1893
#ifdef powerpc_HOST_ARCH
1894
, misalignment
1895
#endif
1896
#endif
1897
);
1898
1899
stgFree(archiveMemberName);
1900
1901
if (0 == loadOc(oc)) {
1902
stgFree(fileName);
1903
return 0;
1904
}
1905
}
1906
else if (isGnuIndex) {
1907
if (gnuFileIndex != NULL) {
1908
barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
1909
}
1910
IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
1911
#ifdef USE_MMAP
1912
gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
1913
#else
1914
gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
1915
#endif
1916
n = fread ( gnuFileIndex, 1, memberSize, f );
1917
if (n != memberSize) {
1918
barf("loadArchive: error whilst reading `%s'", path);
1919
}
1920
gnuFileIndex[memberSize] = '/';
1921
gnuFileIndexSize = memberSize;
1922
}
1923
else {
1924
n = fseek(f, memberSize, SEEK_CUR);
1925
if (n != 0)
1926
barf("loadArchive: error whilst seeking by %d in `%s'",
1927
memberSize, path);
1928
}
1929
/* .ar files are 2-byte aligned */
1930
if (memberSize % 2) {
1931
n = fread ( tmp, 1, 1, f );
1932
if (n != 1) {
1933
if (feof(f)) {
1934
break;
1935
}
1936
else {
1937
barf("loadArchive: Failed reading padding from `%s'", path);
1938
}
1939
}
1940
}
1941
}
1942
1943
fclose(f);
1944
1945
stgFree(fileName);
1946
if (gnuFileIndex != NULL) {
1947
#ifdef USE_MMAP
1948
munmap(gnuFileIndex, gnuFileIndexSize + 1);
1949
#else
1950
stgFree(gnuFileIndex);
1951
#endif
1952
}
1953
1954
return 1;
1955
}
1956
1957
/* -----------------------------------------------------------------------------
1958
* Load an obj (populate the global symbol table, but don't resolve yet)
1959
*
1960
* Returns: 1 if ok, 0 on error.
1961
*/
1962
HsInt
1963
loadObj( char *path )
1964
{
1965
ObjectCode* oc;
1966
char *image;
1967
int fileSize;
1968
struct stat st;
1969
int r;
1970
#ifdef USE_MMAP
1971
int fd;
1972
#else
1973
FILE *f;
1974
# if defined(powerpc_HOST_ARCH)
1975
int misalignment;
1976
# endif
1977
#endif
1978
IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
1979
1980
initLinker();
1981
1982
/* debugBelch("loadObj %s\n", path ); */
1983
1984
/* Check that we haven't already loaded this object.
1985
Ignore requests to load multiple times */
1986
{
1987
ObjectCode *o;
1988
int is_dup = 0;
1989
for (o = objects; o; o = o->next) {
1990
if (0 == strcmp(o->fileName, path)) {
1991
is_dup = 1;
1992
break; /* don't need to search further */
1993
}
1994
}
1995
if (is_dup) {
1996
IF_DEBUG(linker, debugBelch(
1997
"GHCi runtime linker: warning: looks like you're trying to load the\n"
1998
"same object file twice:\n"
1999
" %s\n"
2000
"GHCi will ignore this, but be warned.\n"
2001
, path));
2002
return 1; /* success */
2003
}
2004
}
2005
2006
r = stat(path, &st);
2007
if (r == -1) {
2008
IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
2009
return 0;
2010
}
2011
2012
fileSize = st.st_size;
2013
2014
#ifdef USE_MMAP
2015
/* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
2016
2017
#if defined(openbsd_HOST_OS)
2018
fd = open(path, O_RDONLY, S_IRUSR);
2019
#else
2020
fd = open(path, O_RDONLY);
2021
#endif
2022
if (fd == -1)
2023
barf("loadObj: can't open `%s'", path);
2024
2025
image = mmapForLinker(fileSize, 0, fd);
2026
2027
close(fd);
2028
2029
#else /* !USE_MMAP */
2030
/* load the image into memory */
2031
f = fopen(path, "rb");
2032
if (!f)
2033
barf("loadObj: can't read `%s'", path);
2034
2035
# if defined(mingw32_HOST_OS)
2036
// TODO: We would like to use allocateExec here, but allocateExec
2037
// cannot currently allocate blocks large enough.
2038
image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
2039
PAGE_EXECUTE_READWRITE);
2040
# elif defined(darwin_HOST_OS)
2041
// In a Mach-O .o file, all sections can and will be misaligned
2042
// if the total size of the headers is not a multiple of the
2043
// desired alignment. This is fine for .o files that only serve
2044
// as input for the static linker, but it's not fine for us,
2045
// as SSE (used by gcc for floating point) and Altivec require
2046
// 16-byte alignment.
2047
// We calculate the correct alignment from the header before
2048
// reading the file, and then we misalign image on purpose so
2049
// that the actual sections end up aligned again.
2050
misalignment = machoGetMisalignment(f);
2051
image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
2052
image += misalignment;
2053
# else
2054
image = stgMallocBytes(fileSize, "loadObj(image)");
2055
# endif
2056
2057
{
2058
int n;
2059
n = fread ( image, 1, fileSize, f );
2060
if (n != fileSize)
2061
barf("loadObj: error whilst reading `%s'", path);
2062
}
2063
fclose(f);
2064
#endif /* USE_MMAP */
2065
2066
oc = mkOc(path, image, fileSize, NULL
2067
#ifndef USE_MMAP
2068
#ifdef powerpc_HOST_ARCH
2069
, misalignment
2070
#endif
2071
#endif
2072
);
2073
2074
return loadOc(oc);
2075
}
2076
2077
static HsInt
2078
loadOc( ObjectCode* oc ) {
2079
int r;
2080
2081
IF_DEBUG(linker, debugBelch("loadOc\n"));
2082
2083
# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
2084
r = ocAllocateSymbolExtras_MachO ( oc );
2085
if (!r) {
2086
IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO failed\n"));
2087
return r;
2088
}
2089
# elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
2090
r = ocAllocateSymbolExtras_ELF ( oc );
2091
if (!r) {
2092
IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_ELF failed\n"));
2093
return r;
2094
}
2095
#endif
2096
2097
/* verify the in-memory image */
2098
# if defined(OBJFORMAT_ELF)
2099
r = ocVerifyImage_ELF ( oc );
2100
# elif defined(OBJFORMAT_PEi386)
2101
r = ocVerifyImage_PEi386 ( oc );
2102
# elif defined(OBJFORMAT_MACHO)
2103
r = ocVerifyImage_MachO ( oc );
2104
# else
2105
barf("loadObj: no verify method");
2106
# endif
2107
if (!r) {
2108
IF_DEBUG(linker, debugBelch("ocVerifyImage_* failed\n"));
2109
return r;
2110
}
2111
2112
/* build the symbol list for this image */
2113
# if defined(OBJFORMAT_ELF)
2114
r = ocGetNames_ELF ( oc );
2115
# elif defined(OBJFORMAT_PEi386)
2116
r = ocGetNames_PEi386 ( oc );
2117
# elif defined(OBJFORMAT_MACHO)
2118
r = ocGetNames_MachO ( oc );
2119
# else
2120
barf("loadObj: no getNames method");
2121
# endif
2122
if (!r) {
2123
IF_DEBUG(linker, debugBelch("ocGetNames_* failed\n"));
2124
return r;
2125
}
2126
2127
/* loaded, but not resolved yet */
2128
oc->status = OBJECT_LOADED;
2129
IF_DEBUG(linker, debugBelch("loadObj done.\n"));
2130
2131
return 1;
2132
}
2133
2134
/* -----------------------------------------------------------------------------
2135
* resolve all the currently unlinked objects in memory
2136
*
2137
* Returns: 1 if ok, 0 on error.
2138
*/
2139
HsInt
2140
resolveObjs( void )
2141
{
2142
ObjectCode *oc;
2143
int r;
2144
2145
IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
2146
initLinker();
2147
2148
for (oc = objects; oc; oc = oc->next) {
2149
if (oc->status != OBJECT_RESOLVED) {
2150
# if defined(OBJFORMAT_ELF)
2151
r = ocResolve_ELF ( oc );
2152
# elif defined(OBJFORMAT_PEi386)
2153
r = ocResolve_PEi386 ( oc );
2154
# elif defined(OBJFORMAT_MACHO)
2155
r = ocResolve_MachO ( oc );
2156
# else
2157
barf("resolveObjs: not implemented on this platform");
2158
# endif
2159
if (!r) { return r; }
2160
oc->status = OBJECT_RESOLVED;
2161
}
2162
}
2163
IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
2164
return 1;
2165
}
2166
2167
/* -----------------------------------------------------------------------------
2168
* delete an object from the pool
2169
*/
2170
HsInt
2171
unloadObj( char *path )
2172
{
2173
ObjectCode *oc, *prev;
2174
HsBool unloadedAnyObj = HS_BOOL_FALSE;
2175
2176
ASSERT(symhash != NULL);
2177
ASSERT(objects != NULL);
2178
2179
initLinker();
2180
2181
prev = NULL;
2182
for (oc = objects; oc; prev = oc, oc = oc->next) {
2183
if (!strcmp(oc->fileName,path)) {
2184
2185
/* Remove all the mappings for the symbols within this
2186
* object..
2187
*/
2188
{
2189
int i;
2190
for (i = 0; i < oc->n_symbols; i++) {
2191
if (oc->symbols[i] != NULL) {
2192
removeStrHashTable(symhash, oc->symbols[i], NULL);
2193
}
2194
}
2195
}
2196
2197
if (prev == NULL) {
2198
objects = oc->next;
2199
} else {
2200
prev->next = oc->next;
2201
}
2202
2203
// We're going to leave this in place, in case there are
2204
// any pointers from the heap into it:
2205
// #ifdef mingw32_HOST_OS
2206
// VirtualFree(oc->image);
2207
// #else
2208
// stgFree(oc->image);
2209
// #endif
2210
stgFree(oc->fileName);
2211
stgFree(oc->symbols);
2212
stgFree(oc->sections);
2213
stgFree(oc);
2214
2215
/* This could be a member of an archive so continue
2216
* unloading other members. */
2217
unloadedAnyObj = HS_BOOL_TRUE;
2218
}
2219
}
2220
2221
if (unloadedAnyObj) {
2222
return 1;
2223
}
2224
else {
2225
errorBelch("unloadObj: can't find `%s' to unload", path);
2226
return 0;
2227
}
2228
}
2229
2230
/* -----------------------------------------------------------------------------
2231
* Sanity checking. For each ObjectCode, maintain a list of address ranges
2232
* which may be prodded during relocation, and abort if we try and write
2233
* outside any of these.
2234
*/
2235
static void addProddableBlock ( ObjectCode* oc, void* start, int size )
2236
{
2237
ProddableBlock* pb
2238
= stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
2239
IF_DEBUG(linker, debugBelch("addProddableBlock %p %p %d\n", oc, start, size));
2240
ASSERT(size > 0);
2241
pb->start = start;
2242
pb->size = size;
2243
pb->next = oc->proddables;
2244
oc->proddables = pb;
2245
}
2246
2247
static void checkProddableBlock ( ObjectCode* oc, void* addr )
2248
{
2249
ProddableBlock* pb;
2250
for (pb = oc->proddables; pb != NULL; pb = pb->next) {
2251
char* s = (char*)(pb->start);
2252
char* e = s + pb->size - 1;
2253
char* a = (char*)addr;
2254
/* Assumes that the biggest fixup involves a 4-byte write. This
2255
probably needs to be changed to 8 (ie, +7) on 64-bit
2256
plats. */
2257
if (a >= s && (a+3) <= e) return;
2258
}
2259
barf("checkProddableBlock: invalid fixup in runtime linker");
2260
}
2261
2262
/* -----------------------------------------------------------------------------
2263
* Section management.
2264
*/
2265
static void addSection ( ObjectCode* oc, SectionKind kind,
2266
void* start, void* end )
2267
{
2268
Section* s = stgMallocBytes(sizeof(Section), "addSection");
2269
s->start = start;
2270
s->end = end;
2271
s->kind = kind;
2272
s->next = oc->sections;
2273
oc->sections = s;
2274
/*
2275
debugBelch("addSection: %p-%p (size %d), kind %d\n",
2276
start, ((char*)end)-1, end - start + 1, kind );
2277
*/
2278
}
2279
2280
2281
/* --------------------------------------------------------------------------
2282
* Symbol Extras.
2283
* This is about allocating a small chunk of memory for every symbol in the
2284
* object file. We make sure that the SymboLExtras are always "in range" of
2285
* limited-range PC-relative instructions on various platforms by allocating
2286
* them right next to the object code itself.
2287
*/
2288
2289
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2290
2291
/*
2292
ocAllocateSymbolExtras
2293
2294
Allocate additional space at the end of the object file image to make room
2295
for jump islands (powerpc, x86_64) and GOT entries (x86_64).
2296
2297
PowerPC relative branch instructions have a 24 bit displacement field.
2298
As PPC code is always 4-byte-aligned, this yields a +-32MB range.
2299
If a particular imported symbol is outside this range, we have to redirect
2300
the jump to a short piece of new code that just loads the 32bit absolute
2301
address and jumps there.
2302
On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
2303
to 32 bits (+-2GB).
2304
2305
This function just allocates space for one SymbolExtra for every
2306
undefined symbol in the object file. The code for the jump islands is
2307
filled in by makeSymbolExtra below.
2308
*/
2309
2310
static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
2311
{
2312
#ifdef USE_MMAP
2313
int pagesize, n, m;
2314
#endif
2315
int aligned;
2316
#ifndef USE_MMAP
2317
int misalignment = 0;
2318
#ifdef powerpc_HOST_ARCH
2319
misalignment = oc->misalignment;
2320
#endif
2321
#endif
2322
2323
if( count > 0 )
2324
{
2325
// round up to the nearest 4
2326
aligned = (oc->fileSize + 3) & ~3;
2327
2328
#ifdef USE_MMAP
2329
pagesize = getpagesize();
2330
n = ROUND_UP( oc->fileSize, pagesize );
2331
m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
2332
2333
/* we try to use spare space at the end of the last page of the
2334
* image for the jump islands, but if there isn't enough space
2335
* then we have to map some (anonymously, remembering MAP_32BIT).
2336
*/
2337
if( m > n ) // we need to allocate more pages
2338
{
2339
oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
2340
MAP_ANONYMOUS, -1);
2341
}
2342
else
2343
{
2344
oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2345
}
2346
#else
2347
oc->image -= misalignment;
2348
oc->image = stgReallocBytes( oc->image,
2349
misalignment +
2350
aligned + sizeof (SymbolExtra) * count,
2351
"ocAllocateSymbolExtras" );
2352
oc->image += misalignment;
2353
2354
oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2355
#endif /* USE_MMAP */
2356
2357
memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
2358
}
2359
else
2360
oc->symbol_extras = NULL;
2361
2362
oc->first_symbol_extra = first;
2363
oc->n_symbol_extras = count;
2364
2365
return 1;
2366
}
2367
2368
static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
2369
unsigned long symbolNumber,
2370
unsigned long target )
2371
{
2372
SymbolExtra *extra;
2373
2374
ASSERT( symbolNumber >= oc->first_symbol_extra
2375
&& symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
2376
2377
extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
2378
2379
#ifdef powerpc_HOST_ARCH
2380
// lis r12, hi16(target)
2381
extra->jumpIsland.lis_r12 = 0x3d80;
2382
extra->jumpIsland.hi_addr = target >> 16;
2383
2384
// ori r12, r12, lo16(target)
2385
extra->jumpIsland.ori_r12_r12 = 0x618c;
2386
extra->jumpIsland.lo_addr = target & 0xffff;
2387
2388
// mtctr r12
2389
extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
2390
2391
// bctr
2392
extra->jumpIsland.bctr = 0x4e800420;
2393
#endif
2394
#ifdef x86_64_HOST_ARCH
2395
// jmp *-14(%rip)
2396
static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
2397
extra->addr = target;
2398
memcpy(extra->jumpIsland, jmp, 6);
2399
#endif
2400
2401
return extra;
2402
}
2403
2404
#endif
2405
2406
/* --------------------------------------------------------------------------
2407
* PowerPC specifics (instruction cache flushing)
2408
* ------------------------------------------------------------------------*/
2409
2410
#ifdef powerpc_HOST_ARCH
2411
/*
2412
ocFlushInstructionCache
2413
2414
Flush the data & instruction caches.
2415
Because the PPC has split data/instruction caches, we have to
2416
do that whenever we modify code at runtime.
2417
*/
2418
static void ocFlushInstructionCacheFrom(void* begin, size_t length)
2419
{
2420
size_t n = (length + 3) / 4;
2421
unsigned long* p = begin;
2422
2423
while (n--)
2424
{
2425
__asm__ volatile ( "dcbf 0,%0\n\t"
2426
"sync\n\t"
2427
"icbi 0,%0"
2428
:
2429
: "r" (p)
2430
);
2431
p++;
2432
}
2433
__asm__ volatile ( "sync\n\t"
2434
"isync"
2435
);
2436
}
2437
static void ocFlushInstructionCache( ObjectCode *oc )
2438
{
2439
/* The main object code */
2440
ocFlushInstructionCacheFrom(oc->image + oc->misalignment, oc->fileSize);
2441
2442
/* Jump Islands */
2443
ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
2444
}
2445
#endif
2446
2447
/* --------------------------------------------------------------------------
2448
* PEi386 specifics (Win32 targets)
2449
* ------------------------------------------------------------------------*/
2450
2451
/* The information for this linker comes from
2452
Microsoft Portable Executable
2453
and Common Object File Format Specification
2454
revision 5.1 January 1998
2455
which SimonM says comes from the MS Developer Network CDs.
2456
2457
It can be found there (on older CDs), but can also be found
2458
online at:
2459
2460
http://www.microsoft.com/hwdev/hardware/PECOFF.asp
2461
2462
(this is Rev 6.0 from February 1999).
2463
2464
Things move, so if that fails, try searching for it via
2465
2466
http://www.google.com/search?q=PE+COFF+specification
2467
2468
The ultimate reference for the PE format is the Winnt.h
2469
header file that comes with the Platform SDKs; as always,
2470
implementations will drift wrt their documentation.
2471
2472
A good background article on the PE format is Matt Pietrek's
2473
March 1994 article in Microsoft System Journal (MSJ)
2474
(Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2475
Win32 Portable Executable File Format." The info in there
2476
has recently been updated in a two part article in
2477
MSDN magazine, issues Feb and March 2002,
2478
"Inside Windows: An In-Depth Look into the Win32 Portable
2479
Executable File Format"
2480
2481
John Levine's book "Linkers and Loaders" contains useful
2482
info on PE too.
2483
*/
2484
2485
2486
#if defined(OBJFORMAT_PEi386)
2487
2488
2489
2490
typedef unsigned char UChar;
2491
typedef unsigned short UInt16;
2492
typedef unsigned int UInt32;
2493
typedef int Int32;
2494
2495
2496
typedef
2497
struct {
2498
UInt16 Machine;
2499
UInt16 NumberOfSections;
2500
UInt32 TimeDateStamp;
2501
UInt32 PointerToSymbolTable;
2502
UInt32 NumberOfSymbols;
2503
UInt16 SizeOfOptionalHeader;
2504
UInt16 Characteristics;
2505
}
2506
COFF_header;
2507
2508
#define sizeof_COFF_header 20
2509
2510
2511
typedef
2512
struct {
2513
UChar Name[8];
2514
UInt32 VirtualSize;
2515
UInt32 VirtualAddress;
2516
UInt32 SizeOfRawData;
2517
UInt32 PointerToRawData;
2518
UInt32 PointerToRelocations;
2519
UInt32 PointerToLinenumbers;
2520
UInt16 NumberOfRelocations;
2521
UInt16 NumberOfLineNumbers;
2522
UInt32 Characteristics;
2523
}
2524
COFF_section;
2525
2526
#define sizeof_COFF_section 40
2527
2528
2529
typedef
2530
struct {
2531
UChar Name[8];
2532
UInt32 Value;
2533
UInt16 SectionNumber;
2534
UInt16 Type;
2535
UChar StorageClass;
2536
UChar NumberOfAuxSymbols;
2537
}
2538
COFF_symbol;
2539
2540
#define sizeof_COFF_symbol 18
2541
2542
2543
typedef
2544
struct {
2545
UInt32 VirtualAddress;
2546
UInt32 SymbolTableIndex;
2547
UInt16 Type;
2548
}
2549
COFF_reloc;
2550
2551
#define sizeof_COFF_reloc 10
2552
2553
2554
/* From PE spec doc, section 3.3.2 */
2555
/* Note use of MYIMAGE_* since IMAGE_* are already defined in
2556
windows.h -- for the same purpose, but I want to know what I'm
2557
getting, here. */
2558
#define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
2559
#define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
2560
#define MYIMAGE_FILE_DLL 0x2000
2561
#define MYIMAGE_FILE_SYSTEM 0x1000
2562
#define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
2563
#define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
2564
#define MYIMAGE_FILE_32BIT_MACHINE 0x0100
2565
2566
/* From PE spec doc, section 5.4.2 and 5.4.4 */
2567
#define MYIMAGE_SYM_CLASS_EXTERNAL 2
2568
#define MYIMAGE_SYM_CLASS_STATIC 3
2569
#define MYIMAGE_SYM_UNDEFINED 0
2570
2571
/* From PE spec doc, section 4.1 */
2572
#define MYIMAGE_SCN_CNT_CODE 0x00000020
2573
#define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
2574
#define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
2575
2576
/* From PE spec doc, section 5.2.1 */
2577
#define MYIMAGE_REL_I386_DIR32 0x0006
2578
#define MYIMAGE_REL_I386_REL32 0x0014
2579
2580
2581
/* We use myindex to calculate array addresses, rather than
2582
simply doing the normal subscript thing. That's because
2583
some of the above structs have sizes which are not
2584
a whole number of words. GCC rounds their sizes up to a
2585
whole number of words, which means that the address calcs
2586
arising from using normal C indexing or pointer arithmetic
2587
are just plain wrong. Sigh.
2588
*/
2589
static UChar *
2590
myindex ( int scale, void* base, int index )
2591
{
2592
return
2593
((UChar*)base) + scale * index;
2594
}
2595
2596
2597
static void
2598
printName ( UChar* name, UChar* strtab )
2599
{
2600
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2601
UInt32 strtab_offset = * (UInt32*)(name+4);
2602
debugBelch("%s", strtab + strtab_offset );
2603
} else {
2604
int i;
2605
for (i = 0; i < 8; i++) {
2606
if (name[i] == 0) break;
2607
debugBelch("%c", name[i] );
2608
}
2609
}
2610
}
2611
2612
2613
static void
2614
copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
2615
{
2616
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2617
UInt32 strtab_offset = * (UInt32*)(name+4);
2618
strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
2619
dst[dstSize-1] = 0;
2620
} else {
2621
int i = 0;
2622
while (1) {
2623
if (i >= 8) break;
2624
if (name[i] == 0) break;
2625
dst[i] = name[i];
2626
i++;
2627
}
2628
dst[i] = 0;
2629
}
2630
}
2631
2632
2633
static UChar *
2634
cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
2635
{
2636
UChar* newstr;
2637
/* If the string is longer than 8 bytes, look in the
2638
string table for it -- this will be correctly zero terminated.
2639
*/
2640
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2641
UInt32 strtab_offset = * (UInt32*)(name+4);
2642
return ((UChar*)strtab) + strtab_offset;
2643
}
2644
/* Otherwise, if shorter than 8 bytes, return the original,
2645
which by defn is correctly terminated.
2646
*/
2647
if (name[7]==0) return name;
2648
/* The annoying case: 8 bytes. Copy into a temporary
2649
(XXX which is never freed ...)
2650
*/
2651
newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
2652
ASSERT(newstr);
2653
strncpy((char*)newstr,(char*)name,8);
2654
newstr[8] = 0;
2655
return newstr;
2656
}
2657
2658
/* Getting the name of a section is mildly tricky, so we make a
2659
function for it. Sadly, in one case we have to copy the string
2660
(when it is exactly 8 bytes long there's no trailing '\0'), so for
2661
consistency we *always* copy the string; the caller must free it
2662
*/
2663
static char *
2664
cstring_from_section_name (UChar* name, UChar* strtab)
2665
{
2666
char *newstr;
2667
2668
if (name[0]=='/') {
2669
int strtab_offset = strtol((char*)name+1,NULL,10);
2670
int len = strlen(((char*)strtab) + strtab_offset);
2671
2672
newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
2673
strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
2674
return newstr;
2675
}
2676
else
2677
{
2678
newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
2679
ASSERT(newstr);
2680
strncpy((char*)newstr,(char*)name,8);
2681
newstr[8] = 0;
2682
return newstr;
2683
}
2684
}
2685
2686
/* Just compares the short names (first 8 chars) */
2687
static COFF_section *
2688
findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
2689
{
2690
int i;
2691
COFF_header* hdr
2692
= (COFF_header*)(oc->image);
2693
COFF_section* sectab
2694
= (COFF_section*) (
2695
((UChar*)(oc->image))
2696
+ sizeof_COFF_header + hdr->SizeOfOptionalHeader
2697
);
2698
for (i = 0; i < hdr->NumberOfSections; i++) {
2699
UChar* n1;
2700
UChar* n2;
2701
COFF_section* section_i
2702
= (COFF_section*)
2703
myindex ( sizeof_COFF_section, sectab, i );
2704
n1 = (UChar*) &(section_i->Name);
2705
n2 = name;
2706
if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
2707
n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
2708
n1[6]==n2[6] && n1[7]==n2[7])
2709
return section_i;
2710
}
2711
2712
return NULL;
2713
}
2714
2715
2716
static void
2717
zapTrailingAtSign ( UChar* sym )
2718
{
2719
# define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2720
int i, j;
2721
if (sym[0] == 0) return;
2722
i = 0;
2723
while (sym[i] != 0) i++;
2724
i--;
2725
j = i;
2726
while (j > 0 && my_isdigit(sym[j])) j--;
2727
if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2728
# undef my_isdigit
2729
}
2730
2731
static void *
2732
lookupSymbolInDLLs ( UChar *lbl )
2733
{
2734
OpenedDLL* o_dll;
2735
void *sym;
2736
2737
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2738
/* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
2739
2740
if (lbl[0] == '_') {
2741
/* HACK: if the name has an initial underscore, try stripping
2742
it off & look that up first. I've yet to verify whether there's
2743
a Rule that governs whether an initial '_' *should always* be
2744
stripped off when mapping from import lib name to the DLL name.
2745
*/
2746
sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
2747
if (sym != NULL) {
2748
/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
2749
return sym;
2750
}
2751
}
2752
sym = GetProcAddress(o_dll->instance, (char*)lbl);
2753
if (sym != NULL) {
2754
/*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
2755
return sym;
2756
}
2757
}
2758
return NULL;
2759
}
2760
2761
2762
static int
2763
ocVerifyImage_PEi386 ( ObjectCode* oc )
2764
{
2765
int i;
2766
UInt32 j, noRelocs;
2767
COFF_header* hdr;
2768
COFF_section* sectab;
2769
COFF_symbol* symtab;
2770
UChar* strtab;
2771
/* debugBelch("\nLOADING %s\n", oc->fileName); */
2772
hdr = (COFF_header*)(oc->image);
2773
sectab = (COFF_section*) (
2774
((UChar*)(oc->image))
2775
+ sizeof_COFF_header + hdr->SizeOfOptionalHeader
2776
);
2777
symtab = (COFF_symbol*) (
2778
((UChar*)(oc->image))
2779
+ hdr->PointerToSymbolTable
2780
);
2781
strtab = ((UChar*)symtab)
2782
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
2783
2784
if (hdr->Machine != 0x14c) {
2785
errorBelch("%s: Not x86 PEi386", oc->fileName);
2786
return 0;
2787
}
2788
if (hdr->SizeOfOptionalHeader != 0) {
2789
errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2790
return 0;
2791
}
2792
if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2793
(hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2794
(hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2795
(hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2796
errorBelch("%s: Not a PEi386 object file", oc->fileName);
2797
return 0;
2798
}
2799
if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2800
/* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2801
errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2802
oc->fileName,
2803
(int)(hdr->Characteristics));
2804
return 0;
2805
}
2806
/* If the string table size is way crazy, this might indicate that
2807
there are more than 64k relocations, despite claims to the
2808
contrary. Hence this test. */
2809
/* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2810
#if 0
2811
if ( (*(UInt32*)strtab) > 600000 ) {
2812
/* Note that 600k has no special significance other than being
2813
big enough to handle the almost-2MB-sized lumps that
2814
constitute HSwin32*.o. */
2815
debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2816
return 0;
2817
}
2818
#endif
2819
2820
/* No further verification after this point; only debug printing. */
2821
i = 0;
2822
IF_DEBUG(linker, i=1);
2823
if (i == 0) return 1;
2824
2825
debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2826
debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2827
debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2828
2829
debugBelch("\n" );
2830
debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2831
debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2832
debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2833
debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2834
debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2835
debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2836
debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2837
2838
/* Print the section table. */
2839
debugBelch("\n" );
2840
for (i = 0; i < hdr->NumberOfSections; i++) {
2841
COFF_reloc* reltab;
2842
COFF_section* sectab_i
2843
= (COFF_section*)
2844
myindex ( sizeof_COFF_section, sectab, i );
2845
debugBelch(
2846
"\n"
2847
"section %d\n"
2848
" name `",
2849
i
2850
);
2851
printName ( sectab_i->Name, strtab );
2852
debugBelch(
2853
"'\n"
2854
" vsize %d\n"
2855
" vaddr %d\n"
2856
" data sz %d\n"
2857
" data off %d\n"
2858
" num rel %d\n"
2859
" off rel %d\n"
2860
" ptr raw 0x%x\n",
2861
sectab_i->VirtualSize,
2862
sectab_i->VirtualAddress,
2863
sectab_i->SizeOfRawData,
2864
sectab_i->PointerToRawData,
2865
sectab_i->NumberOfRelocations,
2866
sectab_i->PointerToRelocations,
2867
sectab_i->PointerToRawData
2868
);
2869
reltab = (COFF_reloc*) (
2870
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2871
);
2872
2873
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2874
/* If the relocation field (a short) has overflowed, the
2875
* real count can be found in the first reloc entry.
2876
*
2877
* See Section 4.1 (last para) of the PE spec (rev6.0).
2878
*/
2879
COFF_reloc* rel = (COFF_reloc*)
2880
myindex ( sizeof_COFF_reloc, reltab, 0 );
2881
noRelocs = rel->VirtualAddress;
2882
j = 1;
2883
} else {
2884
noRelocs = sectab_i->NumberOfRelocations;
2885
j = 0;
2886
}
2887
2888
for (; j < noRelocs; j++) {
2889
COFF_symbol* sym;
2890
COFF_reloc* rel = (COFF_reloc*)
2891
myindex ( sizeof_COFF_reloc, reltab, j );
2892
debugBelch(
2893
" type 0x%-4x vaddr 0x%-8x name `",
2894
(UInt32)rel->Type,
2895
rel->VirtualAddress );
2896
sym = (COFF_symbol*)
2897
myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2898
/* Hmm..mysterious looking offset - what's it for? SOF */
2899
printName ( sym->Name, strtab -10 );
2900
debugBelch("'\n" );
2901
}
2902
2903
debugBelch("\n" );
2904
}
2905
debugBelch("\n" );
2906
debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2907
debugBelch("---START of string table---\n");
2908
for (i = 4; i < *(Int32*)strtab; i++) {
2909
if (strtab[i] == 0)
2910
debugBelch("\n"); else
2911
debugBelch("%c", strtab[i] );
2912
}
2913
debugBelch("--- END of string table---\n");
2914
2915
debugBelch("\n" );
2916
i = 0;
2917
while (1) {
2918
COFF_symbol* symtab_i;
2919
if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2920
symtab_i = (COFF_symbol*)
2921
myindex ( sizeof_COFF_symbol, symtab, i );
2922
debugBelch(
2923
"symbol %d\n"
2924
" name `",
2925
i
2926
);
2927
printName ( symtab_i->Name, strtab );
2928
debugBelch(
2929
"'\n"
2930
" value 0x%x\n"
2931
" 1+sec# %d\n"
2932
" type 0x%x\n"
2933
" sclass 0x%x\n"
2934
" nAux %d\n",
2935
symtab_i->Value,
2936
(Int32)(symtab_i->SectionNumber),
2937
(UInt32)symtab_i->Type,
2938
(UInt32)symtab_i->StorageClass,
2939
(UInt32)symtab_i->NumberOfAuxSymbols
2940
);
2941
i += symtab_i->NumberOfAuxSymbols;
2942
i++;
2943
}
2944
2945
debugBelch("\n" );
2946
return 1;
2947
}
2948
2949
2950
static int
2951
ocGetNames_PEi386 ( ObjectCode* oc )
2952
{
2953
COFF_header* hdr;
2954
COFF_section* sectab;
2955
COFF_symbol* symtab;
2956
UChar* strtab;
2957
2958
UChar* sname;
2959
void* addr;
2960
int i;
2961
2962
hdr = (COFF_header*)(oc->image);
2963
sectab = (COFF_section*) (
2964
((UChar*)(oc->image))
2965
+ sizeof_COFF_header + hdr->SizeOfOptionalHeader
2966
);
2967
symtab = (COFF_symbol*) (
2968
((UChar*)(oc->image))
2969
+ hdr->PointerToSymbolTable
2970
);
2971
strtab = ((UChar*)(oc->image))
2972
+ hdr->PointerToSymbolTable
2973
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
2974
2975
/* Allocate space for any (local, anonymous) .bss sections. */
2976
2977
for (i = 0; i < hdr->NumberOfSections; i++) {
2978
UInt32 bss_sz;
2979
UChar* zspace;
2980
COFF_section* sectab_i
2981
= (COFF_section*)
2982
myindex ( sizeof_COFF_section, sectab, i );
2983
2984
char *secname = cstring_from_section_name(sectab_i->Name, strtab);
2985
2986
if (0 != strcmp(secname, ".bss")) {
2987
stgFree(secname);
2988
continue;
2989
}
2990
2991
stgFree(secname);
2992
2993
/* sof 10/05: the PE spec text isn't too clear regarding what
2994
* the SizeOfRawData field is supposed to hold for object
2995
* file sections containing just uninitialized data -- for executables,
2996
* it is supposed to be zero; unclear what it's supposed to be
2997
* for object files. However, VirtualSize is guaranteed to be
2998
* zero for object files, which definitely suggests that SizeOfRawData
2999
* will be non-zero (where else would the size of this .bss section be
3000
* stored?) Looking at the COFF_section info for incoming object files,
3001
* this certainly appears to be the case.
3002
*
3003
* => I suspect we've been incorrectly handling .bss sections in (relocatable)
3004
* object files up until now. This turned out to bite us with ghc-6.4.1's use
3005
* of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
3006
* variable decls into to the .bss section. (The specific function in Q which
3007
* triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
3008
*/
3009
if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
3010
/* This is a non-empty .bss section. Allocate zeroed space for
3011
it, and set its PointerToRawData field such that oc->image +
3012
PointerToRawData == addr_of_zeroed_space. */
3013
bss_sz = sectab_i->VirtualSize;
3014
if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
3015
zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
3016
sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
3017
addProddableBlock(oc, zspace, bss_sz);
3018
/* debugBelch("BSS anon section at 0x%x\n", zspace); */
3019
}
3020
3021
/* Copy section information into the ObjectCode. */
3022
3023
for (i = 0; i < hdr->NumberOfSections; i++) {
3024
UChar* start;
3025
UChar* end;
3026
UInt32 sz;
3027
3028
SectionKind kind
3029
= SECTIONKIND_OTHER;
3030
COFF_section* sectab_i
3031
= (COFF_section*)
3032
myindex ( sizeof_COFF_section, sectab, i );
3033
3034
char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3035
3036
IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
3037
3038
# if 0
3039
/* I'm sure this is the Right Way to do it. However, the
3040
alternative of testing the sectab_i->Name field seems to
3041
work ok with Cygwin.
3042
*/
3043
if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
3044
sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
3045
kind = SECTIONKIND_CODE_OR_RODATA;
3046
# endif
3047
3048
if (0==strcmp(".text",(char*)secname) ||
3049
0==strcmp(".rdata",(char*)secname)||
3050
0==strcmp(".rodata",(char*)secname))
3051
kind = SECTIONKIND_CODE_OR_RODATA;
3052
if (0==strcmp(".data",(char*)secname) ||
3053
0==strcmp(".bss",(char*)secname))
3054
kind = SECTIONKIND_RWDATA;
3055
3056
ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
3057
sz = sectab_i->SizeOfRawData;
3058
if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
3059
3060
start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
3061
end = start + sz - 1;
3062
3063
if (kind == SECTIONKIND_OTHER
3064
/* Ignore sections called which contain stabs debugging
3065
information. */
3066
&& 0 != strcmp(".stab", (char*)secname)
3067
&& 0 != strcmp(".stabstr", (char*)secname)
3068
/* ignore constructor section for now */
3069
&& 0 != strcmp(".ctors", (char*)secname)
3070
/* ignore section generated from .ident */
3071
&& 0!= strncmp(".debug", (char*)secname, 6)
3072
/* ignore unknown section that appeared in gcc 3.4.5(?) */
3073
&& 0!= strcmp(".reloc", (char*)secname)
3074
&& 0 != strcmp(".rdata$zzz", (char*)secname)
3075
) {
3076
errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
3077
stgFree(secname);
3078
return 0;
3079
}
3080
3081
if (kind != SECTIONKIND_OTHER && end >= start) {
3082
addSection(oc, kind, start, end);
3083
addProddableBlock(oc, start, end - start + 1);
3084
}
3085
3086
stgFree(secname);
3087
}
3088
3089
/* Copy exported symbols into the ObjectCode. */
3090
3091
oc->n_symbols = hdr->NumberOfSymbols;
3092
oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3093
"ocGetNames_PEi386(oc->symbols)");
3094
/* Call me paranoid; I don't care. */
3095
for (i = 0; i < oc->n_symbols; i++)
3096
oc->symbols[i] = NULL;
3097
3098
i = 0;
3099
while (1) {
3100
COFF_symbol* symtab_i;
3101
if (i >= (Int32)(hdr->NumberOfSymbols)) break;
3102
symtab_i = (COFF_symbol*)
3103
myindex ( sizeof_COFF_symbol, symtab, i );
3104
3105
addr = NULL;
3106
3107
if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
3108
&& symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
3109
/* This symbol is global and defined, viz, exported */
3110
/* for MYIMAGE_SYMCLASS_EXTERNAL
3111
&& !MYIMAGE_SYM_UNDEFINED,
3112
the address of the symbol is:
3113
address of relevant section + offset in section
3114
*/
3115
COFF_section* sectabent
3116
= (COFF_section*) myindex ( sizeof_COFF_section,
3117
sectab,
3118
symtab_i->SectionNumber-1 );
3119
addr = ((UChar*)(oc->image))
3120
+ (sectabent->PointerToRawData
3121
+ symtab_i->Value);
3122
}
3123
else
3124
if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
3125
&& symtab_i->Value > 0) {
3126
/* This symbol isn't in any section at all, ie, global bss.
3127
Allocate zeroed space for it. */
3128
addr = stgCallocBytes(1, symtab_i->Value,
3129
"ocGetNames_PEi386(non-anonymous bss)");
3130
addSection(oc, SECTIONKIND_RWDATA, addr,
3131
((UChar*)addr) + symtab_i->Value - 1);
3132
addProddableBlock(oc, addr, symtab_i->Value);
3133
/* debugBelch("BSS section at 0x%x\n", addr); */
3134
}
3135
3136
if (addr != NULL ) {
3137
sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
3138
/* debugBelch("addSymbol %p `%s \n", addr,sname); */
3139
IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
3140
ASSERT(i >= 0 && i < oc->n_symbols);
3141
/* cstring_from_COFF_symbol_name always succeeds. */
3142
oc->symbols[i] = (char*)sname;
3143
ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
3144
} else {
3145
# if 0
3146
debugBelch(
3147
"IGNORING symbol %d\n"
3148
" name `",
3149
i
3150
);
3151
printName ( symtab_i->Name, strtab );
3152
debugBelch(
3153
"'\n"
3154
" value 0x%x\n"
3155
" 1+sec# %d\n"
3156
" type 0x%x\n"
3157
" sclass 0x%x\n"
3158
" nAux %d\n",
3159
symtab_i->Value,
3160
(Int32)(symtab_i->SectionNumber),
3161
(UInt32)symtab_i->Type,
3162
(UInt32)symtab_i->StorageClass,
3163
(UInt32)symtab_i->NumberOfAuxSymbols
3164
);
3165
# endif
3166
}
3167
3168
i += symtab_i->NumberOfAuxSymbols;
3169
i++;
3170
}
3171
3172
return 1;
3173
}
3174
3175
3176
static int
3177
ocResolve_PEi386 ( ObjectCode* oc )
3178
{
3179
COFF_header* hdr;
3180
COFF_section* sectab;
3181
COFF_symbol* symtab;
3182
UChar* strtab;
3183
3184
UInt32 A;
3185
UInt32 S;
3186
UInt32* pP;
3187
3188
int i;
3189
UInt32 j, noRelocs;
3190
3191
/* ToDo: should be variable-sized? But is at least safe in the
3192
sense of buffer-overrun-proof. */
3193
UChar symbol[1000];
3194
/* debugBelch("resolving for %s\n", oc->fileName); */
3195
3196
hdr = (COFF_header*)(oc->image);
3197
sectab = (COFF_section*) (
3198
((UChar*)(oc->image))
3199
+ sizeof_COFF_header + hdr->SizeOfOptionalHeader
3200
);
3201
symtab = (COFF_symbol*) (
3202
((UChar*)(oc->image))
3203
+ hdr->PointerToSymbolTable
3204
);
3205
strtab = ((UChar*)(oc->image))
3206
+ hdr->PointerToSymbolTable
3207
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
3208
3209
for (i = 0; i < hdr->NumberOfSections; i++) {
3210
COFF_section* sectab_i
3211
= (COFF_section*)
3212
myindex ( sizeof_COFF_section, sectab, i );
3213
COFF_reloc* reltab
3214
= (COFF_reloc*) (
3215
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3216
);
3217
3218
char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3219
3220
/* Ignore sections called which contain stabs debugging
3221
information. */
3222
if (0 == strcmp(".stab", (char*)secname)
3223
|| 0 == strcmp(".stabstr", (char*)secname)
3224
|| 0 == strcmp(".ctors", (char*)secname)
3225
|| 0 == strncmp(".debug", (char*)secname, 6)
3226
|| 0 == strcmp(".rdata$zzz", (char*)secname)) {
3227
stgFree(secname);
3228
continue;
3229
}
3230
3231
stgFree(secname);
3232
3233
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3234
/* If the relocation field (a short) has overflowed, the
3235
* real count can be found in the first reloc entry.
3236
*
3237
* See Section 4.1 (last para) of the PE spec (rev6.0).
3238
*
3239
* Nov2003 update: the GNU linker still doesn't correctly
3240
* handle the generation of relocatable object files with
3241
* overflown relocations. Hence the output to warn of potential
3242
* troubles.
3243
*/
3244
COFF_reloc* rel = (COFF_reloc*)
3245
myindex ( sizeof_COFF_reloc, reltab, 0 );
3246
noRelocs = rel->VirtualAddress;
3247
3248
/* 10/05: we now assume (and check for) a GNU ld that is capable
3249
* of handling object files with (>2^16) of relocs.
3250
*/
3251
#if 0
3252
debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
3253
noRelocs);
3254
#endif
3255
j = 1;
3256
} else {
3257
noRelocs = sectab_i->NumberOfRelocations;
3258
j = 0;
3259
}
3260
3261
3262
for (; j < noRelocs; j++) {
3263
COFF_symbol* sym;
3264
COFF_reloc* reltab_j
3265
= (COFF_reloc*)
3266
myindex ( sizeof_COFF_reloc, reltab, j );
3267
3268
/* the location to patch */
3269
pP = (UInt32*)(
3270
((UChar*)(oc->image))
3271
+ (sectab_i->PointerToRawData
3272
+ reltab_j->VirtualAddress
3273
- sectab_i->VirtualAddress )
3274
);
3275
/* the existing contents of pP */
3276
A = *pP;
3277
/* the symbol to connect to */
3278
sym = (COFF_symbol*)
3279
myindex ( sizeof_COFF_symbol,
3280
symtab, reltab_j->SymbolTableIndex );
3281
IF_DEBUG(linker,
3282
debugBelch(
3283
"reloc sec %2d num %3d: type 0x%-4x "
3284
"vaddr 0x%-8x name `",
3285
i, j,
3286
(UInt32)reltab_j->Type,
3287
reltab_j->VirtualAddress );
3288
printName ( sym->Name, strtab );
3289
debugBelch("'\n" ));
3290
3291
if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
3292
COFF_section* section_sym
3293
= findPEi386SectionCalled ( oc, sym->Name );
3294
if (!section_sym) {
3295
errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
3296
return 0;
3297
}
3298
S = ((UInt32)(oc->image))
3299
+ (section_sym->PointerToRawData
3300
+ sym->Value);
3301
} else {
3302
copyName ( sym->Name, strtab, symbol, 1000-1 );
3303
S = (UInt32) lookupSymbol( (char*)symbol );
3304
if ((void*)S != NULL) goto foundit;
3305
errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3306
return 0;
3307
foundit:;
3308
}
3309
checkProddableBlock(oc, pP);
3310
switch (reltab_j->Type) {
3311
case MYIMAGE_REL_I386_DIR32:
3312
*pP = A + S;
3313
break;
3314
case MYIMAGE_REL_I386_REL32:
3315
/* Tricky. We have to insert a displacement at
3316
pP which, when added to the PC for the _next_
3317
insn, gives the address of the target (S).
3318
Problem is to know the address of the next insn
3319
when we only know pP. We assume that this
3320
literal field is always the last in the insn,
3321
so that the address of the next insn is pP+4
3322
-- hence the constant 4.
3323
Also I don't know if A should be added, but so
3324
far it has always been zero.
3325
3326
SOF 05/2005: 'A' (old contents of *pP) have been observed
3327
to contain values other than zero (the 'wx' object file
3328
that came with wxhaskell-0.9.4; dunno how it was compiled..).
3329
So, add displacement to old value instead of asserting
3330
A to be zero. Fixes wxhaskell-related crashes, and no other
3331
ill effects have been observed.
3332
3333
Update: the reason why we're seeing these more elaborate
3334
relocations is due to a switch in how the NCG compiles SRTs
3335
and offsets to them from info tables. SRTs live in .(ro)data,
3336
while info tables live in .text, causing GAS to emit REL32/DISP32
3337
relocations with non-zero values. Adding the displacement is
3338
the right thing to do.
3339
*/
3340
*pP = S - ((UInt32)pP) - 4 + A;
3341
break;
3342
default:
3343
debugBelch("%s: unhandled PEi386 relocation type %d",
3344
oc->fileName, reltab_j->Type);
3345
return 0;
3346
}
3347
3348
}
3349
}
3350
3351
IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
3352
return 1;
3353
}
3354
3355
#endif /* defined(OBJFORMAT_PEi386) */
3356
3357
3358
/* --------------------------------------------------------------------------
3359
* ELF specifics
3360
* ------------------------------------------------------------------------*/
3361
3362
#if defined(OBJFORMAT_ELF)
3363
3364
#define FALSE 0
3365
#define TRUE 1
3366
3367
#if defined(sparc_HOST_ARCH)
3368
# define ELF_TARGET_SPARC /* Used inside <elf.h> */
3369
#elif defined(i386_HOST_ARCH)
3370
# define ELF_TARGET_386 /* Used inside <elf.h> */
3371
#elif defined(x86_64_HOST_ARCH)
3372
# define ELF_TARGET_X64_64
3373
# define ELF_64BIT
3374
#endif
3375
3376
#if !defined(openbsd_HOST_OS)
3377
# include <elf.h>
3378
#else
3379
/* openbsd elf has things in different places, with diff names */
3380
# include <elf_abi.h>
3381
# include <machine/reloc.h>
3382
# define R_386_32 RELOC_32
3383
# define R_386_PC32 RELOC_PC32
3384
#endif
3385
3386
/* If elf.h doesn't define it */
3387
# ifndef R_X86_64_PC64
3388
# define R_X86_64_PC64 24
3389
# endif
3390
3391
/*
3392
* Define a set of types which can be used for both ELF32 and ELF64
3393
*/
3394
3395
#ifdef ELF_64BIT
3396
#define ELFCLASS ELFCLASS64
3397
#define Elf_Addr Elf64_Addr
3398
#define Elf_Word Elf64_Word
3399
#define Elf_Sword Elf64_Sword
3400
#define Elf_Ehdr Elf64_Ehdr
3401
#define Elf_Phdr Elf64_Phdr
3402
#define Elf_Shdr Elf64_Shdr
3403
#define Elf_Sym Elf64_Sym
3404
#define Elf_Rel Elf64_Rel
3405
#define Elf_Rela Elf64_Rela
3406
#ifndef ELF_ST_TYPE
3407
#define ELF_ST_TYPE ELF64_ST_TYPE
3408
#endif
3409
#ifndef ELF_ST_BIND
3410
#define ELF_ST_BIND ELF64_ST_BIND
3411
#endif
3412
#ifndef ELF_R_TYPE
3413
#define ELF_R_TYPE ELF64_R_TYPE
3414
#endif
3415
#ifndef ELF_R_SYM
3416
#define ELF_R_SYM ELF64_R_SYM
3417
#endif
3418
#else
3419
#define ELFCLASS ELFCLASS32
3420
#define Elf_Addr Elf32_Addr
3421
#define Elf_Word Elf32_Word
3422
#define Elf_Sword Elf32_Sword
3423
#define Elf_Ehdr Elf32_Ehdr
3424
#define Elf_Phdr Elf32_Phdr
3425
#define Elf_Shdr Elf32_Shdr
3426
#define Elf_Sym Elf32_Sym
3427
#define Elf_Rel Elf32_Rel
3428
#define Elf_Rela Elf32_Rela
3429
#ifndef ELF_ST_TYPE
3430
#define ELF_ST_TYPE ELF32_ST_TYPE
3431
#endif
3432
#ifndef ELF_ST_BIND
3433
#define ELF_ST_BIND ELF32_ST_BIND
3434
#endif
3435
#ifndef ELF_R_TYPE
3436
#define ELF_R_TYPE ELF32_R_TYPE
3437
#endif
3438
#ifndef ELF_R_SYM
3439
#define ELF_R_SYM ELF32_R_SYM
3440
#endif
3441
#endif
3442
3443
3444
/*
3445
* Functions to allocate entries in dynamic sections. Currently we simply
3446
* preallocate a large number, and we don't check if a entry for the given
3447
* target already exists (a linear search is too slow). Ideally these
3448
* entries would be associated with symbols.
3449
*/
3450
3451
/* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
3452
#define GOT_SIZE 0x20000
3453
#define FUNCTION_TABLE_SIZE 0x10000
3454
#define PLT_SIZE 0x08000
3455
3456
#ifdef ELF_NEED_GOT
3457
static Elf_Addr got[GOT_SIZE];
3458
static unsigned int gotIndex;
3459
static Elf_Addr gp_val = (Elf_Addr)got;
3460
3461
static Elf_Addr
3462
allocateGOTEntry(Elf_Addr target)
3463
{
3464
Elf_Addr *entry;
3465
3466
if (gotIndex >= GOT_SIZE)
3467
barf("Global offset table overflow");
3468
3469
entry = &got[gotIndex++];
3470
*entry = target;
3471
return (Elf_Addr)entry;
3472
}
3473
#endif
3474
3475
#ifdef ELF_FUNCTION_DESC
3476
typedef struct {
3477
Elf_Addr ip;
3478
Elf_Addr gp;
3479
} FunctionDesc;
3480
3481
static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
3482
static unsigned int functionTableIndex;
3483
3484
static Elf_Addr
3485
allocateFunctionDesc(Elf_Addr target)
3486
{
3487
FunctionDesc *entry;
3488
3489
if (functionTableIndex >= FUNCTION_TABLE_SIZE)
3490
barf("Function table overflow");
3491
3492
entry = &functionTable[functionTableIndex++];
3493
entry->ip = target;
3494
entry->gp = (Elf_Addr)gp_val;
3495
return (Elf_Addr)entry;
3496
}
3497
3498
static Elf_Addr
3499
copyFunctionDesc(Elf_Addr target)
3500
{
3501
FunctionDesc *olddesc = (FunctionDesc *)target;
3502
FunctionDesc *newdesc;
3503
3504
newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
3505
newdesc->gp = olddesc->gp;
3506
return (Elf_Addr)newdesc;
3507
}
3508
#endif
3509
3510
#ifdef ELF_NEED_PLT
3511
3512
typedef struct {
3513
unsigned char code[sizeof(plt_code)];
3514
} PLTEntry;
3515
3516
static Elf_Addr
3517
allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
3518
{
3519
PLTEntry *plt = (PLTEntry *)oc->plt;
3520
PLTEntry *entry;
3521
3522
if (oc->pltIndex >= PLT_SIZE)
3523
barf("Procedure table overflow");
3524
3525
entry = &plt[oc->pltIndex++];
3526
memcpy(entry->code, plt_code, sizeof(entry->code));
3527
PLT_RELOC(entry->code, target);
3528
return (Elf_Addr)entry;
3529
}
3530
3531
static unsigned int
3532
PLTSize(void)
3533
{
3534
return (PLT_SIZE * sizeof(PLTEntry));
3535
}
3536
#endif
3537
3538
3539
/*
3540
* Generic ELF functions
3541
*/
3542
3543
static char *
3544
findElfSection ( void* objImage, Elf_Word sh_type )
3545
{
3546
char* ehdrC = (char*)objImage;
3547
Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3548
Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
3549
char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3550
char* ptr = NULL;
3551
int i;
3552
3553
for (i = 0; i < ehdr->e_shnum; i++) {
3554
if (shdr[i].sh_type == sh_type
3555
/* Ignore the section header's string table. */
3556
&& i != ehdr->e_shstrndx
3557
/* Ignore string tables named .stabstr, as they contain
3558
debugging info. */
3559
&& 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3560
) {
3561
ptr = ehdrC + shdr[i].sh_offset;
3562
break;
3563
}
3564
}
3565
return ptr;
3566
}
3567
3568
static int
3569
ocVerifyImage_ELF ( ObjectCode* oc )
3570
{
3571
Elf_Shdr* shdr;
3572
Elf_Sym* stab;
3573
int i, j, nent, nstrtab, nsymtabs;
3574
char* sh_strtab;
3575
char* strtab;
3576
3577
char* ehdrC = (char*)(oc->image);
3578
Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3579
3580
if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
3581
ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
3582
ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
3583
ehdr->e_ident[EI_MAG3] != ELFMAG3) {
3584
errorBelch("%s: not an ELF object", oc->fileName);
3585
return 0;
3586
}
3587
3588
if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
3589
errorBelch("%s: unsupported ELF format", oc->fileName);
3590
return 0;
3591
}
3592
3593
if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
3594
IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
3595
} else
3596
if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
3597
IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
3598
} else {
3599
errorBelch("%s: unknown endiannness", oc->fileName);
3600
return 0;
3601
}
3602
3603
if (ehdr->e_type != ET_REL) {
3604
errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
3605
return 0;
3606
}
3607
IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
3608
3609
IF_DEBUG(linker,debugBelch( "Architecture is " ));
3610
switch (ehdr->e_machine) {
3611
case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
3612
#ifdef EM_SPARC32PLUS
3613
case EM_SPARC32PLUS:
3614
#endif
3615
case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
3616
#ifdef EM_IA_64
3617
case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
3618
#endif
3619
case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
3620
#ifdef EM_X86_64
3621
case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
3622
#elif defined(EM_AMD64)
3623
case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
3624
#endif
3625
default: IF_DEBUG(linker,debugBelch( "unknown" ));
3626
errorBelch("%s: unknown architecture (e_machine == %d)"
3627
, oc->fileName, ehdr->e_machine);
3628
return 0;
3629
}
3630
3631
IF_DEBUG(linker,debugBelch(
3632
"\nSection header table: start %ld, n_entries %d, ent_size %d\n",
3633
(long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
3634
3635
ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
3636
3637
shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3638
3639
if (ehdr->e_shstrndx == SHN_UNDEF) {
3640
errorBelch("%s: no section header string table", oc->fileName);
3641
return 0;
3642
} else {
3643
IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
3644
ehdr->e_shstrndx));
3645
sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3646
}
3647
3648
for (i = 0; i < ehdr->e_shnum; i++) {
3649
IF_DEBUG(linker,debugBelch("%2d: ", i ));
3650
IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
3651
IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
3652
IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
3653
IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
3654
ehdrC + shdr[i].sh_offset,
3655
ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
3656
3657
if (shdr[i].sh_type == SHT_REL) {
3658
IF_DEBUG(linker,debugBelch("Rel " ));
3659
} else if (shdr[i].sh_type == SHT_RELA) {
3660
IF_DEBUG(linker,debugBelch("RelA " ));
3661
} else {
3662
IF_DEBUG(linker,debugBelch(" "));
3663
}
3664
if (sh_strtab) {
3665
IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
3666
}
3667
}
3668
3669
IF_DEBUG(linker,debugBelch( "\nString tables" ));
3670
strtab = NULL;
3671
nstrtab = 0;
3672
for (i = 0; i < ehdr->e_shnum; i++) {
3673
if (shdr[i].sh_type == SHT_STRTAB
3674
/* Ignore the section header's string table. */
3675
&& i != ehdr->e_shstrndx
3676
/* Ignore string tables named .stabstr, as they contain
3677
debugging info. */
3678
&& 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3679
) {
3680
IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
3681
strtab = ehdrC + shdr[i].sh_offset;
3682
nstrtab++;
3683
}
3684
}
3685
if (nstrtab != 1) {
3686
errorBelch("%s: no string tables, or too many", oc->fileName);
3687
return 0;
3688
}
3689
3690
nsymtabs = 0;
3691
IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
3692
for (i = 0; i < ehdr->e_shnum; i++) {
3693
if (shdr[i].sh_type != SHT_SYMTAB) continue;
3694
IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
3695
nsymtabs++;
3696
stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3697
nent = shdr[i].sh_size / sizeof(Elf_Sym);
3698
IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
3699
nent,
3700
(long)shdr[i].sh_size % sizeof(Elf_Sym)
3701
));
3702
if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
3703
errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
3704
return 0;
3705
}
3706
for (j = 0; j < nent; j++) {
3707
IF_DEBUG(linker,debugBelch(" %2d ", j ));
3708
IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
3709
(int)stab[j].st_shndx,
3710
(int)stab[j].st_size,
3711
(char*)stab[j].st_value ));
3712
3713
IF_DEBUG(linker,debugBelch("type=" ));
3714
switch (ELF_ST_TYPE(stab[j].st_info)) {
3715
case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
3716
case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
3717
case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
3718
case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
3719
case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
3720
default: IF_DEBUG(linker,debugBelch("? " )); break;
3721
}
3722
IF_DEBUG(linker,debugBelch(" " ));
3723
3724
IF_DEBUG(linker,debugBelch("bind=" ));
3725
switch (ELF_ST_BIND(stab[j].st_info)) {
3726
case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
3727
case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
3728
case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
3729
default: IF_DEBUG(linker,debugBelch("? " )); break;
3730
}
3731
IF_DEBUG(linker,debugBelch(" " ));
3732
3733
IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3734
}
3735
}
3736
3737
if (nsymtabs == 0) {
3738
errorBelch("%s: didn't find any symbol tables", oc->fileName);
3739
return 0;
3740
}
3741
3742
return 1;
3743
}
3744
3745
static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3746
{
3747
*is_bss = FALSE;
3748
3749
if (hdr->sh_type == SHT_PROGBITS
3750
&& (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3751
/* .text-style section */
3752
return SECTIONKIND_CODE_OR_RODATA;
3753
}
3754
3755
if (hdr->sh_type == SHT_PROGBITS
3756
&& (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3757
/* .data-style section */
3758
return SECTIONKIND_RWDATA;
3759
}
3760
3761
if (hdr->sh_type == SHT_PROGBITS
3762
&& (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3763
/* .rodata-style section */
3764
return SECTIONKIND_CODE_OR_RODATA;
3765
}
3766
3767
if (hdr->sh_type == SHT_NOBITS
3768
&& (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3769
/* .bss-style section */
3770
*is_bss = TRUE;
3771
return SECTIONKIND_RWDATA;
3772
}
3773
3774
return SECTIONKIND_OTHER;
3775
}
3776
3777
3778
static int
3779
ocGetNames_ELF ( ObjectCode* oc )
3780
{
3781
int i, j, k, nent;
3782
Elf_Sym* stab;
3783
3784
char* ehdrC = (char*)(oc->image);
3785
Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3786
char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3787
Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3788
3789
ASSERT(symhash != NULL);
3790
3791
if (!strtab) {
3792
errorBelch("%s: no strtab", oc->fileName);
3793
return 0;
3794
}
3795
3796
k = 0;
3797
for (i = 0; i < ehdr->e_shnum; i++) {
3798
/* Figure out what kind of section it is. Logic derived from
3799
Figure 1.14 ("Special Sections") of the ELF document
3800
("Portable Formats Specification, Version 1.1"). */
3801
int is_bss = FALSE;
3802
SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3803
3804
if (is_bss && shdr[i].sh_size > 0) {
3805
/* This is a non-empty .bss section. Allocate zeroed space for
3806
it, and set its .sh_offset field such that
3807
ehdrC + .sh_offset == addr_of_zeroed_space. */
3808
char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3809
"ocGetNames_ELF(BSS)");
3810
shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3811
/*
3812
debugBelch("BSS section at 0x%x, size %d\n",
3813
zspace, shdr[i].sh_size);
3814
*/
3815
}
3816
3817
/* fill in the section info */
3818
if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3819
addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3820
addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3821
ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3822
}
3823
3824
if (shdr[i].sh_type != SHT_SYMTAB) continue;
3825
3826
/* copy stuff into this module's object symbol table */
3827
stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3828
nent = shdr[i].sh_size / sizeof(Elf_Sym);
3829
3830
oc->n_symbols = nent;
3831
oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3832
"ocGetNames_ELF(oc->symbols)");
3833
3834
for (j = 0; j < nent; j++) {
3835
3836
char isLocal = FALSE; /* avoids uninit-var warning */
3837
char* ad = NULL;
3838
char* nm = strtab + stab[j].st_name;
3839
int secno = stab[j].st_shndx;
3840
3841
/* Figure out if we want to add it; if so, set ad to its
3842
address. Otherwise leave ad == NULL. */
3843
3844
if (secno == SHN_COMMON) {
3845
isLocal = FALSE;
3846
ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3847
/*
3848
debugBelch("COMMON symbol, size %d name %s\n",
3849
stab[j].st_size, nm);
3850
*/
3851
/* Pointless to do addProddableBlock() for this area,
3852
since the linker should never poke around in it. */
3853
}
3854
else
3855
if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3856
|| ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3857
)
3858
/* and not an undefined symbol */
3859
&& stab[j].st_shndx != SHN_UNDEF
3860
/* and not in a "special section" */
3861
&& stab[j].st_shndx < SHN_LORESERVE
3862
&&
3863
/* and it's a not a section or string table or anything silly */
3864
( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3865
ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3866
ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3867
)
3868
) {
3869
/* Section 0 is the undefined section, hence > and not >=. */
3870
ASSERT(secno > 0 && secno < ehdr->e_shnum);
3871
/*
3872
if (shdr[secno].sh_type == SHT_NOBITS) {
3873
debugBelch(" BSS symbol, size %d off %d name %s\n",
3874
stab[j].st_size, stab[j].st_value, nm);
3875
}
3876
*/
3877
ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3878
if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3879
isLocal = TRUE;
3880
} else {
3881
#ifdef ELF_FUNCTION_DESC
3882
/* dlsym() and the initialisation table both give us function
3883
* descriptors, so to be consistent we store function descriptors
3884
* in the symbol table */
3885
if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3886
ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3887
#endif
3888
IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
3889
ad, oc->fileName, nm ));
3890
isLocal = FALSE;
3891
}
3892
}
3893
3894
/* And the decision is ... */
3895
3896
if (ad != NULL) {
3897
ASSERT(nm != NULL);
3898
oc->symbols[j] = nm;
3899
/* Acquire! */
3900
if (isLocal) {
3901
/* Ignore entirely. */
3902
} else {
3903
ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3904
}
3905
} else {
3906
/* Skip. */
3907
IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3908
strtab + stab[j].st_name ));
3909
/*
3910
debugBelch(
3911
"skipping bind = %d, type = %d, shndx = %d `%s'\n",
3912
(int)ELF_ST_BIND(stab[j].st_info),
3913
(int)ELF_ST_TYPE(stab[j].st_info),
3914
(int)stab[j].st_shndx,
3915
strtab + stab[j].st_name
3916
);
3917
*/
3918
oc->symbols[j] = NULL;
3919
}
3920
3921
}
3922
}
3923
3924
return 1;
3925
}
3926
3927
/* Do ELF relocations which lack an explicit addend. All x86-linux
3928
relocations appear to be of this form. */
3929
static int
3930
do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3931
Elf_Shdr* shdr, int shnum,
3932
Elf_Sym* stab, char* strtab )
3933
{
3934
int j;
3935
char *symbol;
3936
Elf_Word* targ;
3937
Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3938
int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3939
int target_shndx = shdr[shnum].sh_info;
3940
int symtab_shndx = shdr[shnum].sh_link;
3941
3942
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3943
targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3944
IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3945
target_shndx, symtab_shndx ));
3946
3947
/* Skip sections that we're not interested in. */
3948
{
3949
int is_bss;
3950
SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3951
if (kind == SECTIONKIND_OTHER) {
3952
IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3953
return 1;
3954
}
3955
}
3956
3957
for (j = 0; j < nent; j++) {
3958
Elf_Addr offset = rtab[j].r_offset;
3959
Elf_Addr info = rtab[j].r_info;
3960
3961
Elf_Addr P = ((Elf_Addr)targ) + offset;
3962
Elf_Word* pP = (Elf_Word*)P;
3963
Elf_Addr A = *pP;
3964
Elf_Addr S;
3965
void* S_tmp;
3966
Elf_Addr value;
3967
StgStablePtr stablePtr;
3968
StgPtr stableVal;
3969
3970
IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3971
j, (void*)offset, (void*)info ));
3972
if (!info) {
3973
IF_DEBUG(linker,debugBelch( " ZERO" ));
3974
S = 0;
3975
} else {
3976
Elf_Sym sym = stab[ELF_R_SYM(info)];
3977
/* First see if it is a local symbol. */
3978
if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3979
/* Yes, so we can get the address directly from the ELF symbol
3980
table. */
3981
symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3982
S = (Elf_Addr)
3983
(ehdrC + shdr[ sym.st_shndx ].sh_offset
3984
+ stab[ELF_R_SYM(info)].st_value);
3985
3986
} else {
3987
symbol = strtab + sym.st_name;
3988
stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3989
if (NULL == stablePtr) {
3990
/* No, so look up the name in our global table. */
3991
S_tmp = lookupSymbol( symbol );
3992
S = (Elf_Addr)S_tmp;
3993
} else {
3994
stableVal = deRefStablePtr( stablePtr );
3995
S_tmp = stableVal;
3996
S = (Elf_Addr)S_tmp;
3997
}
3998
}
3999
if (!S) {
4000
errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
4001
return 0;
4002
}
4003
IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
4004
}
4005
4006
IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
4007
(void*)P, (void*)S, (void*)A ));
4008
checkProddableBlock ( oc, pP );
4009
4010
value = S + A;
4011
4012
switch (ELF_R_TYPE(info)) {
4013
# ifdef i386_HOST_ARCH
4014
case R_386_32: *pP = value; break;
4015
case R_386_PC32: *pP = value - P; break;
4016
# endif
4017
default:
4018
errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
4019
oc->fileName, (lnat)ELF_R_TYPE(info));
4020
return 0;
4021
}
4022
4023
}
4024
return 1;
4025
}
4026
4027
/* Do ELF relocations for which explicit addends are supplied.
4028
sparc-solaris relocations appear to be of this form. */
4029
static int
4030
do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
4031
Elf_Shdr* shdr, int shnum,
4032
Elf_Sym* stab, char* strtab )
4033
{
4034
int j;
4035
char *symbol = NULL;
4036
Elf_Addr targ;
4037
Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
4038
int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
4039
int target_shndx = shdr[shnum].sh_info;
4040
int symtab_shndx = shdr[shnum].sh_link;
4041
4042
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
4043
targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
4044
IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
4045
target_shndx, symtab_shndx ));
4046
4047
for (j = 0; j < nent; j++) {
4048
#if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4049
/* This #ifdef only serves to avoid unused-var warnings. */
4050
Elf_Addr offset = rtab[j].r_offset;
4051
Elf_Addr P = targ + offset;
4052
#endif
4053
Elf_Addr info = rtab[j].r_info;
4054
Elf_Addr A = rtab[j].r_addend;
4055
Elf_Addr S;
4056
void* S_tmp;
4057
Elf_Addr value;
4058
# if defined(sparc_HOST_ARCH)
4059
Elf_Word* pP = (Elf_Word*)P;
4060
Elf_Word w1, w2;
4061
# elif defined(powerpc_HOST_ARCH)
4062
Elf_Sword delta;
4063
# endif
4064
4065
IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
4066
j, (void*)offset, (void*)info,
4067
(void*)A ));
4068
if (!info) {
4069
IF_DEBUG(linker,debugBelch( " ZERO" ));
4070
S = 0;
4071
} else {
4072
Elf_Sym sym = stab[ELF_R_SYM(info)];
4073
/* First see if it is a local symbol. */
4074
if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
4075
/* Yes, so we can get the address directly from the ELF symbol
4076
table. */
4077
symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
4078
S = (Elf_Addr)
4079
(ehdrC + shdr[ sym.st_shndx ].sh_offset
4080
+ stab[ELF_R_SYM(info)].st_value);
4081
#ifdef ELF_FUNCTION_DESC
4082
/* Make a function descriptor for this function */
4083
if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
4084
S = allocateFunctionDesc(S + A);
4085
A = 0;
4086
}
4087
#endif
4088
} else {
4089
/* No, so look up the name in our global table. */
4090
symbol = strtab + sym.st_name;
4091
S_tmp = lookupSymbol( symbol );
4092
S = (Elf_Addr)S_tmp;
4093
4094
#ifdef ELF_FUNCTION_DESC
4095
/* If a function, already a function descriptor - we would
4096
have to copy it to add an offset. */
4097
if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
4098
errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
4099
#endif
4100
}
4101
if (!S) {
4102
errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
4103
return 0;
4104
}
4105
IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
4106
}
4107
4108
IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
4109
(void*)P, (void*)S, (void*)A ));
4110
/* checkProddableBlock ( oc, (void*)P ); */
4111
4112
value = S + A;
4113
4114
switch (ELF_R_TYPE(info)) {
4115
# if defined(sparc_HOST_ARCH)
4116
case R_SPARC_WDISP30:
4117
w1 = *pP & 0xC0000000;
4118
w2 = (Elf_Word)((value - P) >> 2);
4119
ASSERT((w2 & 0xC0000000) == 0);
4120
w1 |= w2;
4121
*pP = w1;
4122
break;
4123
case R_SPARC_HI22:
4124
w1 = *pP & 0xFFC00000;
4125
w2 = (Elf_Word)(value >> 10);
4126
ASSERT((w2 & 0xFFC00000) == 0);
4127
w1 |= w2;
4128
*pP = w1;
4129
break;
4130
case R_SPARC_LO10:
4131
w1 = *pP & ~0x3FF;
4132
w2 = (Elf_Word)(value & 0x3FF);
4133
ASSERT((w2 & ~0x3FF) == 0);
4134
w1 |= w2;
4135
*pP = w1;
4136
break;
4137
4138
/* According to the Sun documentation:
4139
R_SPARC_UA32
4140
This relocation type resembles R_SPARC_32, except it refers to an
4141
unaligned word. That is, the word to be relocated must be treated
4142
as four separate bytes with arbitrary alignment, not as a word
4143
aligned according to the architecture requirements.
4144
*/
4145
case R_SPARC_UA32:
4146
w2 = (Elf_Word)value;
4147
4148
// SPARC doesn't do misaligned writes of 32 bit words,
4149
// so we have to do this one byte-at-a-time.
4150
char *pPc = (char*)pP;
4151
pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
4152
pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
4153
pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
4154
pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
4155
break;
4156
4157
case R_SPARC_32:
4158
w2 = (Elf_Word)value;
4159
*pP = w2;
4160
break;
4161
# elif defined(powerpc_HOST_ARCH)
4162
case R_PPC_ADDR16_LO:
4163
*(Elf32_Half*) P = value;
4164
break;
4165
4166
case R_PPC_ADDR16_HI:
4167
*(Elf32_Half*) P = value >> 16;
4168
break;
4169
4170
case R_PPC_ADDR16_HA:
4171
*(Elf32_Half*) P = (value + 0x8000) >> 16;
4172
break;
4173
4174
case R_PPC_ADDR32:
4175
*(Elf32_Word *) P = value;
4176
break;
4177
4178
case R_PPC_REL32:
4179
*(Elf32_Word *) P = value - P;
4180
break;
4181
4182
case R_PPC_REL24:
4183
delta = value - P;
4184
4185
if( delta << 6 >> 6 != delta )
4186
{
4187
value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
4188
->jumpIsland);
4189
delta = value - P;
4190
4191
if( value == 0 || delta << 6 >> 6 != delta )
4192
{
4193
barf( "Unable to make SymbolExtra for #%d",
4194
ELF_R_SYM(info) );
4195
return 0;
4196
}
4197
}
4198
4199
*(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
4200
| (delta & 0x3fffffc);
4201
break;
4202
# endif
4203
4204
#if x86_64_HOST_ARCH
4205
case R_X86_64_64:
4206
*(Elf64_Xword *)P = value;
4207
break;
4208
4209
case R_X86_64_PC32:
4210
{
4211
#if defined(ALWAYS_PIC)
4212
barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
4213
#else
4214
StgInt64 off = value - P;
4215
if (off >= 0x7fffffffL || off < -0x80000000L) {
4216
#if X86_64_ELF_NONPIC_HACK
4217
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4218
-> jumpIsland;
4219
off = pltAddress + A - P;
4220
#else
4221
barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4222
symbol, off, oc->fileName );
4223
#endif
4224
}
4225
*(Elf64_Word *)P = (Elf64_Word)off;
4226
#endif
4227
break;
4228
}
4229
4230
case R_X86_64_PC64:
4231
{
4232
StgInt64 off = value - P;
4233
*(Elf64_Word *)P = (Elf64_Word)off;
4234
break;
4235
}
4236
4237
case R_X86_64_32:
4238
#if defined(ALWAYS_PIC)
4239
barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
4240
#else
4241
if (value >= 0x7fffffffL) {
4242
#if X86_64_ELF_NONPIC_HACK
4243
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4244
-> jumpIsland;
4245
value = pltAddress + A;
4246
#else
4247
barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4248
symbol, value, oc->fileName );
4249
#endif
4250
}
4251
*(Elf64_Word *)P = (Elf64_Word)value;
4252
#endif
4253
break;
4254
4255
case R_X86_64_32S:
4256
#if defined(ALWAYS_PIC)
4257
barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
4258
#else
4259
if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
4260
#if X86_64_ELF_NONPIC_HACK
4261
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4262
-> jumpIsland;
4263
value = pltAddress + A;
4264
#else
4265
barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4266
symbol, value, oc->fileName );
4267
#endif
4268
}
4269
*(Elf64_Sword *)P = (Elf64_Sword)value;
4270
#endif
4271
break;
4272
4273
case R_X86_64_GOTPCREL:
4274
{
4275
StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
4276
StgInt64 off = gotAddress + A - P;
4277
*(Elf64_Word *)P = (Elf64_Word)off;
4278
break;
4279
}
4280
4281
case R_X86_64_PLT32:
4282
{
4283
#if defined(ALWAYS_PIC)
4284
barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
4285
#else
4286
StgInt64 off = value - P;
4287
if (off >= 0x7fffffffL || off < -0x80000000L) {
4288
StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4289
-> jumpIsland;
4290
off = pltAddress + A - P;
4291
}
4292
*(Elf64_Word *)P = (Elf64_Word)off;
4293
#endif
4294
break;
4295
}
4296
#endif
4297
4298
default:
4299
errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
4300
oc->fileName, (lnat)ELF_R_TYPE(info));
4301
return 0;
4302
}
4303
4304
}
4305
return 1;
4306
}
4307
4308
static int
4309
ocResolve_ELF ( ObjectCode* oc )
4310
{
4311
char *strtab;
4312
int shnum, ok;
4313
Elf_Sym* stab = NULL;
4314
char* ehdrC = (char*)(oc->image);
4315
Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
4316
Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
4317
4318
/* first find "the" symbol table */
4319
stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
4320
4321
/* also go find the string table */
4322
strtab = findElfSection ( ehdrC, SHT_STRTAB );
4323
4324
if (stab == NULL || strtab == NULL) {
4325
errorBelch("%s: can't find string or symbol table", oc->fileName);
4326
return 0;
4327
}
4328
4329
/* Process the relocation sections. */
4330
for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
4331
if (shdr[shnum].sh_type == SHT_REL) {
4332
ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
4333
shnum, stab, strtab );
4334
if (!ok) return ok;
4335
}
4336
else
4337
if (shdr[shnum].sh_type == SHT_RELA) {
4338
ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
4339
shnum, stab, strtab );
4340
if (!ok) return ok;
4341
}
4342
}
4343
4344
#if defined(powerpc_HOST_ARCH)
4345
ocFlushInstructionCache( oc );
4346
#endif
4347
4348
return 1;
4349
}
4350
4351
/*
4352
* PowerPC & X86_64 ELF specifics
4353
*/
4354
4355
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4356
4357
static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
4358
{
4359
Elf_Ehdr *ehdr;
4360
Elf_Shdr* shdr;
4361
int i;
4362
4363
ehdr = (Elf_Ehdr *) oc->image;
4364
shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
4365
4366
for( i = 0; i < ehdr->e_shnum; i++ )
4367
if( shdr[i].sh_type == SHT_SYMTAB )
4368
break;
4369
4370
if( i == ehdr->e_shnum )
4371
{
4372
errorBelch( "This ELF file contains no symtab" );
4373
return 0;
4374
}
4375
4376
if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
4377
{
4378
errorBelch( "The entry size (%d) of the symtab isn't %d\n",
4379
(int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
4380
4381
return 0;
4382
}
4383
4384
return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
4385
}
4386
4387
#endif /* powerpc */
4388
4389
#endif /* ELF */
4390
4391
/* --------------------------------------------------------------------------
4392
* Mach-O specifics
4393
* ------------------------------------------------------------------------*/
4394
4395
#if defined(OBJFORMAT_MACHO)
4396
4397
/*
4398
Support for MachO linking on Darwin/MacOS X
4399
by Wolfgang Thaller (wolfgang.thaller@gmx.net)
4400
4401
I hereby formally apologize for the hackish nature of this code.
4402
Things that need to be done:
4403
*) implement ocVerifyImage_MachO
4404
*) add still more sanity checks.
4405
*/
4406
4407
#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4408
#define mach_header mach_header_64
4409
#define segment_command segment_command_64
4410
#define section section_64
4411
#define nlist nlist_64
4412
#endif
4413
4414
#ifdef powerpc_HOST_ARCH
4415
static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4416
{
4417
struct mach_header *header = (struct mach_header *) oc->image;
4418
struct load_command *lc = (struct load_command *) (header + 1);
4419
unsigned i;
4420
4421
for( i = 0; i < header->ncmds; i++ )
4422
{
4423
if( lc->cmd == LC_SYMTAB )
4424
{
4425
// Find out the first and last undefined external
4426
// symbol, so we don't have to allocate too many
4427
// jump islands.
4428
struct symtab_command *symLC = (struct symtab_command *) lc;
4429
unsigned min = symLC->nsyms, max = 0;
4430
struct nlist *nlist =
4431
symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
4432
: NULL;
4433
for(i=0;i<symLC->nsyms;i++)
4434
{
4435
if(nlist[i].n_type & N_STAB)
4436
;
4437
else if(nlist[i].n_type & N_EXT)
4438
{
4439
if((nlist[i].n_type & N_TYPE) == N_UNDF
4440
&& (nlist[i].n_value == 0))
4441
{
4442
if(i < min)
4443
min = i;
4444
if(i > max)
4445
max = i;
4446
}
4447
}
4448
}
4449
if(max >= min)
4450
return ocAllocateSymbolExtras(oc, max - min + 1, min);
4451
4452
break;
4453
}
4454
4455
lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4456
}
4457
return ocAllocateSymbolExtras(oc,0,0);
4458
}
4459
#endif
4460
#ifdef x86_64_HOST_ARCH
4461
static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4462
{
4463
struct mach_header *header = (struct mach_header *) oc->image;
4464
struct load_command *lc = (struct load_command *) (header + 1);
4465
unsigned i;
4466
4467
for( i = 0; i < header->ncmds; i++ )
4468
{
4469
if( lc->cmd == LC_SYMTAB )
4470
{
4471
// Just allocate one entry for every symbol
4472
struct symtab_command *symLC = (struct symtab_command *) lc;
4473
4474
return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
4475
}
4476
4477
lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4478
}
4479
return ocAllocateSymbolExtras(oc,0,0);
4480
}
4481
#endif
4482
4483
static int ocVerifyImage_MachO(ObjectCode* oc)
4484
{
4485
char *image = (char*) oc->image;
4486
struct mach_header *header = (struct mach_header*) image;
4487
4488
#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4489
if(header->magic != MH_MAGIC_64) {
4490
errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4491
oc->fileName, MH_MAGIC_64, header->magic);
4492
return 0;
4493
}
4494
#else
4495
if(header->magic != MH_MAGIC) {
4496
errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4497
oc->fileName, MH_MAGIC, header->magic);
4498
return 0;
4499
}
4500
#endif
4501
// FIXME: do some more verifying here
4502
return 1;
4503
}
4504
4505
static int resolveImports(
4506
ObjectCode* oc,
4507
char *image,
4508
struct symtab_command *symLC,
4509
struct section *sect, // ptr to lazy or non-lazy symbol pointer section
4510
unsigned long *indirectSyms,
4511
struct nlist *nlist)
4512
{
4513
unsigned i;
4514
size_t itemSize = 4;
4515
4516
IF_DEBUG(linker, debugBelch("resolveImports: start\n"));
4517
4518
#if i386_HOST_ARCH
4519
int isJumpTable = 0;
4520
if(!strcmp(sect->sectname,"__jump_table"))
4521
{
4522
isJumpTable = 1;
4523
itemSize = 5;
4524
ASSERT(sect->reserved2 == itemSize);
4525
}
4526
#endif
4527
4528
for(i=0; i*itemSize < sect->size;i++)
4529
{
4530
// according to otool, reserved1 contains the first index into the indirect symbol table
4531
struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
4532
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4533
void *addr = NULL;
4534
4535
IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm));
4536
if ((symbol->n_type & N_TYPE) == N_UNDF
4537
&& (symbol->n_type & N_EXT) && (symbol->n_value != 0)) {
4538
addr = (void*) (symbol->n_value);
4539
IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
4540
} else {
4541
addr = lookupSymbol(nm);
4542
IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
4543
}
4544
if (!addr)
4545
{
4546
errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
4547
return 0;
4548
}
4549
ASSERT(addr);
4550
4551
#if i386_HOST_ARCH
4552
if(isJumpTable)
4553
{
4554
checkProddableBlock(oc,image + sect->offset + i*itemSize);
4555
*(image + sect->offset + i*itemSize) = 0xe9; // jmp
4556
*(unsigned*)(image + sect->offset + i*itemSize + 1)
4557
= (char*)addr - (image + sect->offset + i*itemSize + 5);
4558
}
4559
else
4560
#endif
4561
{
4562
checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
4563
((void**)(image + sect->offset))[i] = addr;
4564
}
4565
}
4566
4567
IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
4568
return 1;
4569
}
4570
4571
static unsigned long relocateAddress(
4572
ObjectCode* oc,
4573
int nSections,
4574
struct section* sections,
4575
unsigned long address)
4576
{
4577
int i;
4578
IF_DEBUG(linker, debugBelch("relocateAddress: start\n"));
4579
for (i = 0; i < nSections; i++)
4580
{
4581
IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i));
4582
if (sections[i].addr <= address
4583
&& address < sections[i].addr + sections[i].size)
4584
{
4585
return (unsigned long)oc->image
4586
+ sections[i].offset + address - sections[i].addr;
4587
}
4588
}
4589
barf("Invalid Mach-O file:"
4590
"Address out of bounds while relocating object file");
4591
return 0;
4592
}
4593
4594
static int relocateSection(
4595
ObjectCode* oc,
4596
char *image,
4597
struct symtab_command *symLC, struct nlist *nlist,
4598
int nSections, struct section* sections, struct section *sect)
4599
{
4600
struct relocation_info *relocs;
4601
int i, n;
4602
4603
IF_DEBUG(linker, debugBelch("relocateSection: start\n"));
4604
4605
if(!strcmp(sect->sectname,"__la_symbol_ptr"))
4606
return 1;
4607
else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
4608
return 1;
4609
else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
4610
return 1;
4611
else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
4612
return 1;
4613
4614
n = sect->nreloc;
4615
IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n));
4616
4617
relocs = (struct relocation_info*) (image + sect->reloff);
4618
4619
for(i=0;i<n;i++)
4620
{
4621
#ifdef x86_64_HOST_ARCH
4622
struct relocation_info *reloc = &relocs[i];
4623
4624
char *thingPtr = image + sect->offset + reloc->r_address;
4625
uint64_t thing;
4626
/* We shouldn't need to initialise this, but gcc on OS X 64 bit
4627
complains that it may be used uninitialized if we don't */
4628
uint64_t value = 0;
4629
uint64_t baseValue;
4630
int type = reloc->r_type;
4631
4632
checkProddableBlock(oc,thingPtr);
4633
switch(reloc->r_length)
4634
{
4635
case 0:
4636
thing = *(uint8_t*)thingPtr;
4637
baseValue = (uint64_t)thingPtr + 1;
4638
break;
4639
case 1:
4640
thing = *(uint16_t*)thingPtr;
4641
baseValue = (uint64_t)thingPtr + 2;
4642
break;
4643
case 2:
4644
thing = *(uint32_t*)thingPtr;
4645
baseValue = (uint64_t)thingPtr + 4;
4646
break;
4647
case 3:
4648
thing = *(uint64_t*)thingPtr;
4649
baseValue = (uint64_t)thingPtr + 8;
4650
break;
4651
default:
4652
barf("Unknown size.");
4653
}
4654
4655
IF_DEBUG(linker,
4656
debugBelch("relocateSection: length = %d, thing = %" PRId64 ", baseValue = %p\n",
4657
reloc->r_length, thing, (char *)baseValue));
4658
4659
if (type == X86_64_RELOC_GOT
4660
|| type == X86_64_RELOC_GOT_LOAD)
4661
{
4662
struct nlist *symbol = &nlist[reloc->r_symbolnum];
4663
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4664
4665
IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern));
4666
ASSERT(reloc->r_extern);
4667
value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr;
4668
4669
type = X86_64_RELOC_SIGNED;
4670
}
4671
else if(reloc->r_extern)
4672
{
4673
struct nlist *symbol = &nlist[reloc->r_symbolnum];
4674
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4675
4676
IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
4677
IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type));
4678
IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect));
4679
IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc));
4680
IF_DEBUG(linker, debugBelch(" : value = %p\n", (void *)symbol->n_value));
4681
if ((symbol->n_type & N_TYPE) == N_SECT) {
4682
value = relocateAddress(oc, nSections, sections,
4683
symbol->n_value);
4684
IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value));
4685
}
4686
else {
4687
value = (uint64_t) lookupSymbol(nm);
4688
IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, (void *)value));
4689
}
4690
}
4691
else
4692
{
4693
// If the relocation is not through the global offset table
4694
// or external, then set the value to the baseValue. This
4695
// will leave displacements into the __const section
4696
// unchanged (as they ought to be).
4697
4698
value = baseValue;
4699
}
4700
4701
IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", (void *)value));
4702
4703
if (type == X86_64_RELOC_BRANCH)
4704
{
4705
if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4706
{
4707
ASSERT(reloc->r_extern);
4708
value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4709
-> jumpIsland;
4710
}
4711
ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4712
type = X86_64_RELOC_SIGNED;
4713
}
4714
4715
switch(type)
4716
{
4717
case X86_64_RELOC_UNSIGNED:
4718
ASSERT(!reloc->r_pcrel);
4719
thing += value;
4720
break;
4721
case X86_64_RELOC_SIGNED:
4722
case X86_64_RELOC_SIGNED_1:
4723
case X86_64_RELOC_SIGNED_2:
4724
case X86_64_RELOC_SIGNED_4:
4725
ASSERT(reloc->r_pcrel);
4726
thing += value - baseValue;
4727
break;
4728
case X86_64_RELOC_SUBTRACTOR:
4729
ASSERT(!reloc->r_pcrel);
4730
thing -= value;
4731
break;
4732
default:
4733
barf("unkown relocation");
4734
}
4735
4736
switch(reloc->r_length)
4737
{
4738
case 0:
4739
*(uint8_t*)thingPtr = thing;
4740
break;
4741
case 1:
4742
*(uint16_t*)thingPtr = thing;
4743
break;
4744
case 2:
4745
*(uint32_t*)thingPtr = thing;
4746
break;
4747
case 3:
4748
*(uint64_t*)thingPtr = thing;
4749
break;
4750
}
4751
#else
4752
if(relocs[i].r_address & R_SCATTERED)
4753
{
4754
struct scattered_relocation_info *scat =
4755
(struct scattered_relocation_info*) &relocs[i];
4756
4757
if(!scat->r_pcrel)
4758
{
4759
if(scat->r_length == 2)
4760
{
4761
unsigned long word = 0;
4762
unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4763
checkProddableBlock(oc,wordPtr);
4764
4765
// Note on relocation types:
4766
// i386 uses the GENERIC_RELOC_* types,
4767
// while ppc uses special PPC_RELOC_* types.
4768
// *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4769
// in both cases, all others are different.
4770
// Therefore, we use GENERIC_RELOC_VANILLA
4771
// and GENERIC_RELOC_PAIR instead of the PPC variants,
4772
// and use #ifdefs for the other types.
4773
4774
// Step 1: Figure out what the relocated value should be
4775
if(scat->r_type == GENERIC_RELOC_VANILLA)
4776
{
4777
word = *wordPtr + (unsigned long) relocateAddress(
4778
oc,
4779
nSections,
4780
sections,
4781
scat->r_value)
4782
- scat->r_value;
4783
}
4784
#ifdef powerpc_HOST_ARCH
4785
else if(scat->r_type == PPC_RELOC_SECTDIFF
4786
|| scat->r_type == PPC_RELOC_LO16_SECTDIFF
4787
|| scat->r_type == PPC_RELOC_HI16_SECTDIFF
4788
|| scat->r_type == PPC_RELOC_HA16_SECTDIFF
4789
|| scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
4790
#else
4791
else if(scat->r_type == GENERIC_RELOC_SECTDIFF
4792
|| scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4793
#endif
4794
{
4795
struct scattered_relocation_info *pair =
4796
(struct scattered_relocation_info*) &relocs[i+1];
4797
4798
if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4799
barf("Invalid Mach-O file: "
4800
"RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4801
4802
word = (unsigned long)
4803
(relocateAddress(oc, nSections, sections, scat->r_value)
4804
- relocateAddress(oc, nSections, sections, pair->r_value));
4805
i++;
4806
}
4807
#ifdef powerpc_HOST_ARCH
4808
else if(scat->r_type == PPC_RELOC_HI16
4809
|| scat->r_type == PPC_RELOC_LO16
4810
|| scat->r_type == PPC_RELOC_HA16
4811
|| scat->r_type == PPC_RELOC_LO14)
4812
{ // these are generated by label+offset things
4813
struct relocation_info *pair = &relocs[i+1];
4814
if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4815
barf("Invalid Mach-O file: "
4816
"PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4817
4818
if(scat->r_type == PPC_RELOC_LO16)
4819
{
4820
word = ((unsigned short*) wordPtr)[1];
4821
word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4822
}
4823
else if(scat->r_type == PPC_RELOC_LO14)
4824
{
4825
barf("Unsupported Relocation: PPC_RELOC_LO14");
4826
word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4827
word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4828
}
4829
else if(scat->r_type == PPC_RELOC_HI16)
4830
{
4831
word = ((unsigned short*) wordPtr)[1] << 16;
4832
word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4833
}
4834
else if(scat->r_type == PPC_RELOC_HA16)
4835
{
4836
word = ((unsigned short*) wordPtr)[1] << 16;
4837
word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4838
}
4839
4840
4841
word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4842
- scat->r_value;
4843
4844
i++;
4845
}
4846
#endif
4847
else
4848
{
4849
barf ("Don't know how to handle this Mach-O "
4850
"scattered relocation entry: "
4851
"object file %s; entry type %ld; "
4852
"address %#lx\n",
4853
OC_INFORMATIVE_FILENAME(oc),
4854
scat->r_type,
4855
scat->r_address);
4856
return 0;
4857
}
4858
4859
#ifdef powerpc_HOST_ARCH
4860
if(scat->r_type == GENERIC_RELOC_VANILLA
4861
|| scat->r_type == PPC_RELOC_SECTDIFF)
4862
#else
4863
if(scat->r_type == GENERIC_RELOC_VANILLA
4864
|| scat->r_type == GENERIC_RELOC_SECTDIFF
4865
|| scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4866
#endif
4867
{
4868
*wordPtr = word;
4869
}
4870
#ifdef powerpc_HOST_ARCH
4871
else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4872
{
4873
((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4874
}
4875
else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4876
{
4877
((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4878
}
4879
else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4880
{
4881
((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4882
+ ((word & (1<<15)) ? 1 : 0);
4883
}
4884
#endif
4885
}
4886
else
4887
{
4888
barf("Can't handle Mach-O scattered relocation entry "
4889
"with this r_length tag: "
4890
"object file %s; entry type %ld; "
4891
"r_length tag %ld; address %#lx\n",
4892
OC_INFORMATIVE_FILENAME(oc),
4893
scat->r_type,
4894
scat->r_length,
4895
scat->r_address);
4896
return 0;
4897
}
4898
}
4899
else /* scat->r_pcrel */
4900
{
4901
barf("Don't know how to handle *PC-relative* Mach-O "
4902
"scattered relocation entry: "
4903
"object file %s; entry type %ld; address %#lx\n",
4904
OC_INFORMATIVE_FILENAME(oc),
4905
scat->r_type,
4906
scat->r_address);
4907
return 0;
4908
}
4909
4910
}
4911
else /* !(relocs[i].r_address & R_SCATTERED) */
4912
{
4913
struct relocation_info *reloc = &relocs[i];
4914
if(reloc->r_pcrel && !reloc->r_extern)
4915
continue;
4916
4917
if(reloc->r_length == 2)
4918
{
4919
unsigned long word = 0;
4920
#ifdef powerpc_HOST_ARCH
4921
unsigned long jumpIsland = 0;
4922
long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4923
// to avoid warning and to catch
4924
// bugs.
4925
#endif
4926
4927
unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4928
checkProddableBlock(oc,wordPtr);
4929
4930
if(reloc->r_type == GENERIC_RELOC_VANILLA)
4931
{
4932
word = *wordPtr;
4933
}
4934
#ifdef powerpc_HOST_ARCH
4935
else if(reloc->r_type == PPC_RELOC_LO16)
4936
{
4937
word = ((unsigned short*) wordPtr)[1];
4938
word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4939
}
4940
else if(reloc->r_type == PPC_RELOC_HI16)
4941
{
4942
word = ((unsigned short*) wordPtr)[1] << 16;
4943
word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4944
}
4945
else if(reloc->r_type == PPC_RELOC_HA16)
4946
{
4947
word = ((unsigned short*) wordPtr)[1] << 16;
4948
word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4949
}
4950
else if(reloc->r_type == PPC_RELOC_BR24)
4951
{
4952
word = *wordPtr;
4953
word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4954
}
4955
#endif
4956
else
4957
{
4958
barf("Can't handle this Mach-O relocation entry "
4959
"(not scattered): "
4960
"object file %s; entry type %ld; address %#lx\n",
4961
OC_INFORMATIVE_FILENAME(oc),
4962
reloc->r_type,
4963
reloc->r_address);
4964
return 0;
4965
}
4966
4967
if(!reloc->r_extern)
4968
{
4969
long delta =
4970
sections[reloc->r_symbolnum-1].offset
4971
- sections[reloc->r_symbolnum-1].addr
4972
+ ((long) image);
4973
4974
word += delta;
4975
}
4976
else
4977
{
4978
struct nlist *symbol = &nlist[reloc->r_symbolnum];
4979
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4980
void *symbolAddress = lookupSymbol(nm);
4981
if(!symbolAddress)
4982
{
4983
errorBelch("\nunknown symbol `%s'", nm);
4984
return 0;
4985
}
4986
4987
if(reloc->r_pcrel)
4988
{
4989
#ifdef powerpc_HOST_ARCH
4990
// In the .o file, this should be a relative jump to NULL
4991
// and we'll change it to a relative jump to the symbol
4992
ASSERT(word + reloc->r_address == 0);
4993
jumpIsland = (unsigned long)
4994
&makeSymbolExtra(oc,
4995
reloc->r_symbolnum,
4996
(unsigned long) symbolAddress)
4997
-> jumpIsland;
4998
if(jumpIsland != 0)
4999
{
5000
offsetToJumpIsland = word + jumpIsland
5001
- (((long)image) + sect->offset - sect->addr);
5002
}
5003
#endif
5004
word += (unsigned long) symbolAddress
5005
- (((long)image) + sect->offset - sect->addr);
5006
}
5007
else
5008
{
5009
word += (unsigned long) symbolAddress;
5010
}
5011
}
5012
5013
if(reloc->r_type == GENERIC_RELOC_VANILLA)
5014
{
5015
*wordPtr = word;
5016
continue;
5017
}
5018
#ifdef powerpc_HOST_ARCH
5019
else if(reloc->r_type == PPC_RELOC_LO16)
5020
{
5021
((unsigned short*) wordPtr)[1] = word & 0xFFFF;
5022
i++; continue;
5023
}
5024
else if(reloc->r_type == PPC_RELOC_HI16)
5025
{
5026
((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
5027
i++; continue;
5028
}
5029
else if(reloc->r_type == PPC_RELOC_HA16)
5030
{
5031
((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
5032
+ ((word & (1<<15)) ? 1 : 0);
5033
i++; continue;
5034
}
5035
else if(reloc->r_type == PPC_RELOC_BR24)
5036
{
5037
if((word & 0x03) != 0)
5038
barf("%s: unconditional relative branch with a displacement "
5039
"which isn't a multiple of 4 bytes: %#lx",
5040
OC_INFORMATIVE_FILENAME(oc),
5041
word);
5042
5043
if((word & 0xFE000000) != 0xFE000000 &&
5044
(word & 0xFE000000) != 0x00000000)
5045
{
5046
// The branch offset is too large.
5047
// Therefore, we try to use a jump island.
5048
if(jumpIsland == 0)
5049
{
5050
barf("%s: unconditional relative branch out of range: "
5051
"no jump island available: %#lx",
5052
OC_INFORMATIVE_FILENAME(oc),
5053
word);
5054
}
5055
5056
word = offsetToJumpIsland;
5057
if((word & 0xFE000000) != 0xFE000000 &&
5058
(word & 0xFE000000) != 0x00000000)
5059
barf("%s: unconditional relative branch out of range: "
5060
"jump island out of range: %#lx",
5061
OC_INFORMATIVE_FILENAME(oc),
5062
word);
5063
}
5064
*wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
5065
continue;
5066
}
5067
#endif
5068
}
5069
else
5070
{
5071
barf("Can't handle Mach-O relocation entry (not scattered) "
5072
"with this r_length tag: "
5073
"object file %s; entry type %ld; "
5074
"r_length tag %ld; address %#lx\n",
5075
OC_INFORMATIVE_FILENAME(oc),
5076
reloc->r_type,
5077
reloc->r_length,
5078
reloc->r_address);
5079
return 0;
5080
}
5081
}
5082
#endif
5083
}
5084
IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
5085
return 1;
5086
}
5087
5088
static int ocGetNames_MachO(ObjectCode* oc)
5089
{
5090
char *image = (char*) oc->image;
5091
struct mach_header *header = (struct mach_header*) image;
5092
struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
5093
unsigned i,curSymbol = 0;
5094
struct segment_command *segLC = NULL;
5095
struct section *sections;
5096
struct symtab_command *symLC = NULL;
5097
struct nlist *nlist;
5098
unsigned long commonSize = 0;
5099
char *commonStorage = NULL;
5100
unsigned long commonCounter;
5101
5102
IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
5103
5104
for(i=0;i<header->ncmds;i++)
5105
{
5106
if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
5107
segLC = (struct segment_command*) lc;
5108
else if(lc->cmd == LC_SYMTAB)
5109
symLC = (struct symtab_command*) lc;
5110
lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
5111
}
5112
5113
sections = (struct section*) (segLC+1);
5114
nlist = symLC ? (struct nlist*) (image + symLC->symoff)
5115
: NULL;
5116
5117
if(!segLC)
5118
barf("ocGetNames_MachO: no segment load command");
5119
5120
for(i=0;i<segLC->nsects;i++)
5121
{
5122
IF_DEBUG(linker, debugBelch("ocGetNames_MachO: segment %d\n", i));
5123
if (sections[i].size == 0)
5124
continue;
5125
5126
if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
5127
{
5128
char * zeroFillArea = stgCallocBytes(1,sections[i].size,
5129
"ocGetNames_MachO(common symbols)");
5130
sections[i].offset = zeroFillArea - image;
5131
}
5132
5133
if(!strcmp(sections[i].sectname,"__text"))
5134
addSection(oc, SECTIONKIND_CODE_OR_RODATA,
5135
(void*) (image + sections[i].offset),
5136
(void*) (image + sections[i].offset + sections[i].size));
5137
else if(!strcmp(sections[i].sectname,"__const"))
5138
addSection(oc, SECTIONKIND_RWDATA,
5139
(void*) (image + sections[i].offset),
5140
(void*) (image + sections[i].offset + sections[i].size));
5141
else if(!strcmp(sections[i].sectname,"__data"))
5142
addSection(oc, SECTIONKIND_RWDATA,
5143
(void*) (image + sections[i].offset),
5144
(void*) (image + sections[i].offset + sections[i].size));
5145
else if(!strcmp(sections[i].sectname,"__bss")
5146
|| !strcmp(sections[i].sectname,"__common"))
5147
addSection(oc, SECTIONKIND_RWDATA,
5148
(void*) (image + sections[i].offset),
5149
(void*) (image + sections[i].offset + sections[i].size));
5150
5151
addProddableBlock(oc, (void*) (image + sections[i].offset),
5152
sections[i].size);
5153
}
5154
5155
// count external symbols defined here
5156
oc->n_symbols = 0;
5157
if(symLC)
5158
{
5159
for(i=0;i<symLC->nsyms;i++)
5160
{
5161
if(nlist[i].n_type & N_STAB)
5162
;
5163
else if(nlist[i].n_type & N_EXT)
5164
{
5165
if((nlist[i].n_type & N_TYPE) == N_UNDF
5166
&& (nlist[i].n_value != 0))
5167
{
5168
commonSize += nlist[i].n_value;
5169
oc->n_symbols++;
5170
}
5171
else if((nlist[i].n_type & N_TYPE) == N_SECT)
5172
oc->n_symbols++;
5173
}
5174
}
5175
}
5176
IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols));
5177
oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
5178
"ocGetNames_MachO(oc->symbols)");
5179
5180
if(symLC)
5181
{
5182
for(i=0;i<symLC->nsyms;i++)
5183
{
5184
if(nlist[i].n_type & N_STAB)
5185
;
5186
else if((nlist[i].n_type & N_TYPE) == N_SECT)
5187
{
5188
if(nlist[i].n_type & N_EXT)
5189
{
5190
char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
5191
if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
5192
// weak definition, and we already have a definition
5193
IF_DEBUG(linker, debugBelch(" weak: %s\n", nm));
5194
}
5195
else
5196
{
5197
IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
5198
ghciInsertStrHashTable(oc->fileName, symhash, nm,
5199
image
5200
+ sections[nlist[i].n_sect-1].offset
5201
- sections[nlist[i].n_sect-1].addr
5202
+ nlist[i].n_value);
5203
oc->symbols[curSymbol++] = nm;
5204
}
5205
}
5206
}
5207
}
5208
}
5209
5210
commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
5211
commonCounter = (unsigned long)commonStorage;
5212
if(symLC)
5213
{
5214
for(i=0;i<symLC->nsyms;i++)
5215
{
5216
if((nlist[i].n_type & N_TYPE) == N_UNDF
5217
&& (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
5218
{
5219
char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
5220
unsigned long sz = nlist[i].n_value;
5221
5222
nlist[i].n_value = commonCounter;
5223
5224
IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
5225
ghciInsertStrHashTable(oc->fileName, symhash, nm,
5226
(void*)commonCounter);
5227
oc->symbols[curSymbol++] = nm;
5228
5229
commonCounter += sz;
5230
}
5231
}
5232
}
5233
return 1;
5234
}
5235
5236
static int ocResolve_MachO(ObjectCode* oc)
5237
{
5238
char *image = (char*) oc->image;
5239
struct mach_header *header = (struct mach_header*) image;
5240
struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
5241
unsigned i;
5242
struct segment_command *segLC = NULL;
5243
struct section *sections;
5244
struct symtab_command *symLC = NULL;
5245
struct dysymtab_command *dsymLC = NULL;
5246
struct nlist *nlist;
5247
5248
IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n"));
5249
for (i = 0; i < header->ncmds; i++)
5250
{
5251
if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
5252
segLC = (struct segment_command*) lc;
5253
else if(lc->cmd == LC_SYMTAB)
5254
symLC = (struct symtab_command*) lc;
5255
else if(lc->cmd == LC_DYSYMTAB)
5256
dsymLC = (struct dysymtab_command*) lc;
5257
lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
5258
}
5259
5260
sections = (struct section*) (segLC+1);
5261
nlist = symLC ? (struct nlist*) (image + symLC->symoff)
5262
: NULL;
5263
5264
if(dsymLC)
5265
{
5266
unsigned long *indirectSyms
5267
= (unsigned long*) (image + dsymLC->indirectsymoff);
5268
5269
IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n"));
5270
for (i = 0; i < segLC->nsects; i++)
5271
{
5272
if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
5273
|| !strcmp(sections[i].sectname,"__la_sym_ptr2")
5274
|| !strcmp(sections[i].sectname,"__la_sym_ptr3"))
5275
{
5276
if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5277
return 0;
5278
}
5279
else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
5280
|| !strcmp(sections[i].sectname,"__pointers"))
5281
{
5282
if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5283
return 0;
5284
}
5285
else if(!strcmp(sections[i].sectname,"__jump_table"))
5286
{
5287
if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5288
return 0;
5289
}
5290
else
5291
{
5292
IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
5293
}
5294
}
5295
}
5296
5297
for(i=0;i<segLC->nsects;i++)
5298
{
5299
IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i));
5300
5301
if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
5302
return 0;
5303
}
5304
5305
#if defined (powerpc_HOST_ARCH)
5306
ocFlushInstructionCache( oc );
5307
#endif
5308
5309
return 1;
5310
}
5311
5312
#ifdef powerpc_HOST_ARCH
5313
/*
5314
* The Mach-O object format uses leading underscores. But not everywhere.
5315
* There is a small number of runtime support functions defined in
5316
* libcc_dynamic.a whose name does not have a leading underscore.
5317
* As a consequence, we can't get their address from C code.
5318
* We have to use inline assembler just to take the address of a function.
5319
* Yuck.
5320
*/
5321
5322
extern void* symbolsWithoutUnderscore[];
5323
5324
static void machoInitSymbolsWithoutUnderscore()
5325
{
5326
void **p = symbolsWithoutUnderscore;
5327
__asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
5328
5329
#undef SymI_NeedsProto
5330
#define SymI_NeedsProto(x) \
5331
__asm__ volatile(".long " # x);
5332
5333
RTS_MACHO_NOUNDERLINE_SYMBOLS
5334
5335
__asm__ volatile(".text");
5336
5337
#undef SymI_NeedsProto
5338
#define SymI_NeedsProto(x) \
5339
ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
5340
5341
RTS_MACHO_NOUNDERLINE_SYMBOLS
5342
5343
#undef SymI_NeedsProto
5344
}
5345
#endif
5346
5347
#if !defined USE_MMAP && defined(darwin_HOST_OS)
5348
/*
5349
* Figure out by how much to shift the entire Mach-O file in memory
5350
* when loading so that its single segment ends up 16-byte-aligned
5351
*/
5352
static int machoGetMisalignment( FILE * f )
5353
{
5354
struct mach_header header;
5355
int misalignment;
5356
5357
{
5358
int n = fread(&header, sizeof(header), 1, f);
5359
if (n != 1) {
5360
barf("machoGetMisalignment: can't read the Mach-O header");
5361
}
5362
}
5363
fseek(f, -sizeof(header), SEEK_CUR);
5364
5365
#if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
5366
if(header.magic != MH_MAGIC_64) {
5367
barf("Bad magic. Expected: %08x, got: %08x.",
5368
MH_MAGIC_64, header.magic);
5369
}
5370
#else
5371
if(header.magic != MH_MAGIC) {
5372
barf("Bad magic. Expected: %08x, got: %08x.",
5373
MH_MAGIC, header.magic);
5374
}
5375
#endif
5376
5377
misalignment = (header.sizeofcmds + sizeof(header))
5378
& 0xF;
5379
5380
return misalignment ? (16 - misalignment) : 0;
5381
}
5382
#endif
5383
5384
#endif
Loggerhead is a web-based interface for Breezy
Version: 2.0.1