1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 2000-2004
7 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
13 /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14 MREMAP_MAYMOVE from <sys/mman.h>.
16 #if defined(__linux__) || defined(__GLIBC__)
23 #include "sm/Storage.h"
26 #include "LinkerInternals.h"
29 #include "StgPrimFloat.h" // for __int_encodeFloat etc.
32 #if !defined(mingw32_HOST_OS)
33 #include "posix/Signals.h"
36 // get protos for is*()
39 #ifdef HAVE_SYS_TYPES_H
40 #include <sys/types.h>
49 #ifdef HAVE_SYS_STAT_H
53 #if defined(HAVE_DLFCN_H)
57 #if defined(cygwin32_HOST_OS)
62 #ifdef HAVE_SYS_TIME_H
66 #include <sys/fcntl.h>
67 #include <sys/termios.h>
68 #include <sys/utime.h>
69 #include <sys/utsname.h>
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.
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
101 #elif defined(darwin_HOST_OS)
102 # define OBJFORMAT_MACHO
104 # include <mach/machine.h>
105 # include <mach-o/fat.h>
106 # include <mach-o/loader.h>
107 # include <mach-o/nlist.h>
108 # include <mach-o/reloc.h>
109 #if !defined(HAVE_DLFCN_H)
110 # include <mach-o/dyld.h>
112 #if defined(powerpc_HOST_ARCH)
113 # include <mach-o/ppc/reloc.h>
115 #if defined(x86_64_HOST_ARCH)
116 # include <mach-o/x86_64/reloc.h>
120 #if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
124 /* Hash table mapping symbol names to Symbol */
125 static /*Str*/HashTable *symhash;
127 /* Hash table mapping symbol names to StgStablePtr */
128 static /*Str*/HashTable *stablehash;
130 /* List of currently loaded objects */
131 ObjectCode *objects = NULL; /* initially empty */
133 static HsInt loadOc( ObjectCode* oc );
134 static ObjectCode* mkOc( char *path, char *image, int imageSize,
135 char *archiveMemberName
137 #ifdef darwin_HOST_OS
143 #if defined(OBJFORMAT_ELF)
144 static int ocVerifyImage_ELF ( ObjectCode* oc );
145 static int ocGetNames_ELF ( ObjectCode* oc );
146 static int ocResolve_ELF ( ObjectCode* oc );
147 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
148 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
150 #elif defined(OBJFORMAT_PEi386)
151 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
152 static int ocGetNames_PEi386 ( ObjectCode* oc );
153 static int ocResolve_PEi386 ( ObjectCode* oc );
154 static void *lookupSymbolInDLLs ( unsigned char *lbl );
155 static void zapTrailingAtSign ( unsigned char *sym );
156 #elif defined(OBJFORMAT_MACHO)
157 static int ocVerifyImage_MachO ( ObjectCode* oc );
158 static int ocGetNames_MachO ( ObjectCode* oc );
159 static int ocResolve_MachO ( ObjectCode* oc );
162 static int machoGetMisalignment( FILE * );
164 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
165 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
167 #ifdef powerpc_HOST_ARCH
168 static void machoInitSymbolsWithoutUnderscore( void );
172 /* on x86_64 we have a problem with relocating symbol references in
173 * code that was compiled without -fPIC. By default, the small memory
174 * model is used, which assumes that symbol references can fit in a
175 * 32-bit slot. The system dynamic linker makes this work for
176 * references to shared libraries by either (a) allocating a jump
177 * table slot for code references, or (b) moving the symbol at load
178 * time (and copying its contents, if necessary) for data references.
180 * We unfortunately can't tell whether symbol references are to code
181 * or data. So for now we assume they are code (the vast majority
182 * are), and allocate jump-table slots. Unfortunately this will
183 * SILENTLY generate crashing code for data references. This hack is
184 * enabled by X86_64_ELF_NONPIC_HACK.
186 * One workaround is to use shared Haskell libraries. This is
187 * coming. Another workaround is to keep the static libraries but
188 * compile them with -fPIC, because that will generate PIC references
189 * to data which can be relocated. The PIC code is still too green to
190 * do this systematically, though.
193 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
195 * Naming Scheme for Symbol Macros
197 * SymI_*: symbol is internal to the RTS. It resides in an object
198 * file/library that is statically.
199 * SymE_*: symbol is external to the RTS library. It might be linked
202 * Sym*_HasProto : the symbol prototype is imported in an include file
203 * or defined explicitly
204 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
205 * default proto extern void sym(void);
207 #define X86_64_ELF_NONPIC_HACK 1
209 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
210 * small memory model on this architecture (see gcc docs,
213 * MAP_32BIT not available on OpenBSD/amd64
215 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
216 #define TRY_MAP_32BIT MAP_32BIT
218 #define TRY_MAP_32BIT 0
222 * Due to the small memory model (see above), on x86_64 we have to map
223 * all our non-PIC object files into the low 2Gb of the address space
224 * (why 2Gb and not 4Gb? Because all addresses must be reachable
225 * using a 32-bit signed PC-relative offset). On Linux we can do this
226 * using the MAP_32BIT flag to mmap(), however on other OSs
227 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
228 * can't do this. So on these systems, we have to pick a base address
229 * in the low 2Gb of the address space and try to allocate memory from
232 * We pick a default address based on the OS, but also make this
233 * configurable via an RTS flag (+RTS -xm)
235 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
237 #if defined(MAP_32BIT)
238 // Try to use MAP_32BIT
239 #define MMAP_32BIT_BASE_DEFAULT 0
242 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
245 static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
248 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
249 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
250 #define MAP_ANONYMOUS MAP_ANON
253 /* -----------------------------------------------------------------------------
254 * Built-in symbols from the RTS
257 typedef struct _RtsSymbolVal {
262 #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
263 SymI_HasProto(stg_mkWeakForeignEnvzh) \
264 SymI_HasProto(stg_makeStableNamezh) \
265 SymI_HasProto(stg_finalizzeWeakzh)
267 #if !defined (mingw32_HOST_OS)
268 #define RTS_POSIX_ONLY_SYMBOLS \
269 SymI_HasProto(__hscore_get_saved_termios) \
270 SymI_HasProto(__hscore_set_saved_termios) \
271 SymI_HasProto(shutdownHaskellAndSignal) \
272 SymI_HasProto(lockFile) \
273 SymI_HasProto(unlockFile) \
274 SymI_HasProto(signal_handlers) \
275 SymI_HasProto(stg_sig_install) \
276 SymI_HasProto(rtsTimerSignal) \
277 SymI_HasProto(atexit) \
278 SymI_NeedsProto(nocldstop)
281 #if defined (cygwin32_HOST_OS)
282 #define RTS_MINGW_ONLY_SYMBOLS /**/
283 /* Don't have the ability to read import libs / archives, so
284 * we have to stupidly list a lot of what libcygwin.a
287 #define RTS_CYGWIN_ONLY_SYMBOLS \
288 SymI_HasProto(regfree) \
289 SymI_HasProto(regexec) \
290 SymI_HasProto(regerror) \
291 SymI_HasProto(regcomp) \
292 SymI_HasProto(__errno) \
293 SymI_HasProto(access) \
294 SymI_HasProto(chmod) \
295 SymI_HasProto(chdir) \
296 SymI_HasProto(close) \
297 SymI_HasProto(creat) \
299 SymI_HasProto(dup2) \
300 SymI_HasProto(fstat) \
301 SymI_HasProto(fcntl) \
302 SymI_HasProto(getcwd) \
303 SymI_HasProto(getenv) \
304 SymI_HasProto(lseek) \
305 SymI_HasProto(open) \
306 SymI_HasProto(fpathconf) \
307 SymI_HasProto(pathconf) \
308 SymI_HasProto(stat) \
310 SymI_HasProto(tanh) \
311 SymI_HasProto(cosh) \
312 SymI_HasProto(sinh) \
313 SymI_HasProto(atan) \
314 SymI_HasProto(acos) \
315 SymI_HasProto(asin) \
321 SymI_HasProto(sqrt) \
322 SymI_HasProto(localtime_r) \
323 SymI_HasProto(gmtime_r) \
324 SymI_HasProto(mktime) \
325 SymI_NeedsProto(_imp___tzname) \
326 SymI_HasProto(gettimeofday) \
327 SymI_HasProto(timezone) \
328 SymI_HasProto(tcgetattr) \
329 SymI_HasProto(tcsetattr) \
330 SymI_HasProto(memcpy) \
331 SymI_HasProto(memmove) \
332 SymI_HasProto(realloc) \
333 SymI_HasProto(malloc) \
334 SymI_HasProto(free) \
335 SymI_HasProto(fork) \
336 SymI_HasProto(lstat) \
337 SymI_HasProto(isatty) \
338 SymI_HasProto(mkdir) \
339 SymI_HasProto(opendir) \
340 SymI_HasProto(readdir) \
341 SymI_HasProto(rewinddir) \
342 SymI_HasProto(closedir) \
343 SymI_HasProto(link) \
344 SymI_HasProto(mkfifo) \
345 SymI_HasProto(pipe) \
346 SymI_HasProto(read) \
347 SymI_HasProto(rename) \
348 SymI_HasProto(rmdir) \
349 SymI_HasProto(select) \
350 SymI_HasProto(system) \
351 SymI_HasProto(write) \
352 SymI_HasProto(strcmp) \
353 SymI_HasProto(strcpy) \
354 SymI_HasProto(strncpy) \
355 SymI_HasProto(strerror) \
356 SymI_HasProto(sigaddset) \
357 SymI_HasProto(sigemptyset) \
358 SymI_HasProto(sigprocmask) \
359 SymI_HasProto(umask) \
360 SymI_HasProto(uname) \
361 SymI_HasProto(unlink) \
362 SymI_HasProto(utime) \
363 SymI_HasProto(waitpid)
365 #elif !defined(mingw32_HOST_OS)
366 #define RTS_MINGW_ONLY_SYMBOLS /**/
367 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
368 #else /* defined(mingw32_HOST_OS) */
369 #define RTS_POSIX_ONLY_SYMBOLS /**/
370 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
372 #if HAVE_GETTIMEOFDAY
373 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
375 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
378 #if HAVE___MINGW_VFPRINTF
379 #define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
381 #define RTS___MINGW_VFPRINTF_SYM /**/
384 /* These are statically linked from the mingw libraries into the ghc
385 executable, so we have to employ this hack. */
386 #define RTS_MINGW_ONLY_SYMBOLS \
387 SymI_HasProto(stg_asyncReadzh) \
388 SymI_HasProto(stg_asyncWritezh) \
389 SymI_HasProto(stg_asyncDoProczh) \
390 SymI_HasProto(getWin32ProgArgv) \
391 SymI_HasProto(setWin32ProgArgv) \
392 SymI_HasProto(memset) \
393 SymI_HasProto(inet_ntoa) \
394 SymI_HasProto(inet_addr) \
395 SymI_HasProto(htonl) \
396 SymI_HasProto(recvfrom) \
397 SymI_HasProto(listen) \
398 SymI_HasProto(bind) \
399 SymI_HasProto(shutdown) \
400 SymI_HasProto(connect) \
401 SymI_HasProto(htons) \
402 SymI_HasProto(ntohs) \
403 SymI_HasProto(getservbyname) \
404 SymI_HasProto(getservbyport) \
405 SymI_HasProto(getprotobynumber) \
406 SymI_HasProto(getprotobyname) \
407 SymI_HasProto(gethostbyname) \
408 SymI_HasProto(gethostbyaddr) \
409 SymI_HasProto(gethostname) \
410 SymI_HasProto(strcpy) \
411 SymI_HasProto(strncpy) \
412 SymI_HasProto(abort) \
413 SymI_NeedsProto(_alloca) \
414 SymI_HasProto(isxdigit) \
415 SymI_HasProto(isupper) \
416 SymI_HasProto(ispunct) \
417 SymI_HasProto(islower) \
418 SymI_HasProto(isspace) \
419 SymI_HasProto(isprint) \
420 SymI_HasProto(isdigit) \
421 SymI_HasProto(iscntrl) \
422 SymI_HasProto(isalpha) \
423 SymI_HasProto(isalnum) \
424 SymI_HasProto(isascii) \
425 RTS___MINGW_VFPRINTF_SYM \
426 SymI_HasProto(strcmp) \
427 SymI_HasProto(memmove) \
428 SymI_HasProto(realloc) \
429 SymI_HasProto(malloc) \
431 SymI_HasProto(tanh) \
432 SymI_HasProto(cosh) \
433 SymI_HasProto(sinh) \
434 SymI_HasProto(atan) \
435 SymI_HasProto(acos) \
436 SymI_HasProto(asin) \
442 SymI_HasProto(sqrt) \
443 SymI_HasProto(powf) \
444 SymI_HasProto(tanhf) \
445 SymI_HasProto(coshf) \
446 SymI_HasProto(sinhf) \
447 SymI_HasProto(atanf) \
448 SymI_HasProto(acosf) \
449 SymI_HasProto(asinf) \
450 SymI_HasProto(tanf) \
451 SymI_HasProto(cosf) \
452 SymI_HasProto(sinf) \
453 SymI_HasProto(expf) \
454 SymI_HasProto(logf) \
455 SymI_HasProto(sqrtf) \
457 SymI_HasProto(erfc) \
458 SymI_HasProto(erff) \
459 SymI_HasProto(erfcf) \
460 SymI_HasProto(memcpy) \
461 SymI_HasProto(rts_InstallConsoleEvent) \
462 SymI_HasProto(rts_ConsoleHandlerDone) \
463 SymI_NeedsProto(mktime) \
464 SymI_NeedsProto(_imp___timezone) \
465 SymI_NeedsProto(_imp___tzname) \
466 SymI_NeedsProto(_imp__tzname) \
467 SymI_NeedsProto(_imp___iob) \
468 SymI_NeedsProto(_imp___osver) \
469 SymI_NeedsProto(localtime) \
470 SymI_NeedsProto(gmtime) \
471 SymI_NeedsProto(opendir) \
472 SymI_NeedsProto(readdir) \
473 SymI_NeedsProto(rewinddir) \
474 SymI_NeedsProto(_imp____mb_cur_max) \
475 SymI_NeedsProto(_imp___pctype) \
476 SymI_NeedsProto(__chkstk) \
477 RTS_MINGW_GETTIMEOFDAY_SYM \
478 SymI_NeedsProto(closedir)
482 #if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
483 #define RTS_DARWIN_ONLY_SYMBOLS \
484 SymI_NeedsProto(asprintf$LDBLStub) \
485 SymI_NeedsProto(err$LDBLStub) \
486 SymI_NeedsProto(errc$LDBLStub) \
487 SymI_NeedsProto(errx$LDBLStub) \
488 SymI_NeedsProto(fprintf$LDBLStub) \
489 SymI_NeedsProto(fscanf$LDBLStub) \
490 SymI_NeedsProto(fwprintf$LDBLStub) \
491 SymI_NeedsProto(fwscanf$LDBLStub) \
492 SymI_NeedsProto(printf$LDBLStub) \
493 SymI_NeedsProto(scanf$LDBLStub) \
494 SymI_NeedsProto(snprintf$LDBLStub) \
495 SymI_NeedsProto(sprintf$LDBLStub) \
496 SymI_NeedsProto(sscanf$LDBLStub) \
497 SymI_NeedsProto(strtold$LDBLStub) \
498 SymI_NeedsProto(swprintf$LDBLStub) \
499 SymI_NeedsProto(swscanf$LDBLStub) \
500 SymI_NeedsProto(syslog$LDBLStub) \
501 SymI_NeedsProto(vasprintf$LDBLStub) \
502 SymI_NeedsProto(verr$LDBLStub) \
503 SymI_NeedsProto(verrc$LDBLStub) \
504 SymI_NeedsProto(verrx$LDBLStub) \
505 SymI_NeedsProto(vfprintf$LDBLStub) \
506 SymI_NeedsProto(vfscanf$LDBLStub) \
507 SymI_NeedsProto(vfwprintf$LDBLStub) \
508 SymI_NeedsProto(vfwscanf$LDBLStub) \
509 SymI_NeedsProto(vprintf$LDBLStub) \
510 SymI_NeedsProto(vscanf$LDBLStub) \
511 SymI_NeedsProto(vsnprintf$LDBLStub) \
512 SymI_NeedsProto(vsprintf$LDBLStub) \
513 SymI_NeedsProto(vsscanf$LDBLStub) \
514 SymI_NeedsProto(vswprintf$LDBLStub) \
515 SymI_NeedsProto(vswscanf$LDBLStub) \
516 SymI_NeedsProto(vsyslog$LDBLStub) \
517 SymI_NeedsProto(vwarn$LDBLStub) \
518 SymI_NeedsProto(vwarnc$LDBLStub) \
519 SymI_NeedsProto(vwarnx$LDBLStub) \
520 SymI_NeedsProto(vwprintf$LDBLStub) \
521 SymI_NeedsProto(vwscanf$LDBLStub) \
522 SymI_NeedsProto(warn$LDBLStub) \
523 SymI_NeedsProto(warnc$LDBLStub) \
524 SymI_NeedsProto(warnx$LDBLStub) \
525 SymI_NeedsProto(wcstold$LDBLStub) \
526 SymI_NeedsProto(wprintf$LDBLStub) \
527 SymI_NeedsProto(wscanf$LDBLStub)
529 #define RTS_DARWIN_ONLY_SYMBOLS
533 # define MAIN_CAP_SYM SymI_HasProto(MainCapability)
535 # define MAIN_CAP_SYM
538 #if !defined(mingw32_HOST_OS)
539 #define RTS_USER_SIGNALS_SYMBOLS \
540 SymI_HasProto(setIOManagerControlFd) \
541 SymI_HasProto(setIOManagerWakeupFd) \
542 SymI_HasProto(ioManagerWakeup) \
543 SymI_HasProto(blockUserSignals) \
544 SymI_HasProto(unblockUserSignals)
546 #define RTS_USER_SIGNALS_SYMBOLS \
547 SymI_HasProto(ioManagerWakeup) \
548 SymI_HasProto(sendIOManagerEvent) \
549 SymI_HasProto(readIOManagerEvent) \
550 SymI_HasProto(getIOManagerEvent) \
551 SymI_HasProto(console_handler)
554 #define RTS_LIBFFI_SYMBOLS \
555 SymE_NeedsProto(ffi_prep_cif) \
556 SymE_NeedsProto(ffi_call) \
557 SymE_NeedsProto(ffi_type_void) \
558 SymE_NeedsProto(ffi_type_float) \
559 SymE_NeedsProto(ffi_type_double) \
560 SymE_NeedsProto(ffi_type_sint64) \
561 SymE_NeedsProto(ffi_type_uint64) \
562 SymE_NeedsProto(ffi_type_sint32) \
563 SymE_NeedsProto(ffi_type_uint32) \
564 SymE_NeedsProto(ffi_type_sint16) \
565 SymE_NeedsProto(ffi_type_uint16) \
566 SymE_NeedsProto(ffi_type_sint8) \
567 SymE_NeedsProto(ffi_type_uint8) \
568 SymE_NeedsProto(ffi_type_pointer)
570 #ifdef TABLES_NEXT_TO_CODE
571 #define RTS_RET_SYMBOLS /* nothing */
573 #define RTS_RET_SYMBOLS \
574 SymI_HasProto(stg_enter_ret) \
575 SymI_HasProto(stg_gc_fun_ret) \
576 SymI_HasProto(stg_ap_v_ret) \
577 SymI_HasProto(stg_ap_f_ret) \
578 SymI_HasProto(stg_ap_d_ret) \
579 SymI_HasProto(stg_ap_l_ret) \
580 SymI_HasProto(stg_ap_n_ret) \
581 SymI_HasProto(stg_ap_p_ret) \
582 SymI_HasProto(stg_ap_pv_ret) \
583 SymI_HasProto(stg_ap_pp_ret) \
584 SymI_HasProto(stg_ap_ppv_ret) \
585 SymI_HasProto(stg_ap_ppp_ret) \
586 SymI_HasProto(stg_ap_pppv_ret) \
587 SymI_HasProto(stg_ap_pppp_ret) \
588 SymI_HasProto(stg_ap_ppppp_ret) \
589 SymI_HasProto(stg_ap_pppppp_ret)
592 /* Modules compiled with -ticky may mention ticky counters */
593 /* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
594 #define RTS_TICKY_SYMBOLS \
595 SymI_NeedsProto(ticky_entry_ctrs) \
596 SymI_NeedsProto(top_ct) \
598 SymI_HasProto(ENT_VIA_NODE_ctr) \
599 SymI_HasProto(ENT_STATIC_THK_ctr) \
600 SymI_HasProto(ENT_DYN_THK_ctr) \
601 SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
602 SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
603 SymI_HasProto(ENT_STATIC_CON_ctr) \
604 SymI_HasProto(ENT_DYN_CON_ctr) \
605 SymI_HasProto(ENT_STATIC_IND_ctr) \
606 SymI_HasProto(ENT_DYN_IND_ctr) \
607 SymI_HasProto(ENT_PERM_IND_ctr) \
608 SymI_HasProto(ENT_PAP_ctr) \
609 SymI_HasProto(ENT_AP_ctr) \
610 SymI_HasProto(ENT_AP_STACK_ctr) \
611 SymI_HasProto(ENT_BH_ctr) \
612 SymI_HasProto(UNKNOWN_CALL_ctr) \
613 SymI_HasProto(SLOW_CALL_v_ctr) \
614 SymI_HasProto(SLOW_CALL_f_ctr) \
615 SymI_HasProto(SLOW_CALL_d_ctr) \
616 SymI_HasProto(SLOW_CALL_l_ctr) \
617 SymI_HasProto(SLOW_CALL_n_ctr) \
618 SymI_HasProto(SLOW_CALL_p_ctr) \
619 SymI_HasProto(SLOW_CALL_pv_ctr) \
620 SymI_HasProto(SLOW_CALL_pp_ctr) \
621 SymI_HasProto(SLOW_CALL_ppv_ctr) \
622 SymI_HasProto(SLOW_CALL_ppp_ctr) \
623 SymI_HasProto(SLOW_CALL_pppv_ctr) \
624 SymI_HasProto(SLOW_CALL_pppp_ctr) \
625 SymI_HasProto(SLOW_CALL_ppppp_ctr) \
626 SymI_HasProto(SLOW_CALL_pppppp_ctr) \
627 SymI_HasProto(SLOW_CALL_OTHER_ctr) \
628 SymI_HasProto(ticky_slow_call_unevald) \
629 SymI_HasProto(SLOW_CALL_ctr) \
630 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
631 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
632 SymI_HasProto(KNOWN_CALL_ctr) \
633 SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
634 SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
635 SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
636 SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
637 SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
638 SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
639 SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
640 SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
641 SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
642 SymI_HasProto(UPDF_OMITTED_ctr) \
643 SymI_HasProto(UPDF_PUSHED_ctr) \
644 SymI_HasProto(CATCHF_PUSHED_ctr) \
645 SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
646 SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
647 SymI_HasProto(UPD_SQUEEZED_ctr) \
648 SymI_HasProto(UPD_CON_IN_NEW_ctr) \
649 SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
650 SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
651 SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
652 SymI_HasProto(ALLOC_HEAP_ctr) \
653 SymI_HasProto(ALLOC_HEAP_tot) \
654 SymI_HasProto(ALLOC_FUN_ctr) \
655 SymI_HasProto(ALLOC_FUN_adm) \
656 SymI_HasProto(ALLOC_FUN_gds) \
657 SymI_HasProto(ALLOC_FUN_slp) \
658 SymI_HasProto(UPD_NEW_IND_ctr) \
659 SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
660 SymI_HasProto(UPD_OLD_IND_ctr) \
661 SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
662 SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
663 SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
664 SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
665 SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
666 SymI_HasProto(GC_SEL_ABANDONED_ctr) \
667 SymI_HasProto(GC_SEL_MINOR_ctr) \
668 SymI_HasProto(GC_SEL_MAJOR_ctr) \
669 SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
670 SymI_HasProto(ALLOC_UP_THK_ctr) \
671 SymI_HasProto(ALLOC_SE_THK_ctr) \
672 SymI_HasProto(ALLOC_THK_adm) \
673 SymI_HasProto(ALLOC_THK_gds) \
674 SymI_HasProto(ALLOC_THK_slp) \
675 SymI_HasProto(ALLOC_CON_ctr) \
676 SymI_HasProto(ALLOC_CON_adm) \
677 SymI_HasProto(ALLOC_CON_gds) \
678 SymI_HasProto(ALLOC_CON_slp) \
679 SymI_HasProto(ALLOC_TUP_ctr) \
680 SymI_HasProto(ALLOC_TUP_adm) \
681 SymI_HasProto(ALLOC_TUP_gds) \
682 SymI_HasProto(ALLOC_TUP_slp) \
683 SymI_HasProto(ALLOC_BH_ctr) \
684 SymI_HasProto(ALLOC_BH_adm) \
685 SymI_HasProto(ALLOC_BH_gds) \
686 SymI_HasProto(ALLOC_BH_slp) \
687 SymI_HasProto(ALLOC_PRIM_ctr) \
688 SymI_HasProto(ALLOC_PRIM_adm) \
689 SymI_HasProto(ALLOC_PRIM_gds) \
690 SymI_HasProto(ALLOC_PRIM_slp) \
691 SymI_HasProto(ALLOC_PAP_ctr) \
692 SymI_HasProto(ALLOC_PAP_adm) \
693 SymI_HasProto(ALLOC_PAP_gds) \
694 SymI_HasProto(ALLOC_PAP_slp) \
695 SymI_HasProto(ALLOC_TSO_ctr) \
696 SymI_HasProto(ALLOC_TSO_adm) \
697 SymI_HasProto(ALLOC_TSO_gds) \
698 SymI_HasProto(ALLOC_TSO_slp) \
699 SymI_HasProto(RET_NEW_ctr) \
700 SymI_HasProto(RET_OLD_ctr) \
701 SymI_HasProto(RET_UNBOXED_TUP_ctr) \
702 SymI_HasProto(RET_SEMI_loads_avoided)
705 // On most platforms, the garbage collector rewrites references
706 // to small integer and char objects to a set of common, shared ones.
708 // We don't do this when compiling to Windows DLLs at the moment because
709 // it doesn't support cross package data references well.
711 #if defined(__PIC__) && defined(mingw32_HOST_OS)
712 #define RTS_INTCHAR_SYMBOLS
714 #define RTS_INTCHAR_SYMBOLS \
715 SymI_HasProto(stg_CHARLIKE_closure) \
716 SymI_HasProto(stg_INTLIKE_closure)
720 #define RTS_SYMBOLS \
723 SymI_HasProto(StgReturn) \
724 SymI_HasProto(stg_enter_info) \
725 SymI_HasProto(stg_gc_void_info) \
726 SymI_HasProto(__stg_gc_enter_1) \
727 SymI_HasProto(stg_gc_noregs) \
728 SymI_HasProto(stg_gc_unpt_r1_info) \
729 SymI_HasProto(stg_gc_unpt_r1) \
730 SymI_HasProto(stg_gc_unbx_r1_info) \
731 SymI_HasProto(stg_gc_unbx_r1) \
732 SymI_HasProto(stg_gc_f1_info) \
733 SymI_HasProto(stg_gc_f1) \
734 SymI_HasProto(stg_gc_d1_info) \
735 SymI_HasProto(stg_gc_d1) \
736 SymI_HasProto(stg_gc_l1_info) \
737 SymI_HasProto(stg_gc_l1) \
738 SymI_HasProto(__stg_gc_fun) \
739 SymI_HasProto(stg_gc_fun_info) \
740 SymI_HasProto(stg_gc_gen) \
741 SymI_HasProto(stg_gc_gen_info) \
742 SymI_HasProto(stg_gc_gen_hp) \
743 SymI_HasProto(stg_gc_ut) \
744 SymI_HasProto(stg_gen_yield) \
745 SymI_HasProto(stg_yield_noregs) \
746 SymI_HasProto(stg_yield_to_interpreter) \
747 SymI_HasProto(stg_gen_block) \
748 SymI_HasProto(stg_block_noregs) \
749 SymI_HasProto(stg_block_1) \
750 SymI_HasProto(stg_block_takemvar) \
751 SymI_HasProto(stg_block_putmvar) \
753 SymI_HasProto(MallocFailHook) \
754 SymI_HasProto(OnExitHook) \
755 SymI_HasProto(OutOfHeapHook) \
756 SymI_HasProto(StackOverflowHook) \
757 SymI_HasProto(addDLL) \
758 SymI_HasProto(__int_encodeDouble) \
759 SymI_HasProto(__word_encodeDouble) \
760 SymI_HasProto(__2Int_encodeDouble) \
761 SymI_HasProto(__int_encodeFloat) \
762 SymI_HasProto(__word_encodeFloat) \
763 SymI_HasProto(stg_atomicallyzh) \
764 SymI_HasProto(barf) \
765 SymI_HasProto(debugBelch) \
766 SymI_HasProto(errorBelch) \
767 SymI_HasProto(sysErrorBelch) \
768 SymI_HasProto(stg_getMaskingStatezh) \
769 SymI_HasProto(stg_maskAsyncExceptionszh) \
770 SymI_HasProto(stg_maskUninterruptiblezh) \
771 SymI_HasProto(stg_catchzh) \
772 SymI_HasProto(stg_catchRetryzh) \
773 SymI_HasProto(stg_catchSTMzh) \
774 SymI_HasProto(stg_checkzh) \
775 SymI_HasProto(closure_flags) \
776 SymI_HasProto(cmp_thread) \
777 SymI_HasProto(createAdjustor) \
778 SymI_HasProto(stg_decodeDoublezu2Intzh) \
779 SymI_HasProto(stg_decodeFloatzuIntzh) \
780 SymI_HasProto(defaultsHook) \
781 SymI_HasProto(stg_delayzh) \
782 SymI_HasProto(stg_deRefWeakzh) \
783 SymI_HasProto(stg_deRefStablePtrzh) \
784 SymI_HasProto(dirty_MUT_VAR) \
785 SymI_HasProto(stg_forkzh) \
786 SymI_HasProto(stg_forkOnzh) \
787 SymI_HasProto(forkProcess) \
788 SymI_HasProto(forkOS_createThread) \
789 SymI_HasProto(freeHaskellFunctionPtr) \
790 SymI_HasProto(getOrSetTypeableStore) \
791 SymI_HasProto(getOrSetGHCConcSignalSignalHandlerStore) \
792 SymI_HasProto(getOrSetGHCConcWindowsPendingDelaysStore) \
793 SymI_HasProto(getOrSetGHCConcWindowsIOManagerThreadStore) \
794 SymI_HasProto(getOrSetGHCConcWindowsProddingStore) \
795 SymI_HasProto(getOrSetSystemEventThreadEventManagerStore) \
796 SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore) \
797 SymI_HasProto(genSymZh) \
798 SymI_HasProto(genericRaise) \
799 SymI_HasProto(getProgArgv) \
800 SymI_HasProto(getFullProgArgv) \
801 SymI_HasProto(getStablePtr) \
802 SymI_HasProto(hs_init) \
803 SymI_HasProto(hs_exit) \
804 SymI_HasProto(hs_set_argv) \
805 SymI_HasProto(hs_add_root) \
806 SymI_HasProto(hs_perform_gc) \
807 SymI_HasProto(hs_free_stable_ptr) \
808 SymI_HasProto(hs_free_fun_ptr) \
809 SymI_HasProto(hs_hpc_rootModule) \
810 SymI_HasProto(hs_hpc_module) \
811 SymI_HasProto(initLinker) \
812 SymI_HasProto(stg_unpackClosurezh) \
813 SymI_HasProto(stg_getApStackValzh) \
814 SymI_HasProto(stg_getSparkzh) \
815 SymI_HasProto(stg_numSparkszh) \
816 SymI_HasProto(stg_isCurrentThreadBoundzh) \
817 SymI_HasProto(stg_isEmptyMVarzh) \
818 SymI_HasProto(stg_killThreadzh) \
819 SymI_HasProto(loadArchive) \
820 SymI_HasProto(loadObj) \
821 SymI_HasProto(insertStableSymbol) \
822 SymI_HasProto(insertSymbol) \
823 SymI_HasProto(lookupSymbol) \
824 SymI_HasProto(stg_makeStablePtrzh) \
825 SymI_HasProto(stg_mkApUpd0zh) \
826 SymI_HasProto(stg_myThreadIdzh) \
827 SymI_HasProto(stg_labelThreadzh) \
828 SymI_HasProto(stg_newArrayzh) \
829 SymI_HasProto(stg_newBCOzh) \
830 SymI_HasProto(stg_newByteArrayzh) \
831 SymI_HasProto_redirect(newCAF, newDynCAF) \
832 SymI_HasProto(stg_newMVarzh) \
833 SymI_HasProto(stg_newMutVarzh) \
834 SymI_HasProto(stg_newTVarzh) \
835 SymI_HasProto(stg_noDuplicatezh) \
836 SymI_HasProto(stg_atomicModifyMutVarzh) \
837 SymI_HasProto(stg_casMutVarzh) \
838 SymI_HasProto(stg_newPinnedByteArrayzh) \
839 SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
840 SymI_HasProto(newSpark) \
841 SymI_HasProto(performGC) \
842 SymI_HasProto(performMajorGC) \
843 SymI_HasProto(prog_argc) \
844 SymI_HasProto(prog_argv) \
845 SymI_HasProto(stg_putMVarzh) \
846 SymI_HasProto(stg_raisezh) \
847 SymI_HasProto(stg_raiseIOzh) \
848 SymI_HasProto(stg_readTVarzh) \
849 SymI_HasProto(stg_readTVarIOzh) \
850 SymI_HasProto(resumeThread) \
851 SymI_HasProto(resolveObjs) \
852 SymI_HasProto(stg_retryzh) \
853 SymI_HasProto(rts_apply) \
854 SymI_HasProto(rts_checkSchedStatus) \
855 SymI_HasProto(rts_eval) \
856 SymI_HasProto(rts_evalIO) \
857 SymI_HasProto(rts_evalLazyIO) \
858 SymI_HasProto(rts_evalStableIO) \
859 SymI_HasProto(rts_eval_) \
860 SymI_HasProto(rts_getBool) \
861 SymI_HasProto(rts_getChar) \
862 SymI_HasProto(rts_getDouble) \
863 SymI_HasProto(rts_getFloat) \
864 SymI_HasProto(rts_getInt) \
865 SymI_HasProto(rts_getInt8) \
866 SymI_HasProto(rts_getInt16) \
867 SymI_HasProto(rts_getInt32) \
868 SymI_HasProto(rts_getInt64) \
869 SymI_HasProto(rts_getPtr) \
870 SymI_HasProto(rts_getFunPtr) \
871 SymI_HasProto(rts_getStablePtr) \
872 SymI_HasProto(rts_getThreadId) \
873 SymI_HasProto(rts_getWord) \
874 SymI_HasProto(rts_getWord8) \
875 SymI_HasProto(rts_getWord16) \
876 SymI_HasProto(rts_getWord32) \
877 SymI_HasProto(rts_getWord64) \
878 SymI_HasProto(rts_lock) \
879 SymI_HasProto(rts_mkBool) \
880 SymI_HasProto(rts_mkChar) \
881 SymI_HasProto(rts_mkDouble) \
882 SymI_HasProto(rts_mkFloat) \
883 SymI_HasProto(rts_mkInt) \
884 SymI_HasProto(rts_mkInt8) \
885 SymI_HasProto(rts_mkInt16) \
886 SymI_HasProto(rts_mkInt32) \
887 SymI_HasProto(rts_mkInt64) \
888 SymI_HasProto(rts_mkPtr) \
889 SymI_HasProto(rts_mkFunPtr) \
890 SymI_HasProto(rts_mkStablePtr) \
891 SymI_HasProto(rts_mkString) \
892 SymI_HasProto(rts_mkWord) \
893 SymI_HasProto(rts_mkWord8) \
894 SymI_HasProto(rts_mkWord16) \
895 SymI_HasProto(rts_mkWord32) \
896 SymI_HasProto(rts_mkWord64) \
897 SymI_HasProto(rts_unlock) \
898 SymI_HasProto(rts_unsafeGetMyCapability) \
899 SymI_HasProto(rtsSupportsBoundThreads) \
900 SymI_HasProto(rts_isProfiled) \
901 SymI_HasProto(setProgArgv) \
902 SymI_HasProto(startupHaskell) \
903 SymI_HasProto(shutdownHaskell) \
904 SymI_HasProto(shutdownHaskellAndExit) \
905 SymI_HasProto(stable_ptr_table) \
906 SymI_HasProto(stackOverflow) \
907 SymI_HasProto(stg_CAF_BLACKHOLE_info) \
908 SymI_HasProto(stg_BLACKHOLE_info) \
909 SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
910 SymI_HasProto(stg_BLOCKING_QUEUE_CLEAN_info) \
911 SymI_HasProto(stg_BLOCKING_QUEUE_DIRTY_info) \
912 SymI_HasProto(startTimer) \
913 SymI_HasProto(stg_MVAR_CLEAN_info) \
914 SymI_HasProto(stg_MVAR_DIRTY_info) \
915 SymI_HasProto(stg_IND_STATIC_info) \
916 SymI_HasProto(stg_ARR_WORDS_info) \
917 SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
918 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
919 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
920 SymI_HasProto(stg_WEAK_info) \
921 SymI_HasProto(stg_ap_v_info) \
922 SymI_HasProto(stg_ap_f_info) \
923 SymI_HasProto(stg_ap_d_info) \
924 SymI_HasProto(stg_ap_l_info) \
925 SymI_HasProto(stg_ap_n_info) \
926 SymI_HasProto(stg_ap_p_info) \
927 SymI_HasProto(stg_ap_pv_info) \
928 SymI_HasProto(stg_ap_pp_info) \
929 SymI_HasProto(stg_ap_ppv_info) \
930 SymI_HasProto(stg_ap_ppp_info) \
931 SymI_HasProto(stg_ap_pppv_info) \
932 SymI_HasProto(stg_ap_pppp_info) \
933 SymI_HasProto(stg_ap_ppppp_info) \
934 SymI_HasProto(stg_ap_pppppp_info) \
935 SymI_HasProto(stg_ap_0_fast) \
936 SymI_HasProto(stg_ap_v_fast) \
937 SymI_HasProto(stg_ap_f_fast) \
938 SymI_HasProto(stg_ap_d_fast) \
939 SymI_HasProto(stg_ap_l_fast) \
940 SymI_HasProto(stg_ap_n_fast) \
941 SymI_HasProto(stg_ap_p_fast) \
942 SymI_HasProto(stg_ap_pv_fast) \
943 SymI_HasProto(stg_ap_pp_fast) \
944 SymI_HasProto(stg_ap_ppv_fast) \
945 SymI_HasProto(stg_ap_ppp_fast) \
946 SymI_HasProto(stg_ap_pppv_fast) \
947 SymI_HasProto(stg_ap_pppp_fast) \
948 SymI_HasProto(stg_ap_ppppp_fast) \
949 SymI_HasProto(stg_ap_pppppp_fast) \
950 SymI_HasProto(stg_ap_1_upd_info) \
951 SymI_HasProto(stg_ap_2_upd_info) \
952 SymI_HasProto(stg_ap_3_upd_info) \
953 SymI_HasProto(stg_ap_4_upd_info) \
954 SymI_HasProto(stg_ap_5_upd_info) \
955 SymI_HasProto(stg_ap_6_upd_info) \
956 SymI_HasProto(stg_ap_7_upd_info) \
957 SymI_HasProto(stg_exit) \
958 SymI_HasProto(stg_sel_0_upd_info) \
959 SymI_HasProto(stg_sel_10_upd_info) \
960 SymI_HasProto(stg_sel_11_upd_info) \
961 SymI_HasProto(stg_sel_12_upd_info) \
962 SymI_HasProto(stg_sel_13_upd_info) \
963 SymI_HasProto(stg_sel_14_upd_info) \
964 SymI_HasProto(stg_sel_15_upd_info) \
965 SymI_HasProto(stg_sel_1_upd_info) \
966 SymI_HasProto(stg_sel_2_upd_info) \
967 SymI_HasProto(stg_sel_3_upd_info) \
968 SymI_HasProto(stg_sel_4_upd_info) \
969 SymI_HasProto(stg_sel_5_upd_info) \
970 SymI_HasProto(stg_sel_6_upd_info) \
971 SymI_HasProto(stg_sel_7_upd_info) \
972 SymI_HasProto(stg_sel_8_upd_info) \
973 SymI_HasProto(stg_sel_9_upd_info) \
974 SymI_HasProto(stg_upd_frame_info) \
975 SymI_HasProto(stg_bh_upd_frame_info) \
976 SymI_HasProto(suspendThread) \
977 SymI_HasProto(stg_takeMVarzh) \
978 SymI_HasProto(stg_threadStatuszh) \
979 SymI_HasProto(stg_tryPutMVarzh) \
980 SymI_HasProto(stg_tryTakeMVarzh) \
981 SymI_HasProto(stg_unmaskAsyncExceptionszh) \
982 SymI_HasProto(unloadObj) \
983 SymI_HasProto(stg_unsafeThawArrayzh) \
984 SymI_HasProto(stg_waitReadzh) \
985 SymI_HasProto(stg_waitWritezh) \
986 SymI_HasProto(stg_writeTVarzh) \
987 SymI_HasProto(stg_yieldzh) \
988 SymI_NeedsProto(stg_interp_constr_entry) \
989 SymI_HasProto(stg_arg_bitmaps) \
990 SymI_HasProto(large_alloc_lim) \
992 SymI_HasProto(allocate) \
993 SymI_HasProto(allocateExec) \
994 SymI_HasProto(freeExec) \
995 SymI_HasProto(getAllocations) \
996 SymI_HasProto(revertCAFs) \
997 SymI_HasProto(RtsFlags) \
998 SymI_NeedsProto(rts_breakpoint_io_action) \
999 SymI_NeedsProto(rts_stop_next_breakpoint) \
1000 SymI_NeedsProto(rts_stop_on_exception) \
1001 SymI_HasProto(stopTimer) \
1002 SymI_HasProto(n_capabilities) \
1003 SymI_HasProto(stg_traceCcszh) \
1004 SymI_HasProto(stg_traceEventzh) \
1005 RTS_USER_SIGNALS_SYMBOLS \
1009 // 64-bit support functions in libgcc.a
1010 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
1011 #define RTS_LIBGCC_SYMBOLS \
1012 SymI_NeedsProto(__divdi3) \
1013 SymI_NeedsProto(__udivdi3) \
1014 SymI_NeedsProto(__moddi3) \
1015 SymI_NeedsProto(__umoddi3) \
1016 SymI_NeedsProto(__muldi3) \
1017 SymI_NeedsProto(__ashldi3) \
1018 SymI_NeedsProto(__ashrdi3) \
1019 SymI_NeedsProto(__lshrdi3)
1021 #define RTS_LIBGCC_SYMBOLS
1024 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
1025 // Symbols that don't have a leading underscore
1026 // on Mac OS X. They have to receive special treatment,
1027 // see machoInitSymbolsWithoutUnderscore()
1028 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
1029 SymI_NeedsProto(saveFP) \
1030 SymI_NeedsProto(restFP)
1033 /* entirely bogus claims about types of these symbols */
1034 #define SymI_NeedsProto(vvv) extern void vvv(void);
1035 #if defined(__PIC__) && defined(mingw32_HOST_OS)
1036 #define SymE_HasProto(vvv) SymE_HasProto(vvv);
1037 #define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
1039 #define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
1040 #define SymE_HasProto(vvv) SymI_HasProto(vvv)
1042 #define SymI_HasProto(vvv) /**/
1043 #define SymI_HasProto_redirect(vvv,xxx) /**/
1046 RTS_POSIX_ONLY_SYMBOLS
1047 RTS_MINGW_ONLY_SYMBOLS
1048 RTS_CYGWIN_ONLY_SYMBOLS
1049 RTS_DARWIN_ONLY_SYMBOLS
1052 #undef SymI_NeedsProto
1053 #undef SymI_HasProto
1054 #undef SymI_HasProto_redirect
1055 #undef SymE_HasProto
1056 #undef SymE_NeedsProto
1058 #ifdef LEADING_UNDERSCORE
1059 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
1061 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
1064 #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1066 #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1067 (void*)DLL_IMPORT_DATA_REF(vvv) },
1069 #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
1070 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
1072 // SymI_HasProto_redirect allows us to redirect references to one symbol to
1073 // another symbol. See newCAF/newDynCAF for an example.
1074 #define SymI_HasProto_redirect(vvv,xxx) \
1075 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1078 static RtsSymbolVal rtsSyms[] = {
1081 RTS_POSIX_ONLY_SYMBOLS
1082 RTS_MINGW_ONLY_SYMBOLS
1083 RTS_CYGWIN_ONLY_SYMBOLS
1084 RTS_DARWIN_ONLY_SYMBOLS
1087 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
1088 // dyld stub code contains references to this,
1089 // but it should never be called because we treat
1090 // lazy pointers as nonlazy.
1091 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
1093 { 0, 0 } /* sentinel */
1098 /* -----------------------------------------------------------------------------
1099 * Insert symbols into hash tables, checking for duplicates.
1102 static void ghciInsertStrHashTable ( char* obj_name,
1108 if (lookupHashTable(table, (StgWord)key) == NULL)
1110 insertStrHashTable(table, (StgWord)key, data);
1115 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
1117 "whilst processing object file\n"
1119 "This could be caused by:\n"
1120 " * Loading two different object files which export the same symbol\n"
1121 " * Specifying the same object file twice on the GHCi command line\n"
1122 " * An incorrect `package.conf' entry, causing some object to be\n"
1124 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
1131 /* -----------------------------------------------------------------------------
1132 * initialize the object linker
1136 static int linker_init_done = 0 ;
1138 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1139 static void *dl_prog_handle;
1140 static regex_t re_invalid;
1141 static regex_t re_realso;
1143 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
1151 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1155 IF_DEBUG(linker, debugBelch("initLinker: start\n"));
1157 /* Make initLinker idempotent, so we can call it
1158 before evey relevant operation; that means we
1159 don't need to initialise the linker separately */
1160 if (linker_init_done == 1) {
1161 IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
1164 linker_init_done = 1;
1167 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
1168 initMutex(&dl_mutex);
1170 stablehash = allocStrHashTable();
1171 symhash = allocStrHashTable();
1173 /* populate the symbol table with stuff from the RTS */
1174 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1175 ghciInsertStrHashTable("(GHCi built-in symbols)",
1176 symhash, sym->lbl, sym->addr);
1177 IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
1179 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1180 machoInitSymbolsWithoutUnderscore();
1183 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1184 # if defined(RTLD_DEFAULT)
1185 dl_prog_handle = RTLD_DEFAULT;
1187 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1188 # endif /* RTLD_DEFAULT */
1190 compileResult = regcomp(&re_invalid,
1191 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)",
1193 ASSERT( compileResult == 0 );
1194 compileResult = regcomp(&re_realso,
1195 "(GROUP|INPUT) *\\( *(([^ )])+)",
1197 ASSERT( compileResult == 0 );
1200 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1201 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1202 // User-override for mmap_32bit_base
1203 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1207 #if defined(mingw32_HOST_OS)
1209 * These two libraries cause problems when added to the static link,
1210 * but are necessary for resolving symbols in GHCi, hence we load
1211 * them manually here.
1217 IF_DEBUG(linker, debugBelch("initLinker: done\n"));
1222 exitLinker( void ) {
1223 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1224 if (linker_init_done == 1) {
1225 regfree(&re_invalid);
1226 regfree(&re_realso);
1228 closeMutex(&dl_mutex);
1234 /* -----------------------------------------------------------------------------
1235 * Loading DLL or .so dynamic libraries
1236 * -----------------------------------------------------------------------------
1238 * Add a DLL from which symbols may be found. In the ELF case, just
1239 * do RTLD_GLOBAL-style add, so no further messing around needs to
1240 * happen in order that symbols in the loaded .so are findable --
1241 * lookupSymbol() will subsequently see them by dlsym on the program's
1242 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1244 * In the PEi386 case, open the DLLs and put handles to them in a
1245 * linked list. When looking for a symbol, try all handles in the
1246 * list. This means that we need to load even DLLs that are guaranteed
1247 * to be in the ghc.exe image already, just so we can get a handle
1248 * to give to loadSymbol, so that we can find the symbols. For such
1249 * libraries, the LoadLibrary call should be a no-op except for returning
1254 #if defined(OBJFORMAT_PEi386)
1255 /* A record for storing handles into DLLs. */
1260 struct _OpenedDLL* next;
1265 /* A list thereof. */
1266 static OpenedDLL* opened_dlls = NULL;
1269 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1272 internal_dlopen(const char *dll_name)
1278 // omitted: RTLD_NOW
1279 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1281 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1283 //-------------- Begin critical section ------------------
1284 // This critical section is necessary because dlerror() is not
1285 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1286 // Also, the error message returned must be copied to preserve it
1289 ACQUIRE_LOCK(&dl_mutex);
1290 hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1294 /* dlopen failed; return a ptr to the error msg. */
1296 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1297 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1298 strcpy(errmsg_copy, errmsg);
1299 errmsg = errmsg_copy;
1301 RELEASE_LOCK(&dl_mutex);
1302 //--------------- End critical section -------------------
1309 addDLL( char *dll_name )
1311 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1312 /* ------------------- ELF DLL loader ------------------- */
1315 regmatch_t match[NMATCH];
1318 size_t match_length;
1319 #define MAXLINE 1000
1325 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1326 errmsg = internal_dlopen(dll_name);
1328 if (errmsg == NULL) {
1332 // GHC Trac ticket #2615
1333 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1334 // contain linker scripts rather than ELF-format object code. This
1335 // code handles the situation by recognizing the real object code
1336 // file name given in the linker script.
1338 // If an "invalid ELF header" error occurs, it is assumed that the
1339 // .so file contains a linker script instead of ELF object code.
1340 // In this case, the code looks for the GROUP ( ... ) linker
1341 // directive. If one is found, the first file name inside the
1342 // parentheses is treated as the name of a dynamic library and the
1343 // code attempts to dlopen that file. If this is also unsuccessful,
1344 // an error message is returned.
1346 // see if the error message is due to an invalid ELF header
1347 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1348 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1349 IF_DEBUG(linker, debugBelch("result = %i\n", result));
1351 // success -- try to read the named file as a linker script
1352 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1354 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
1355 line[match_length] = '\0'; // make sure string is null-terminated
1356 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
1357 if ((fp = fopen(line, "r")) == NULL) {
1358 return errmsg; // return original error if open fails
1360 // try to find a GROUP ( ... ) command
1361 while (fgets(line, MAXLINE, fp) != NULL) {
1362 IF_DEBUG(linker, debugBelch("input line = %s", line));
1363 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
1364 // success -- try to dlopen the first named file
1365 IF_DEBUG(linker, debugBelch("match%s\n",""));
1366 line[match[2].rm_eo] = '\0';
1367 errmsg = internal_dlopen(line+match[2].rm_so);
1370 // if control reaches here, no GROUP ( ... ) directive was found
1371 // and the original error message is returned to the caller
1377 # elif defined(OBJFORMAT_PEi386)
1378 /* ------------------- Win32 DLL loader ------------------- */
1386 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1388 /* See if we've already got it, and ignore if so. */
1389 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1390 if (0 == strcmp(o_dll->name, dll_name))
1394 /* The file name has no suffix (yet) so that we can try
1395 both foo.dll and foo.drv
1397 The documentation for LoadLibrary says:
1398 If no file name extension is specified in the lpFileName
1399 parameter, the default library extension .dll is
1400 appended. However, the file name string can include a trailing
1401 point character (.) to indicate that the module name has no
1404 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1405 sprintf(buf, "%s.DLL", dll_name);
1406 instance = LoadLibrary(buf);
1407 if (instance == NULL) {
1408 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1409 // KAA: allow loading of drivers (like winspool.drv)
1410 sprintf(buf, "%s.DRV", dll_name);
1411 instance = LoadLibrary(buf);
1412 if (instance == NULL) {
1413 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1414 // #1883: allow loading of unix-style libfoo.dll DLLs
1415 sprintf(buf, "lib%s.DLL", dll_name);
1416 instance = LoadLibrary(buf);
1417 if (instance == NULL) {
1424 /* Add this DLL to the list of DLLs in which to search for symbols. */
1425 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1426 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1427 strcpy(o_dll->name, dll_name);
1428 o_dll->instance = instance;
1429 o_dll->next = opened_dlls;
1430 opened_dlls = o_dll;
1436 sysErrorBelch(dll_name);
1438 /* LoadLibrary failed; return a ptr to the error msg. */
1439 return "addDLL: could not load DLL";
1442 barf("addDLL: not implemented on this platform");
1446 /* -----------------------------------------------------------------------------
1447 * insert a stable symbol in the hash table
1451 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1453 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1457 /* -----------------------------------------------------------------------------
1458 * insert a symbol in the hash table
1461 insertSymbol(char* obj_name, char* key, void* data)
1463 ghciInsertStrHashTable(obj_name, symhash, key, data);
1466 /* -----------------------------------------------------------------------------
1467 * lookup a symbol in the hash table
1470 lookupSymbol( char *lbl )
1473 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s\n", lbl));
1475 ASSERT(symhash != NULL);
1476 val = lookupStrHashTable(symhash, lbl);
1479 IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
1480 # if defined(OBJFORMAT_ELF)
1481 return dlsym(dl_prog_handle, lbl);
1482 # elif defined(OBJFORMAT_MACHO)
1484 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1487 HACK: On OS X, global symbols are prefixed with an underscore.
1488 However, dlsym wants us to omit the leading underscore from the
1489 symbol name. For now, we simply strip it off here (and ONLY
1492 IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
1493 ASSERT(lbl[0] == '_');
1494 return dlsym(dl_prog_handle, lbl+1);
1496 if(NSIsSymbolNameDefined(lbl)) {
1497 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1498 return NSAddressOfSymbol(symbol);
1502 # endif /* HAVE_DLFCN_H */
1503 # elif defined(OBJFORMAT_PEi386)
1506 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1507 if (sym != NULL) { return sym; };
1509 // Also try looking up the symbol without the @N suffix. Some
1510 // DLLs have the suffixes on their symbols, some don't.
1511 zapTrailingAtSign ( (unsigned char*)lbl );
1512 sym = lookupSymbolInDLLs((unsigned char*)lbl);
1513 if (sym != NULL) { return sym; };
1521 IF_DEBUG(linker, debugBelch("lookupSymbol: value of %s is %p\n", lbl, val));
1526 /* -----------------------------------------------------------------------------
1527 * Debugging aid: look in GHCi's object symbol tables for symbols
1528 * within DELTA bytes of the specified address, and show their names.
1531 void ghci_enquire ( char* addr );
1533 void ghci_enquire ( char* addr )
1538 const int DELTA = 64;
1543 for (oc = objects; oc; oc = oc->next) {
1544 for (i = 0; i < oc->n_symbols; i++) {
1545 sym = oc->symbols[i];
1546 if (sym == NULL) continue;
1549 a = lookupStrHashTable(symhash, sym);
1552 // debugBelch("ghci_enquire: can't find %s\n", sym);
1554 else if (addr-DELTA <= a && a <= addr+DELTA) {
1555 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1563 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1566 mmapForLinker (size_t bytes, nat flags, int fd)
1568 void *map_addr = NULL;
1571 static nat fixed = 0;
1573 IF_DEBUG(linker, debugBelch("mmapForLinker: start\n"));
1574 pagesize = getpagesize();
1575 size = ROUND_UP(bytes, pagesize);
1577 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1580 if (mmap_32bit_base != 0) {
1581 map_addr = mmap_32bit_base;
1585 IF_DEBUG(linker, debugBelch("mmapForLinker: \tprotection %#0x\n", PROT_EXEC | PROT_READ | PROT_WRITE));
1586 IF_DEBUG(linker, debugBelch("mmapForLinker: \tflags %#0x\n", MAP_PRIVATE | TRY_MAP_32BIT | fixed | flags));
1587 result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
1588 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
1590 if (result == MAP_FAILED) {
1591 sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
1592 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1593 stg_exit(EXIT_FAILURE);
1596 #if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
1597 if (mmap_32bit_base != 0) {
1598 if (result == map_addr) {
1599 mmap_32bit_base = (StgWord8*)map_addr + size;
1601 if ((W_)result > 0x80000000) {
1602 // oops, we were given memory over 2Gb
1603 #if defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS)
1604 // Some platforms require MAP_FIXED. This is normally
1605 // a bad idea, because MAP_FIXED will overwrite
1606 // existing mappings.
1607 munmap(result,size);
1611 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);
1614 // hmm, we were given memory somewhere else, but it's
1615 // still under 2Gb so we can use it. Next time, ask
1616 // for memory right after the place we just got some
1617 mmap_32bit_base = (StgWord8*)result + size;
1621 if ((W_)result > 0x80000000) {
1622 // oops, we were given memory over 2Gb
1623 // ... try allocating memory somewhere else?;
1624 debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
1625 munmap(result, size);
1627 // Set a base address and try again... (guess: 1Gb)
1628 mmap_32bit_base = (void*)0x40000000;
1634 IF_DEBUG(linker, debugBelch("mmapForLinker: mapped %lu bytes starting at %p\n", (lnat)size, result));
1635 IF_DEBUG(linker, debugBelch("mmapForLinker: done\n"));
1641 mkOc( char *path, char *image, int imageSize,
1642 char *archiveMemberName
1644 #ifdef darwin_HOST_OS
1651 IF_DEBUG(linker, debugBelch("mkOc: start\n"));
1652 oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
1654 # if defined(OBJFORMAT_ELF)
1655 oc->formatName = "ELF";
1656 # elif defined(OBJFORMAT_PEi386)
1657 oc->formatName = "PEi386";
1658 # elif defined(OBJFORMAT_MACHO)
1659 oc->formatName = "Mach-O";
1662 barf("loadObj: not implemented on this platform");
1666 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1667 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1668 strcpy(oc->fileName, path);
1670 if (archiveMemberName) {
1671 oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
1672 strcpy(oc->archiveMemberName, archiveMemberName);
1675 oc->archiveMemberName = NULL;
1678 oc->fileSize = imageSize;
1680 oc->sections = NULL;
1681 oc->proddables = NULL;
1684 #ifdef darwin_HOST_OS
1685 oc->misalignment = misalignment;
1689 /* chain it onto the list of objects */
1693 IF_DEBUG(linker, debugBelch("mkOc: done\n"));
1698 loadArchive( char *path )
1705 size_t thisFileNameSize;
1707 size_t fileNameSize;
1708 int isObject, isGnuIndex;
1711 int gnuFileIndexSize;
1712 #if defined(darwin_HOST_OS)
1714 uint32_t nfat_arch, nfat_offset, cputype, cpusubtype;
1715 #if defined(i386_HOST_ARCH)
1716 const uint32_t mycputype = CPU_TYPE_X86;
1717 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_ALL;
1718 #elif defined(x86_64_HOST_ARCH)
1719 const uint32_t mycputype = CPU_TYPE_X86_64;
1720 const uint32_t mycpusubtype = CPU_SUBTYPE_X86_64_ALL;
1721 #elif defined(powerpc_HOST_ARCH)
1722 const uint32_t mycputype = CPU_TYPE_POWERPC;
1723 const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
1724 #elif defined(powerpc64_HOST_ARCH)
1725 const uint32_t mycputype = CPU_TYPE_POWERPC64;
1726 const uint32_t mycpusubtype = CPU_SUBTYPE_POWERPC_ALL;
1728 #error Unknown Darwin architecture
1730 #if !defined(USE_MMAP)
1735 IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
1736 IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
1738 gnuFileIndex = NULL;
1739 gnuFileIndexSize = 0;
1742 fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
1744 f = fopen(path, "rb");
1746 barf("loadObj: can't read `%s'", path);
1748 /* Check if this is an archive by looking for the magic "!<arch>\n"
1749 * string. Usually, if this fails, we barf and quit. On Darwin however,
1750 * we may have a fat archive, which contains archives for more than
1751 * one architecture. Fat archives start with the magic number 0xcafebabe,
1752 * always stored big endian. If we find a fat_header, we scan through
1753 * the fat_arch structs, searching through for one for our host
1754 * architecture. If a matching struct is found, we read the offset
1755 * of our archive data (nfat_offset) and seek forward nfat_offset bytes
1756 * from the start of the file.
1758 * A subtlety is that all of the members of the fat_header and fat_arch
1759 * structs are stored big endian, so we need to call byte order
1760 * conversion functions.
1762 * If we find the appropriate architecture in a fat archive, we gobble
1763 * its magic "!<arch>\n" string and continue processing just as if
1764 * we had a single architecture archive.
1767 n = fread ( tmp, 1, 8, f );
1769 barf("loadArchive: Failed reading header from `%s'", path);
1770 if (strncmp(tmp, "!<arch>\n", 8) != 0) {
1772 #if defined(darwin_HOST_OS)
1773 /* Not a standard archive, look for a fat archive magic number: */
1774 if (ntohl(*(uint32_t *)tmp) == FAT_MAGIC) {
1775 nfat_arch = ntohl(*(uint32_t *)(tmp + 4));
1776 IF_DEBUG(linker, debugBelch("loadArchive: found a fat archive containing %d architectures\n", nfat_arch));
1779 for (i = 0; i < (int)nfat_arch; i++) {
1780 /* search for the right arch */
1781 n = fread( tmp, 1, 20, f );
1783 barf("loadArchive: Failed reading arch from `%s'", path);
1784 cputype = ntohl(*(uint32_t *)tmp);
1785 cpusubtype = ntohl(*(uint32_t *)(tmp + 4));
1787 if (cputype == mycputype && cpusubtype == mycpusubtype) {
1788 IF_DEBUG(linker, debugBelch("loadArchive: found my archive in a fat archive\n"));
1789 nfat_offset = ntohl(*(uint32_t *)(tmp + 8));
1794 if (nfat_offset == 0) {
1795 barf ("loadArchive: searched %d architectures, but no host arch found", (int)nfat_arch);
1798 n = fseek( f, nfat_offset, SEEK_SET );
1800 barf("loadArchive: Failed to seek to arch in `%s'", path);
1801 n = fread ( tmp, 1, 8, f );
1803 barf("loadArchive: Failed reading header from `%s'", path);
1804 if (strncmp(tmp, "!<arch>\n", 8) != 0) {
1805 barf("loadArchive: couldn't find archive in `%s' at offset %d", path, nfat_offset);
1810 barf("loadArchive: Neither an archive, nor a fat archive: `%s'", path);
1814 barf("loadArchive: Not an archive: `%s'", path);
1818 IF_DEBUG(linker, debugBelch("loadArchive: loading archive contents\n"));
1821 n = fread ( fileName, 1, 16, f );
1824 IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%s'\n", path));
1828 barf("loadArchive: Failed reading file name from `%s'", path);
1832 #if defined(darwin_HOST_OS)
1833 if (strncmp(fileName, "!<arch>\n", 8) == 0) {
1834 IF_DEBUG(linker, debugBelch("loadArchive: found the start of another archive, breaking\n"));
1839 n = fread ( tmp, 1, 12, f );
1841 barf("loadArchive: Failed reading mod time from `%s'", path);
1842 n = fread ( tmp, 1, 6, f );
1844 barf("loadArchive: Failed reading owner from `%s'", path);
1845 n = fread ( tmp, 1, 6, f );
1847 barf("loadArchive: Failed reading group from `%s'", path);
1848 n = fread ( tmp, 1, 8, f );
1850 barf("loadArchive: Failed reading mode from `%s'", path);
1851 n = fread ( tmp, 1, 10, f );
1853 barf("loadArchive: Failed reading size from `%s'", path);
1855 for (n = 0; isdigit(tmp[n]); n++);
1857 memberSize = atoi(tmp);
1859 IF_DEBUG(linker, debugBelch("loadArchive: size of this archive member is %d\n", memberSize));
1860 n = fread ( tmp, 1, 2, f );
1862 barf("loadArchive: Failed reading magic from `%s'", path);
1863 if (strncmp(tmp, "\x60\x0A", 2) != 0)
1864 barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c",
1865 path, ftell(f), tmp[0], tmp[1]);
1868 /* Check for BSD-variant large filenames */
1869 if (0 == strncmp(fileName, "#1/", 3)) {
1870 fileName[16] = '\0';
1871 if (isdigit(fileName[3])) {
1872 for (n = 4; isdigit(fileName[n]); n++);
1874 thisFileNameSize = atoi(fileName + 3);
1875 memberSize -= thisFileNameSize;
1876 if (thisFileNameSize >= fileNameSize) {
1877 /* Double it to avoid potentially continually
1878 increasing it by 1 */
1879 fileNameSize = thisFileNameSize * 2;
1880 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1882 n = fread ( fileName, 1, thisFileNameSize, f );
1883 if (n != (int)thisFileNameSize) {
1884 barf("loadArchive: Failed reading filename from `%s'",
1887 fileName[thisFileNameSize] = 0;
1889 /* On OS X at least, thisFileNameSize is the size of the
1890 fileName field, not the length of the fileName
1892 thisFileNameSize = strlen(fileName);
1895 barf("loadArchive: BSD-variant filename size not found while reading filename from `%s'", path);
1898 /* Check for GNU file index file */
1899 else if (0 == strncmp(fileName, "//", 2)) {
1901 thisFileNameSize = 0;
1904 /* Check for a file in the GNU file index */
1905 else if (fileName[0] == '/') {
1906 if (isdigit(fileName[1])) {
1909 for (n = 2; isdigit(fileName[n]); n++);
1911 n = atoi(fileName + 1);
1913 if (gnuFileIndex == NULL) {
1914 barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
1916 if (n < 0 || n > gnuFileIndexSize) {
1917 barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
1919 if (n != 0 && gnuFileIndex[n - 1] != '\n') {
1920 barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
1922 for (i = n; gnuFileIndex[i] != '/'; i++);
1923 thisFileNameSize = i - n;
1924 if (thisFileNameSize >= fileNameSize) {
1925 /* Double it to avoid potentially continually
1926 increasing it by 1 */
1927 fileNameSize = thisFileNameSize * 2;
1928 fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
1930 memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
1931 fileName[thisFileNameSize] = '\0';
1933 else if (fileName[1] == ' ') {
1935 thisFileNameSize = 0;
1938 barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
1941 /* Finally, the case where the filename field actually contains
1944 /* GNU ar terminates filenames with a '/', this allowing
1945 spaces in filenames. So first look to see if there is a
1947 for (thisFileNameSize = 0;
1948 thisFileNameSize < 16;
1949 thisFileNameSize++) {
1950 if (fileName[thisFileNameSize] == '/') {
1951 fileName[thisFileNameSize] = '\0';
1955 /* If we didn't find a '/', then a space teminates the
1956 filename. Note that if we don't find one, then
1957 thisFileNameSize ends up as 16, and we already have the
1959 if (thisFileNameSize == 16) {
1960 for (thisFileNameSize = 0;
1961 thisFileNameSize < 16;
1962 thisFileNameSize++) {
1963 if (fileName[thisFileNameSize] == ' ') {
1964 fileName[thisFileNameSize] = '\0';
1972 debugBelch("loadArchive: Found member file `%s'\n", fileName));
1974 isObject = thisFileNameSize >= 2
1975 && fileName[thisFileNameSize - 2] == '.'
1976 && fileName[thisFileNameSize - 1] == 'o';
1978 IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
1979 IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
1982 char *archiveMemberName;
1984 IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
1986 /* We can't mmap from the archive directly, as object
1987 files need to be 8-byte aligned but files in .ar
1988 archives are 2-byte aligned. When possible we use mmap
1989 to get some anonymous memory, as on 64-bit platforms if
1990 we use malloc then we can be given memory above 2^32.
1991 In the mmap case we're probably wasting lots of space;
1992 we could do better. */
1993 #if defined(USE_MMAP)
1994 image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
1995 #elif defined(darwin_HOST_OS)
1997 misalignment = machoGetMisalignment(f);
1998 image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
1999 image += misalignment;
2001 image = stgMallocBytes(memberSize, "loadArchive(image)");
2003 n = fread ( image, 1, memberSize, f );
2004 if (n != memberSize) {
2005 barf("loadArchive: error whilst reading `%s'", path);
2008 archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
2009 "loadArchive(file)");
2010 sprintf(archiveMemberName, "%s(%.*s)",
2011 path, (int)thisFileNameSize, fileName);
2013 oc = mkOc(path, image, memberSize, archiveMemberName
2015 #ifdef darwin_HOST_OS
2021 stgFree(archiveMemberName);
2023 if (0 == loadOc(oc)) {
2028 else if (isGnuIndex) {
2029 if (gnuFileIndex != NULL) {
2030 barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
2032 IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
2034 gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
2036 gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
2038 n = fread ( gnuFileIndex, 1, memberSize, f );
2039 if (n != memberSize) {
2040 barf("loadArchive: error whilst reading `%s'", path);
2042 gnuFileIndex[memberSize] = '/';
2043 gnuFileIndexSize = memberSize;
2046 IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
2047 n = fseek(f, memberSize, SEEK_CUR);
2049 barf("loadArchive: error whilst seeking by %d in `%s'",
2053 /* .ar files are 2-byte aligned */
2054 if (memberSize % 2) {
2055 IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
2056 n = fread ( tmp, 1, 1, f );
2059 IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
2063 barf("loadArchive: Failed reading padding from `%s'", path);
2066 IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
2068 IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
2074 if (gnuFileIndex != NULL) {
2076 munmap(gnuFileIndex, gnuFileIndexSize + 1);
2078 stgFree(gnuFileIndex);
2082 IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
2086 /* -----------------------------------------------------------------------------
2087 * Load an obj (populate the global symbol table, but don't resolve yet)
2089 * Returns: 1 if ok, 0 on error.
2092 loadObj( char *path )
2103 # if defined(darwin_HOST_OS)
2107 IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
2111 /* debugBelch("loadObj %s\n", path ); */
2113 /* Check that we haven't already loaded this object.
2114 Ignore requests to load multiple times */
2118 for (o = objects; o; o = o->next) {
2119 if (0 == strcmp(o->fileName, path)) {
2121 break; /* don't need to search further */
2125 IF_DEBUG(linker, debugBelch(
2126 "GHCi runtime linker: warning: looks like you're trying to load the\n"
2127 "same object file twice:\n"
2129 "GHCi will ignore this, but be warned.\n"
2131 return 1; /* success */
2135 r = stat(path, &st);
2137 IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
2141 fileSize = st.st_size;
2144 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
2146 #if defined(openbsd_HOST_OS)
2147 fd = open(path, O_RDONLY, S_IRUSR);
2149 fd = open(path, O_RDONLY);
2152 barf("loadObj: can't open `%s'", path);
2154 image = mmapForLinker(fileSize, 0, fd);
2158 #else /* !USE_MMAP */
2159 /* load the image into memory */
2160 f = fopen(path, "rb");
2162 barf("loadObj: can't read `%s'", path);
2164 # if defined(mingw32_HOST_OS)
2165 // TODO: We would like to use allocateExec here, but allocateExec
2166 // cannot currently allocate blocks large enough.
2167 image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
2168 PAGE_EXECUTE_READWRITE);
2169 # elif defined(darwin_HOST_OS)
2170 // In a Mach-O .o file, all sections can and will be misaligned
2171 // if the total size of the headers is not a multiple of the
2172 // desired alignment. This is fine for .o files that only serve
2173 // as input for the static linker, but it's not fine for us,
2174 // as SSE (used by gcc for floating point) and Altivec require
2175 // 16-byte alignment.
2176 // We calculate the correct alignment from the header before
2177 // reading the file, and then we misalign image on purpose so
2178 // that the actual sections end up aligned again.
2179 misalignment = machoGetMisalignment(f);
2180 image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
2181 image += misalignment;
2183 image = stgMallocBytes(fileSize, "loadObj(image)");
2188 n = fread ( image, 1, fileSize, f );
2190 barf("loadObj: error whilst reading `%s'", path);
2193 #endif /* USE_MMAP */
2195 oc = mkOc(path, image, fileSize, NULL
2197 #ifdef darwin_HOST_OS
2207 loadOc( ObjectCode* oc ) {
2210 IF_DEBUG(linker, debugBelch("loadOc: start\n"));
2212 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
2213 r = ocAllocateSymbolExtras_MachO ( oc );
2215 IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_MachO failed\n"));
2218 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
2219 r = ocAllocateSymbolExtras_ELF ( oc );
2221 IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
2226 /* verify the in-memory image */
2227 # if defined(OBJFORMAT_ELF)
2228 r = ocVerifyImage_ELF ( oc );
2229 # elif defined(OBJFORMAT_PEi386)
2230 r = ocVerifyImage_PEi386 ( oc );
2231 # elif defined(OBJFORMAT_MACHO)
2232 r = ocVerifyImage_MachO ( oc );
2234 barf("loadObj: no verify method");
2237 IF_DEBUG(linker, debugBelch("loadOc: ocVerifyImage_* failed\n"));
2241 /* build the symbol list for this image */
2242 # if defined(OBJFORMAT_ELF)
2243 r = ocGetNames_ELF ( oc );
2244 # elif defined(OBJFORMAT_PEi386)
2245 r = ocGetNames_PEi386 ( oc );
2246 # elif defined(OBJFORMAT_MACHO)
2247 r = ocGetNames_MachO ( oc );
2249 barf("loadObj: no getNames method");
2252 IF_DEBUG(linker, debugBelch("loadOc: ocGetNames_* failed\n"));
2256 /* loaded, but not resolved yet */
2257 oc->status = OBJECT_LOADED;
2258 IF_DEBUG(linker, debugBelch("loadOc: done.\n"));
2263 /* -----------------------------------------------------------------------------
2264 * resolve all the currently unlinked objects in memory
2266 * Returns: 1 if ok, 0 on error.
2274 IF_DEBUG(linker, debugBelch("resolveObjs: start\n"));
2277 for (oc = objects; oc; oc = oc->next) {
2278 if (oc->status != OBJECT_RESOLVED) {
2279 # if defined(OBJFORMAT_ELF)
2280 r = ocResolve_ELF ( oc );
2281 # elif defined(OBJFORMAT_PEi386)
2282 r = ocResolve_PEi386 ( oc );
2283 # elif defined(OBJFORMAT_MACHO)
2284 r = ocResolve_MachO ( oc );
2286 barf("resolveObjs: not implemented on this platform");
2288 if (!r) { return r; }
2289 oc->status = OBJECT_RESOLVED;
2292 IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
2296 /* -----------------------------------------------------------------------------
2297 * delete an object from the pool
2300 unloadObj( char *path )
2302 ObjectCode *oc, *prev;
2303 HsBool unloadedAnyObj = HS_BOOL_FALSE;
2305 ASSERT(symhash != NULL);
2306 ASSERT(objects != NULL);
2311 for (oc = objects; oc; prev = oc, oc = oc->next) {
2312 if (!strcmp(oc->fileName,path)) {
2314 /* Remove all the mappings for the symbols within this
2319 for (i = 0; i < oc->n_symbols; i++) {
2320 if (oc->symbols[i] != NULL) {
2321 removeStrHashTable(symhash, oc->symbols[i], NULL);
2329 prev->next = oc->next;
2332 // We're going to leave this in place, in case there are
2333 // any pointers from the heap into it:
2334 // #ifdef mingw32_HOST_OS
2335 // VirtualFree(oc->image);
2337 // stgFree(oc->image);
2339 stgFree(oc->fileName);
2340 stgFree(oc->archiveMemberName);
2341 stgFree(oc->symbols);
2342 stgFree(oc->sections);
2345 /* This could be a member of an archive so continue
2346 * unloading other members. */
2347 unloadedAnyObj = HS_BOOL_TRUE;
2351 if (unloadedAnyObj) {
2355 errorBelch("unloadObj: can't find `%s' to unload", path);
2360 /* -----------------------------------------------------------------------------
2361 * Sanity checking. For each ObjectCode, maintain a list of address ranges
2362 * which may be prodded during relocation, and abort if we try and write
2363 * outside any of these.
2366 addProddableBlock ( ObjectCode* oc, void* start, int size )
2369 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
2371 IF_DEBUG(linker, debugBelch("addProddableBlock: %p %p %d\n", oc, start, size));
2375 pb->next = oc->proddables;
2376 oc->proddables = pb;
2380 checkProddableBlock (ObjectCode *oc, void *addr )
2384 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
2385 char* s = (char*)(pb->start);
2386 char* e = s + pb->size - 1;
2387 char* a = (char*)addr;
2388 /* Assumes that the biggest fixup involves a 4-byte write. This
2389 probably needs to be changed to 8 (ie, +7) on 64-bit
2391 if (a >= s && (a+3) <= e) return;
2393 barf("checkProddableBlock: invalid fixup in runtime linker");
2396 /* -----------------------------------------------------------------------------
2397 * Section management.
2400 addSection ( ObjectCode* oc, SectionKind kind,
2401 void* start, void* end )
2403 Section* s = stgMallocBytes(sizeof(Section), "addSection");
2407 s->next = oc->sections;
2410 IF_DEBUG(linker, debugBelch("addSection: %p-%p (size %ld), kind %d\n",
2411 start, ((char*)end)-1, (long)end - (long)start + 1, kind ));
2415 /* --------------------------------------------------------------------------
2417 * This is about allocating a small chunk of memory for every symbol in the
2418 * object file. We make sure that the SymboLExtras are always "in range" of
2419 * limited-range PC-relative instructions on various platforms by allocating
2420 * them right next to the object code itself.
2423 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
2426 ocAllocateSymbolExtras
2428 Allocate additional space at the end of the object file image to make room
2429 for jump islands (powerpc, x86_64) and GOT entries (x86_64).
2431 PowerPC relative branch instructions have a 24 bit displacement field.
2432 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
2433 If a particular imported symbol is outside this range, we have to redirect
2434 the jump to a short piece of new code that just loads the 32bit absolute
2435 address and jumps there.
2436 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
2439 This function just allocates space for one SymbolExtra for every
2440 undefined symbol in the object file. The code for the jump islands is
2441 filled in by makeSymbolExtra below.
2444 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
2451 int misalignment = 0;
2452 #ifdef darwin_HOST_OS
2453 misalignment = oc->misalignment;
2459 // round up to the nearest 4
2460 aligned = (oc->fileSize + 3) & ~3;
2463 pagesize = getpagesize();
2464 n = ROUND_UP( oc->fileSize, pagesize );
2465 m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
2467 /* we try to use spare space at the end of the last page of the
2468 * image for the jump islands, but if there isn't enough space
2469 * then we have to map some (anonymously, remembering MAP_32BIT).
2471 if( m > n ) // we need to allocate more pages
2473 oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
2478 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2481 oc->image -= misalignment;
2482 oc->image = stgReallocBytes( oc->image,
2484 aligned + sizeof (SymbolExtra) * count,
2485 "ocAllocateSymbolExtras" );
2486 oc->image += misalignment;
2488 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
2489 #endif /* USE_MMAP */
2491 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
2494 oc->symbol_extras = NULL;
2496 oc->first_symbol_extra = first;
2497 oc->n_symbol_extras = count;
2502 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
2503 unsigned long symbolNumber,
2504 unsigned long target )
2508 ASSERT( symbolNumber >= oc->first_symbol_extra
2509 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
2511 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
2513 #ifdef powerpc_HOST_ARCH
2514 // lis r12, hi16(target)
2515 extra->jumpIsland.lis_r12 = 0x3d80;
2516 extra->jumpIsland.hi_addr = target >> 16;
2518 // ori r12, r12, lo16(target)
2519 extra->jumpIsland.ori_r12_r12 = 0x618c;
2520 extra->jumpIsland.lo_addr = target & 0xffff;
2523 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
2526 extra->jumpIsland.bctr = 0x4e800420;
2528 #ifdef x86_64_HOST_ARCH
2530 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
2531 extra->addr = target;
2532 memcpy(extra->jumpIsland, jmp, 6);
2540 /* --------------------------------------------------------------------------
2541 * PowerPC specifics (instruction cache flushing)
2542 * ------------------------------------------------------------------------*/
2544 #ifdef powerpc_HOST_ARCH
2546 ocFlushInstructionCache
2548 Flush the data & instruction caches.
2549 Because the PPC has split data/instruction caches, we have to
2550 do that whenever we modify code at runtime.
2554 ocFlushInstructionCacheFrom(void* begin, size_t length)
2556 size_t n = (length + 3) / 4;
2557 unsigned long* p = begin;
2561 __asm__ volatile ( "dcbf 0,%0\n\t"
2569 __asm__ volatile ( "sync\n\t"
2575 ocFlushInstructionCache( ObjectCode *oc )
2577 /* The main object code */
2578 ocFlushInstructionCacheFrom(oc->image
2579 #ifdef darwin_HOST_OS
2585 ocFlushInstructionCacheFrom(oc->symbol_extras, sizeof(SymbolExtra) * oc->n_symbol_extras);
2587 #endif /* powerpc_HOST_ARCH */
2590 /* --------------------------------------------------------------------------
2591 * PEi386 specifics (Win32 targets)
2592 * ------------------------------------------------------------------------*/
2594 /* The information for this linker comes from
2595 Microsoft Portable Executable
2596 and Common Object File Format Specification
2597 revision 5.1 January 1998
2598 which SimonM says comes from the MS Developer Network CDs.
2600 It can be found there (on older CDs), but can also be found
2603 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
2605 (this is Rev 6.0 from February 1999).
2607 Things move, so if that fails, try searching for it via
2609 http://www.google.com/search?q=PE+COFF+specification
2611 The ultimate reference for the PE format is the Winnt.h
2612 header file that comes with the Platform SDKs; as always,
2613 implementations will drift wrt their documentation.
2615 A good background article on the PE format is Matt Pietrek's
2616 March 1994 article in Microsoft System Journal (MSJ)
2617 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2618 Win32 Portable Executable File Format." The info in there
2619 has recently been updated in a two part article in
2620 MSDN magazine, issues Feb and March 2002,
2621 "Inside Windows: An In-Depth Look into the Win32 Portable
2622 Executable File Format"
2624 John Levine's book "Linkers and Loaders" contains useful
2629 #if defined(OBJFORMAT_PEi386)
2633 typedef unsigned char UChar;
2634 typedef unsigned short UInt16;
2635 typedef unsigned int UInt32;
2642 UInt16 NumberOfSections;
2643 UInt32 TimeDateStamp;
2644 UInt32 PointerToSymbolTable;
2645 UInt32 NumberOfSymbols;
2646 UInt16 SizeOfOptionalHeader;
2647 UInt16 Characteristics;
2651 #define sizeof_COFF_header 20
2658 UInt32 VirtualAddress;
2659 UInt32 SizeOfRawData;
2660 UInt32 PointerToRawData;
2661 UInt32 PointerToRelocations;
2662 UInt32 PointerToLinenumbers;
2663 UInt16 NumberOfRelocations;
2664 UInt16 NumberOfLineNumbers;
2665 UInt32 Characteristics;
2669 #define sizeof_COFF_section 40
2676 UInt16 SectionNumber;
2679 UChar NumberOfAuxSymbols;
2683 #define sizeof_COFF_symbol 18
2688 UInt32 VirtualAddress;
2689 UInt32 SymbolTableIndex;
2694 #define sizeof_COFF_reloc 10
2697 /* From PE spec doc, section 3.3.2 */
2698 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
2699 windows.h -- for the same purpose, but I want to know what I'm
2701 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
2702 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
2703 #define MYIMAGE_FILE_DLL 0x2000
2704 #define MYIMAGE_FILE_SYSTEM 0x1000
2705 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
2706 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
2707 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
2709 /* From PE spec doc, section 5.4.2 and 5.4.4 */
2710 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
2711 #define MYIMAGE_SYM_CLASS_STATIC 3
2712 #define MYIMAGE_SYM_UNDEFINED 0
2714 /* From PE spec doc, section 4.1 */
2715 #define MYIMAGE_SCN_CNT_CODE 0x00000020
2716 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
2717 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
2719 /* From PE spec doc, section 5.2.1 */
2720 #define MYIMAGE_REL_I386_DIR32 0x0006
2721 #define MYIMAGE_REL_I386_REL32 0x0014
2724 /* We use myindex to calculate array addresses, rather than
2725 simply doing the normal subscript thing. That's because
2726 some of the above structs have sizes which are not
2727 a whole number of words. GCC rounds their sizes up to a
2728 whole number of words, which means that the address calcs
2729 arising from using normal C indexing or pointer arithmetic
2730 are just plain wrong. Sigh.
2733 myindex ( int scale, void* base, int index )
2736 ((UChar*)base) + scale * index;
2741 printName ( UChar* name, UChar* strtab )
2743 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2744 UInt32 strtab_offset = * (UInt32*)(name+4);
2745 debugBelch("%s", strtab + strtab_offset );
2748 for (i = 0; i < 8; i++) {
2749 if (name[i] == 0) break;
2750 debugBelch("%c", name[i] );
2757 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
2759 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2760 UInt32 strtab_offset = * (UInt32*)(name+4);
2761 strncpy ( (char*)dst, (char*)strtab+strtab_offset, dstSize );
2767 if (name[i] == 0) break;
2777 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
2780 /* If the string is longer than 8 bytes, look in the
2781 string table for it -- this will be correctly zero terminated.
2783 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2784 UInt32 strtab_offset = * (UInt32*)(name+4);
2785 return ((UChar*)strtab) + strtab_offset;
2787 /* Otherwise, if shorter than 8 bytes, return the original,
2788 which by defn is correctly terminated.
2790 if (name[7]==0) return name;
2791 /* The annoying case: 8 bytes. Copy into a temporary
2792 (XXX which is never freed ...)
2794 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
2796 strncpy((char*)newstr,(char*)name,8);
2801 /* Getting the name of a section is mildly tricky, so we make a
2802 function for it. Sadly, in one case we have to copy the string
2803 (when it is exactly 8 bytes long there's no trailing '\0'), so for
2804 consistency we *always* copy the string; the caller must free it
2807 cstring_from_section_name (UChar* name, UChar* strtab)
2812 int strtab_offset = strtol((char*)name+1,NULL,10);
2813 int len = strlen(((char*)strtab) + strtab_offset);
2815 newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
2816 strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
2821 newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
2823 strncpy((char*)newstr,(char*)name,8);
2829 /* Just compares the short names (first 8 chars) */
2830 static COFF_section *
2831 findPEi386SectionCalled ( ObjectCode* oc, UChar* name )
2835 = (COFF_header*)(oc->image);
2836 COFF_section* sectab
2838 ((UChar*)(oc->image))
2839 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2841 for (i = 0; i < hdr->NumberOfSections; i++) {
2844 COFF_section* section_i
2846 myindex ( sizeof_COFF_section, sectab, i );
2847 n1 = (UChar*) &(section_i->Name);
2849 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
2850 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
2851 n1[6]==n2[6] && n1[7]==n2[7])
2860 zapTrailingAtSign ( UChar* sym )
2862 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2864 if (sym[0] == 0) return;
2866 while (sym[i] != 0) i++;
2869 while (j > 0 && my_isdigit(sym[j])) j--;
2870 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2875 lookupSymbolInDLLs ( UChar *lbl )
2880 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2881 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
2883 if (lbl[0] == '_') {
2884 /* HACK: if the name has an initial underscore, try stripping
2885 it off & look that up first. I've yet to verify whether there's
2886 a Rule that governs whether an initial '_' *should always* be
2887 stripped off when mapping from import lib name to the DLL name.
2889 sym = GetProcAddress(o_dll->instance, (char*)(lbl+1));
2891 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
2895 sym = GetProcAddress(o_dll->instance, (char*)lbl);
2897 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
2906 ocVerifyImage_PEi386 ( ObjectCode* oc )
2911 COFF_section* sectab;
2912 COFF_symbol* symtab;
2914 /* debugBelch("\nLOADING %s\n", oc->fileName); */
2915 hdr = (COFF_header*)(oc->image);
2916 sectab = (COFF_section*) (
2917 ((UChar*)(oc->image))
2918 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2920 symtab = (COFF_symbol*) (
2921 ((UChar*)(oc->image))
2922 + hdr->PointerToSymbolTable
2924 strtab = ((UChar*)symtab)
2925 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2927 if (hdr->Machine != 0x14c) {
2928 errorBelch("%s: Not x86 PEi386", oc->fileName);
2931 if (hdr->SizeOfOptionalHeader != 0) {
2932 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2935 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2936 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2937 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2938 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2939 errorBelch("%s: Not a PEi386 object file", oc->fileName);
2942 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2943 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2944 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2946 (int)(hdr->Characteristics));
2949 /* If the string table size is way crazy, this might indicate that
2950 there are more than 64k relocations, despite claims to the
2951 contrary. Hence this test. */
2952 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2954 if ( (*(UInt32*)strtab) > 600000 ) {
2955 /* Note that 600k has no special significance other than being
2956 big enough to handle the almost-2MB-sized lumps that
2957 constitute HSwin32*.o. */
2958 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2963 /* No further verification after this point; only debug printing. */
2965 IF_DEBUG(linker, i=1);
2966 if (i == 0) return 1;
2968 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2969 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2970 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2973 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2974 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2975 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2976 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2977 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2978 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2979 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2981 /* Print the section table. */
2983 for (i = 0; i < hdr->NumberOfSections; i++) {
2985 COFF_section* sectab_i
2987 myindex ( sizeof_COFF_section, sectab, i );
2994 printName ( sectab_i->Name, strtab );
3004 sectab_i->VirtualSize,
3005 sectab_i->VirtualAddress,
3006 sectab_i->SizeOfRawData,
3007 sectab_i->PointerToRawData,
3008 sectab_i->NumberOfRelocations,
3009 sectab_i->PointerToRelocations,
3010 sectab_i->PointerToRawData
3012 reltab = (COFF_reloc*) (
3013 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3016 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3017 /* If the relocation field (a short) has overflowed, the
3018 * real count can be found in the first reloc entry.
3020 * See Section 4.1 (last para) of the PE spec (rev6.0).
3022 COFF_reloc* rel = (COFF_reloc*)
3023 myindex ( sizeof_COFF_reloc, reltab, 0 );
3024 noRelocs = rel->VirtualAddress;
3027 noRelocs = sectab_i->NumberOfRelocations;
3031 for (; j < noRelocs; j++) {
3033 COFF_reloc* rel = (COFF_reloc*)
3034 myindex ( sizeof_COFF_reloc, reltab, j );
3036 " type 0x%-4x vaddr 0x%-8x name `",
3038 rel->VirtualAddress );
3039 sym = (COFF_symbol*)
3040 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
3041 /* Hmm..mysterious looking offset - what's it for? SOF */
3042 printName ( sym->Name, strtab -10 );
3049 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
3050 debugBelch("---START of string table---\n");
3051 for (i = 4; i < *(Int32*)strtab; i++) {
3053 debugBelch("\n"); else
3054 debugBelch("%c", strtab[i] );
3056 debugBelch("--- END of string table---\n");
3061 COFF_symbol* symtab_i;
3062 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
3063 symtab_i = (COFF_symbol*)
3064 myindex ( sizeof_COFF_symbol, symtab, i );
3070 printName ( symtab_i->Name, strtab );
3079 (Int32)(symtab_i->SectionNumber),
3080 (UInt32)symtab_i->Type,
3081 (UInt32)symtab_i->StorageClass,
3082 (UInt32)symtab_i->NumberOfAuxSymbols
3084 i += symtab_i->NumberOfAuxSymbols;
3094 ocGetNames_PEi386 ( ObjectCode* oc )
3097 COFF_section* sectab;
3098 COFF_symbol* symtab;
3105 hdr = (COFF_header*)(oc->image);
3106 sectab = (COFF_section*) (
3107 ((UChar*)(oc->image))
3108 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3110 symtab = (COFF_symbol*) (
3111 ((UChar*)(oc->image))
3112 + hdr->PointerToSymbolTable
3114 strtab = ((UChar*)(oc->image))
3115 + hdr->PointerToSymbolTable
3116 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
3118 /* Allocate space for any (local, anonymous) .bss sections. */
3120 for (i = 0; i < hdr->NumberOfSections; i++) {
3123 COFF_section* sectab_i
3125 myindex ( sizeof_COFF_section, sectab, i );
3127 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3129 if (0 != strcmp(secname, ".bss")) {
3136 /* sof 10/05: the PE spec text isn't too clear regarding what
3137 * the SizeOfRawData field is supposed to hold for object
3138 * file sections containing just uninitialized data -- for executables,
3139 * it is supposed to be zero; unclear what it's supposed to be
3140 * for object files. However, VirtualSize is guaranteed to be
3141 * zero for object files, which definitely suggests that SizeOfRawData
3142 * will be non-zero (where else would the size of this .bss section be
3143 * stored?) Looking at the COFF_section info for incoming object files,
3144 * this certainly appears to be the case.
3146 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
3147 * object files up until now. This turned out to bite us with ghc-6.4.1's use
3148 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
3149 * variable decls into to the .bss section. (The specific function in Q which
3150 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
3152 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
3153 /* This is a non-empty .bss section. Allocate zeroed space for
3154 it, and set its PointerToRawData field such that oc->image +
3155 PointerToRawData == addr_of_zeroed_space. */
3156 bss_sz = sectab_i->VirtualSize;
3157 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
3158 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
3159 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
3160 addProddableBlock(oc, zspace, bss_sz);
3161 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
3164 /* Copy section information into the ObjectCode. */
3166 for (i = 0; i < hdr->NumberOfSections; i++) {
3172 = SECTIONKIND_OTHER;
3173 COFF_section* sectab_i
3175 myindex ( sizeof_COFF_section, sectab, i );
3177 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3179 IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
3182 /* I'm sure this is the Right Way to do it. However, the
3183 alternative of testing the sectab_i->Name field seems to
3184 work ok with Cygwin.
3186 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
3187 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
3188 kind = SECTIONKIND_CODE_OR_RODATA;
3191 if (0==strcmp(".text",(char*)secname) ||
3192 0==strcmp(".rdata",(char*)secname)||
3193 0==strcmp(".rodata",(char*)secname))
3194 kind = SECTIONKIND_CODE_OR_RODATA;
3195 if (0==strcmp(".data",(char*)secname) ||
3196 0==strcmp(".bss",(char*)secname))
3197 kind = SECTIONKIND_RWDATA;
3199 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
3200 sz = sectab_i->SizeOfRawData;
3201 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
3203 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
3204 end = start + sz - 1;
3206 if (kind == SECTIONKIND_OTHER
3207 /* Ignore sections called which contain stabs debugging
3209 && 0 != strcmp(".stab", (char*)secname)
3210 && 0 != strcmp(".stabstr", (char*)secname)
3211 /* ignore constructor section for now */
3212 && 0 != strcmp(".ctors", (char*)secname)
3213 /* ignore section generated from .ident */
3214 && 0!= strncmp(".debug", (char*)secname, 6)
3215 /* ignore unknown section that appeared in gcc 3.4.5(?) */
3216 && 0!= strcmp(".reloc", (char*)secname)
3217 && 0 != strcmp(".rdata$zzz", (char*)secname)
3219 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
3224 if (kind != SECTIONKIND_OTHER && end >= start) {
3225 addSection(oc, kind, start, end);
3226 addProddableBlock(oc, start, end - start + 1);
3232 /* Copy exported symbols into the ObjectCode. */
3234 oc->n_symbols = hdr->NumberOfSymbols;
3235 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3236 "ocGetNames_PEi386(oc->symbols)");
3237 /* Call me paranoid; I don't care. */
3238 for (i = 0; i < oc->n_symbols; i++)
3239 oc->symbols[i] = NULL;
3243 COFF_symbol* symtab_i;
3244 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
3245 symtab_i = (COFF_symbol*)
3246 myindex ( sizeof_COFF_symbol, symtab, i );
3250 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
3251 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
3252 /* This symbol is global and defined, viz, exported */
3253 /* for MYIMAGE_SYMCLASS_EXTERNAL
3254 && !MYIMAGE_SYM_UNDEFINED,
3255 the address of the symbol is:
3256 address of relevant section + offset in section
3258 COFF_section* sectabent
3259 = (COFF_section*) myindex ( sizeof_COFF_section,
3261 symtab_i->SectionNumber-1 );
3262 addr = ((UChar*)(oc->image))
3263 + (sectabent->PointerToRawData
3267 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
3268 && symtab_i->Value > 0) {
3269 /* This symbol isn't in any section at all, ie, global bss.
3270 Allocate zeroed space for it. */
3271 addr = stgCallocBytes(1, symtab_i->Value,
3272 "ocGetNames_PEi386(non-anonymous bss)");
3273 addSection(oc, SECTIONKIND_RWDATA, addr,
3274 ((UChar*)addr) + symtab_i->Value - 1);
3275 addProddableBlock(oc, addr, symtab_i->Value);
3276 /* debugBelch("BSS section at 0x%x\n", addr); */
3279 if (addr != NULL ) {
3280 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
3281 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
3282 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
3283 ASSERT(i >= 0 && i < oc->n_symbols);
3284 /* cstring_from_COFF_symbol_name always succeeds. */
3285 oc->symbols[i] = (char*)sname;
3286 ghciInsertStrHashTable(oc->fileName, symhash, (char*)sname, addr);
3290 "IGNORING symbol %d\n"
3294 printName ( symtab_i->Name, strtab );
3303 (Int32)(symtab_i->SectionNumber),
3304 (UInt32)symtab_i->Type,
3305 (UInt32)symtab_i->StorageClass,
3306 (UInt32)symtab_i->NumberOfAuxSymbols
3311 i += symtab_i->NumberOfAuxSymbols;
3320 ocResolve_PEi386 ( ObjectCode* oc )
3323 COFF_section* sectab;
3324 COFF_symbol* symtab;
3334 /* ToDo: should be variable-sized? But is at least safe in the
3335 sense of buffer-overrun-proof. */
3337 /* debugBelch("resolving for %s\n", oc->fileName); */
3339 hdr = (COFF_header*)(oc->image);
3340 sectab = (COFF_section*) (
3341 ((UChar*)(oc->image))
3342 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
3344 symtab = (COFF_symbol*) (
3345 ((UChar*)(oc->image))
3346 + hdr->PointerToSymbolTable
3348 strtab = ((UChar*)(oc->image))
3349 + hdr->PointerToSymbolTable
3350 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
3352 for (i = 0; i < hdr->NumberOfSections; i++) {
3353 COFF_section* sectab_i
3355 myindex ( sizeof_COFF_section, sectab, i );
3358 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
3361 char *secname = cstring_from_section_name(sectab_i->Name, strtab);
3363 /* Ignore sections called which contain stabs debugging
3365 if (0 == strcmp(".stab", (char*)secname)
3366 || 0 == strcmp(".stabstr", (char*)secname)
3367 || 0 == strcmp(".ctors", (char*)secname)
3368 || 0 == strncmp(".debug", (char*)secname, 6)
3369 || 0 == strcmp(".rdata$zzz", (char*)secname)) {
3376 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
3377 /* If the relocation field (a short) has overflowed, the
3378 * real count can be found in the first reloc entry.
3380 * See Section 4.1 (last para) of the PE spec (rev6.0).
3382 * Nov2003 update: the GNU linker still doesn't correctly
3383 * handle the generation of relocatable object files with
3384 * overflown relocations. Hence the output to warn of potential
3387 COFF_reloc* rel = (COFF_reloc*)
3388 myindex ( sizeof_COFF_reloc, reltab, 0 );
3389 noRelocs = rel->VirtualAddress;
3391 /* 10/05: we now assume (and check for) a GNU ld that is capable
3392 * of handling object files with (>2^16) of relocs.
3395 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
3400 noRelocs = sectab_i->NumberOfRelocations;
3405 for (; j < noRelocs; j++) {
3407 COFF_reloc* reltab_j
3409 myindex ( sizeof_COFF_reloc, reltab, j );
3411 /* the location to patch */
3413 ((UChar*)(oc->image))
3414 + (sectab_i->PointerToRawData
3415 + reltab_j->VirtualAddress
3416 - sectab_i->VirtualAddress )
3418 /* the existing contents of pP */
3420 /* the symbol to connect to */
3421 sym = (COFF_symbol*)
3422 myindex ( sizeof_COFF_symbol,
3423 symtab, reltab_j->SymbolTableIndex );
3426 "reloc sec %2d num %3d: type 0x%-4x "
3427 "vaddr 0x%-8x name `",
3429 (UInt32)reltab_j->Type,
3430 reltab_j->VirtualAddress );
3431 printName ( sym->Name, strtab );
3432 debugBelch("'\n" ));
3434 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
3435 COFF_section* section_sym
3436 = findPEi386SectionCalled ( oc, sym->Name );
3438 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
3441 S = ((UInt32)(oc->image))
3442 + (section_sym->PointerToRawData
3445 copyName ( sym->Name, strtab, symbol, 1000-1 );
3446 S = (UInt32) lookupSymbol( (char*)symbol );
3447 if ((void*)S != NULL) goto foundit;
3448 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3452 checkProddableBlock(oc, pP);
3453 switch (reltab_j->Type) {
3454 case MYIMAGE_REL_I386_DIR32:
3457 case MYIMAGE_REL_I386_REL32:
3458 /* Tricky. We have to insert a displacement at
3459 pP which, when added to the PC for the _next_
3460 insn, gives the address of the target (S).
3461 Problem is to know the address of the next insn
3462 when we only know pP. We assume that this
3463 literal field is always the last in the insn,
3464 so that the address of the next insn is pP+4
3465 -- hence the constant 4.
3466 Also I don't know if A should be added, but so
3467 far it has always been zero.
3469 SOF 05/2005: 'A' (old contents of *pP) have been observed
3470 to contain values other than zero (the 'wx' object file
3471 that came with wxhaskell-0.9.4; dunno how it was compiled..).
3472 So, add displacement to old value instead of asserting
3473 A to be zero. Fixes wxhaskell-related crashes, and no other
3474 ill effects have been observed.
3476 Update: the reason why we're seeing these more elaborate
3477 relocations is due to a switch in how the NCG compiles SRTs
3478 and offsets to them from info tables. SRTs live in .(ro)data,
3479 while info tables live in .text, causing GAS to emit REL32/DISP32
3480 relocations with non-zero values. Adding the displacement is
3481 the right thing to do.
3483 *pP = S - ((UInt32)pP) - 4 + A;
3486 debugBelch("%s: unhandled PEi386 relocation type %d",
3487 oc->fileName, reltab_j->Type);
3494 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
3498 #endif /* defined(OBJFORMAT_PEi386) */
3501 /* --------------------------------------------------------------------------
3503 * ------------------------------------------------------------------------*/
3505 #if defined(OBJFORMAT_ELF)
3510 #if defined(sparc_HOST_ARCH)
3511 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
3512 #elif defined(i386_HOST_ARCH)
3513 # define ELF_TARGET_386 /* Used inside <elf.h> */
3514 #elif defined(x86_64_HOST_ARCH)
3515 # define ELF_TARGET_X64_64
3519 #if !defined(openbsd_HOST_OS)
3522 /* openbsd elf has things in different places, with diff names */
3523 # include <elf_abi.h>
3524 # include <machine/reloc.h>
3525 # define R_386_32 RELOC_32
3526 # define R_386_PC32 RELOC_PC32
3529 /* If elf.h doesn't define it */
3530 # ifndef R_X86_64_PC64
3531 # define R_X86_64_PC64 24
3535 * Define a set of types which can be used for both ELF32 and ELF64
3539 #define ELFCLASS ELFCLASS64
3540 #define Elf_Addr Elf64_Addr
3541 #define Elf_Word Elf64_Word
3542 #define Elf_Sword Elf64_Sword
3543 #define Elf_Ehdr Elf64_Ehdr
3544 #define Elf_Phdr Elf64_Phdr
3545 #define Elf_Shdr Elf64_Shdr
3546 #define Elf_Sym Elf64_Sym
3547 #define Elf_Rel Elf64_Rel
3548 #define Elf_Rela Elf64_Rela
3550 #define ELF_ST_TYPE ELF64_ST_TYPE
3553 #define ELF_ST_BIND ELF64_ST_BIND
3556 #define ELF_R_TYPE ELF64_R_TYPE
3559 #define ELF_R_SYM ELF64_R_SYM
3562 #define ELFCLASS ELFCLASS32
3563 #define Elf_Addr Elf32_Addr
3564 #define Elf_Word Elf32_Word
3565 #define Elf_Sword Elf32_Sword
3566 #define Elf_Ehdr Elf32_Ehdr
3567 #define Elf_Phdr Elf32_Phdr
3568 #define Elf_Shdr Elf32_Shdr
3569 #define Elf_Sym Elf32_Sym
3570 #define Elf_Rel Elf32_Rel
3571 #define Elf_Rela Elf32_Rela
3573 #define ELF_ST_TYPE ELF32_ST_TYPE
3576 #define ELF_ST_BIND ELF32_ST_BIND
3579 #define ELF_R_TYPE ELF32_R_TYPE
3582 #define ELF_R_SYM ELF32_R_SYM
3588 * Functions to allocate entries in dynamic sections. Currently we simply
3589 * preallocate a large number, and we don't check if a entry for the given
3590 * target already exists (a linear search is too slow). Ideally these
3591 * entries would be associated with symbols.
3594 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
3595 #define GOT_SIZE 0x20000
3596 #define FUNCTION_TABLE_SIZE 0x10000
3597 #define PLT_SIZE 0x08000
3600 static Elf_Addr got[GOT_SIZE];
3601 static unsigned int gotIndex;
3602 static Elf_Addr gp_val = (Elf_Addr)got;
3605 allocateGOTEntry(Elf_Addr target)
3609 if (gotIndex >= GOT_SIZE)
3610 barf("Global offset table overflow");
3612 entry = &got[gotIndex++];
3614 return (Elf_Addr)entry;
3618 #ifdef ELF_FUNCTION_DESC
3624 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
3625 static unsigned int functionTableIndex;
3628 allocateFunctionDesc(Elf_Addr target)
3630 FunctionDesc *entry;
3632 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
3633 barf("Function table overflow");
3635 entry = &functionTable[functionTableIndex++];
3637 entry->gp = (Elf_Addr)gp_val;
3638 return (Elf_Addr)entry;
3642 copyFunctionDesc(Elf_Addr target)
3644 FunctionDesc *olddesc = (FunctionDesc *)target;
3645 FunctionDesc *newdesc;
3647 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
3648 newdesc->gp = olddesc->gp;
3649 return (Elf_Addr)newdesc;
3656 unsigned char code[sizeof(plt_code)];
3660 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
3662 PLTEntry *plt = (PLTEntry *)oc->plt;
3665 if (oc->pltIndex >= PLT_SIZE)
3666 barf("Procedure table overflow");
3668 entry = &plt[oc->pltIndex++];
3669 memcpy(entry->code, plt_code, sizeof(entry->code));
3670 PLT_RELOC(entry->code, target);
3671 return (Elf_Addr)entry;
3677 return (PLT_SIZE * sizeof(PLTEntry));
3683 * Generic ELF functions
3687 ocVerifyImage_ELF ( ObjectCode* oc )
3691 int i, j, nent, nstrtab, nsymtabs;
3694 char* ehdrC = (char*)(oc->image);
3695 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3697 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
3698 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
3699 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
3700 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
3701 errorBelch("%s: not an ELF object", oc->fileName);
3705 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
3706 errorBelch("%s: unsupported ELF format", oc->fileName);
3710 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
3711 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
3713 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
3714 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
3716 errorBelch("%s: unknown endiannness", oc->fileName);
3720 if (ehdr->e_type != ET_REL) {
3721 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
3724 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
3726 IF_DEBUG(linker,debugBelch( "Architecture is " ));
3727 switch (ehdr->e_machine) {
3728 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
3729 #ifdef EM_SPARC32PLUS
3730 case EM_SPARC32PLUS:
3732 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
3734 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
3736 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
3738 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
3739 #elif defined(EM_AMD64)
3740 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
3742 default: IF_DEBUG(linker,debugBelch( "unknown" ));
3743 errorBelch("%s: unknown architecture (e_machine == %d)"
3744 , oc->fileName, ehdr->e_machine);
3748 IF_DEBUG(linker,debugBelch(
3749 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
3750 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
3752 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
3754 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3756 if (ehdr->e_shstrndx == SHN_UNDEF) {
3757 errorBelch("%s: no section header string table", oc->fileName);
3760 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
3762 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3765 for (i = 0; i < ehdr->e_shnum; i++) {
3766 IF_DEBUG(linker,debugBelch("%2d: ", i ));
3767 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
3768 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
3769 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
3770 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
3771 ehdrC + shdr[i].sh_offset,
3772 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
3774 #define SECTION_INDEX_VALID(ndx) (ndx > SHN_UNDEF && ndx < ehdr->e_shnum)
3776 switch (shdr[i].sh_type) {
3780 IF_DEBUG(linker,debugBelch( shdr[i].sh_type == SHT_REL ? "Rel " : "RelA "));
3782 if (!SECTION_INDEX_VALID(shdr[i].sh_link)) {
3783 if (shdr[i].sh_link == SHN_UNDEF)
3784 errorBelch("\n%s: relocation section #%d has no symbol table\n"
3785 "This object file has probably been fully striped. "
3786 "Such files cannot be linked.\n",
3787 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i);
3789 errorBelch("\n%s: relocation section #%d has an invalid link field (%d)\n",
3790 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName,
3791 i, shdr[i].sh_link);
3794 if (shdr[shdr[i].sh_link].sh_type != SHT_SYMTAB) {
3795 errorBelch("\n%s: relocation section #%d does not link to a symbol table\n",
3796 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i);
3799 if (!SECTION_INDEX_VALID(shdr[i].sh_info)) {
3800 errorBelch("\n%s: relocation section #%d has an invalid info field (%d)\n",
3801 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName,
3802 i, shdr[i].sh_info);
3808 IF_DEBUG(linker,debugBelch("Sym "));
3810 if (!SECTION_INDEX_VALID(shdr[i].sh_link)) {
3811 errorBelch("\n%s: symbol table section #%d has an invalid link field (%d)\n",
3812 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName,
3813 i, shdr[i].sh_link);
3816 if (shdr[shdr[i].sh_link].sh_type != SHT_STRTAB) {
3817 errorBelch("\n%s: symbol table section #%d does not link to a string table\n",
3818 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName, i);
3823 case SHT_STRTAB: IF_DEBUG(linker,debugBelch("Str ")); break;
3824 default: IF_DEBUG(linker,debugBelch(" ")); break;
3827 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
3831 IF_DEBUG(linker,debugBelch( "\nString tables\n" ));
3833 for (i = 0; i < ehdr->e_shnum; i++) {
3834 if (shdr[i].sh_type == SHT_STRTAB
3835 /* Ignore the section header's string table. */
3836 && i != ehdr->e_shstrndx
3837 /* Ignore string tables named .stabstr, as they contain
3839 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3841 IF_DEBUG(linker,debugBelch(" section %d is a normal string table\n", i ));
3846 IF_DEBUG(linker,debugBelch(" no normal string tables (potentially, but not necessarily a problem)\n"));
3850 IF_DEBUG(linker,debugBelch( "Symbol tables\n" ));
3851 for (i = 0; i < ehdr->e_shnum; i++) {
3852 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3853 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
3855 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3856 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3857 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
3859 (long)shdr[i].sh_size % sizeof(Elf_Sym)
3861 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
3862 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
3865 for (j = 0; j < nent; j++) {
3866 IF_DEBUG(linker,debugBelch(" %2d ", j ));
3867 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
3868 (int)stab[j].st_shndx,
3869 (int)stab[j].st_size,
3870 (char*)stab[j].st_value ));
3872 IF_DEBUG(linker,debugBelch("type=" ));
3873 switch (ELF_ST_TYPE(stab[j].st_info)) {
3874 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
3875 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
3876 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
3877 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
3878 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
3879 default: IF_DEBUG(linker,debugBelch("? " )); break;
3881 IF_DEBUG(linker,debugBelch(" " ));
3883 IF_DEBUG(linker,debugBelch("bind=" ));
3884 switch (ELF_ST_BIND(stab[j].st_info)) {
3885 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
3886 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
3887 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
3888 default: IF_DEBUG(linker,debugBelch("? " )); break;
3890 IF_DEBUG(linker,debugBelch(" " ));
3892 IF_DEBUG(linker,debugBelch("name=%s\n",
3893 ehdrC + shdr[shdr[i].sh_link].sh_offset
3894 + stab[j].st_name ));
3898 if (nsymtabs == 0) {
3899 // Not having a symbol table is not in principle a problem.
3900 // When an object file has no symbols then the 'strip' program
3901 // typically will remove the symbol table entirely.
3902 IF_DEBUG(linker,debugBelch(" no symbol tables (potentially, but not necessarily a problem)\n"));
3908 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3912 if (hdr->sh_type == SHT_PROGBITS
3913 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3914 /* .text-style section */
3915 return SECTIONKIND_CODE_OR_RODATA;
3918 if (hdr->sh_type == SHT_PROGBITS
3919 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3920 /* .data-style section */
3921 return SECTIONKIND_RWDATA;
3924 if (hdr->sh_type == SHT_PROGBITS
3925 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3926 /* .rodata-style section */
3927 return SECTIONKIND_CODE_OR_RODATA;
3930 if (hdr->sh_type == SHT_NOBITS
3931 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3932 /* .bss-style section */
3934 return SECTIONKIND_RWDATA;
3937 return SECTIONKIND_OTHER;
3942 ocGetNames_ELF ( ObjectCode* oc )
3947 char* ehdrC = (char*)(oc->image);
3948 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3950 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3952 ASSERT(symhash != NULL);
3955 for (i = 0; i < ehdr->e_shnum; i++) {
3956 /* Figure out what kind of section it is. Logic derived from
3957 Figure 1.14 ("Special Sections") of the ELF document
3958 ("Portable Formats Specification, Version 1.1"). */
3960 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3962 if (is_bss && shdr[i].sh_size > 0) {
3963 /* This is a non-empty .bss section. Allocate zeroed space for
3964 it, and set its .sh_offset field such that
3965 ehdrC + .sh_offset == addr_of_zeroed_space. */
3966 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3967 "ocGetNames_ELF(BSS)");
3968 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3970 debugBelch("BSS section at 0x%x, size %d\n",
3971 zspace, shdr[i].sh_size);
3975 /* fill in the section info */
3976 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3977 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3978 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3979 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3982 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3984 /* copy stuff into this module's object symbol table */
3985 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3986 strtab = ehdrC + shdr[shdr[i].sh_link].sh_offset;
3987 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3989 oc->n_symbols = nent;
3990 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3991 "ocGetNames_ELF(oc->symbols)");
3993 //TODO: we ignore local symbols anyway right? So we can use the
3994 // shdr[i].sh_info to get the index of the first non-local symbol
3995 // ie we should use j = shdr[i].sh_info
3996 for (j = 0; j < nent; j++) {
3998 char isLocal = FALSE; /* avoids uninit-var warning */
4000 char* nm = strtab + stab[j].st_name;
4001 int secno = stab[j].st_shndx;
4003 /* Figure out if we want to add it; if so, set ad to its
4004 address. Otherwise leave ad == NULL. */
4006 if (secno == SHN_COMMON) {
4008 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
4010 debugBelch("COMMON symbol, size %d name %s\n",
4011 stab[j].st_size, nm);
4013 /* Pointless to do addProddableBlock() for this area,
4014 since the linker should never poke around in it. */
4017 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
4018 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
4020 /* and not an undefined symbol */
4021 && stab[j].st_shndx != SHN_UNDEF
4022 /* and not in a "special section" */
4023 && stab[j].st_shndx < SHN_LORESERVE
4025 /* and it's a not a section or string table or anything silly */
4026 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
4027 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
4028 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
4031 /* Section 0 is the undefined section, hence > and not >=. */
4032 ASSERT(secno > 0 && secno < ehdr->e_shnum);
4034 if (shdr[secno].sh_type == SHT_NOBITS) {
4035 debugBelch(" BSS symbol, size %d off %d name %s\n",
4036 stab[j].st_size, stab[j].st_value, nm);
4039 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
4040 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
4043 #ifdef ELF_FUNCTION_DESC
4044 /* dlsym() and the initialisation table both give us function
4045 * descriptors, so to be consistent we store function descriptors
4046 * in the symbol table */
4047 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
4048 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
4050 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
4051 ad, oc->fileName, nm ));
4056 /* And the decision is ... */
4060 oc->symbols[j] = nm;
4063 /* Ignore entirely. */
4065 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
4069 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
4070 strtab + stab[j].st_name ));
4073 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
4074 (int)ELF_ST_BIND(stab[j].st_info),
4075 (int)ELF_ST_TYPE(stab[j].st_info),
4076 (int)stab[j].st_shndx,
4077 strtab + stab[j].st_name
4080 oc->symbols[j] = NULL;
4089 /* Do ELF relocations which lack an explicit addend. All x86-linux
4090 relocations appear to be of this form. */
4092 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
4093 Elf_Shdr* shdr, int shnum )
4098 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
4101 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
4102 int target_shndx = shdr[shnum].sh_info;
4103 int symtab_shndx = shdr[shnum].sh_link;
4104 int strtab_shndx = shdr[symtab_shndx].sh_link;
4106 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
4107 strtab= (char*) (ehdrC + shdr[ strtab_shndx ].sh_offset);
4108 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
4109 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d and strtab %d\n",
4110 target_shndx, symtab_shndx, strtab_shndx ));
4112 /* Skip sections that we're not interested in. */
4115 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
4116 if (kind == SECTIONKIND_OTHER) {
4117 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
4122 for (j = 0; j < nent; j++) {
4123 Elf_Addr offset = rtab[j].r_offset;
4124 Elf_Addr info = rtab[j].r_info;
4126 Elf_Addr P = ((Elf_Addr)targ) + offset;
4127 Elf_Word* pP = (Elf_Word*)P;
4132 StgStablePtr stablePtr;
4135 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
4136 j, (void*)offset, (void*)info ));
4138 IF_DEBUG(linker,debugBelch( " ZERO" ));
4141 Elf_Sym sym = stab[ELF_R_SYM(info)];
4142 /* First see if it is a local symbol. */
4143 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
4144 /* Yes, so we can get the address directly from the ELF symbol
4146 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
4148 (ehdrC + shdr[ sym.st_shndx ].sh_offset
4149 + stab[ELF_R_SYM(info)].st_value);
4152 symbol = strtab + sym.st_name;
4153 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
4154 if (NULL == stablePtr) {
4155 /* No, so look up the name in our global table. */
4156 S_tmp = lookupSymbol( symbol );
4157 S = (Elf_Addr)S_tmp;
4159 stableVal = deRefStablePtr( stablePtr );
4161 S = (Elf_Addr)S_tmp;
4165 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
4168 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
4171 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
4172 (void*)P, (void*)S, (void*)A ));
4173 checkProddableBlock ( oc, pP );
4177 switch (ELF_R_TYPE(info)) {
4178 # ifdef i386_HOST_ARCH
4179 case R_386_32: *pP = value; break;
4180 case R_386_PC32: *pP = value - P; break;
4183 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
4184 oc->fileName, (lnat)ELF_R_TYPE(info));
4192 /* Do ELF relocations for which explicit addends are supplied.
4193 sparc-solaris relocations appear to be of this form. */
4195 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
4196 Elf_Shdr* shdr, int shnum )
4199 char *symbol = NULL;
4201 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
4204 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
4205 int target_shndx = shdr[shnum].sh_info;
4206 int symtab_shndx = shdr[shnum].sh_link;
4207 int strtab_shndx = shdr[symtab_shndx].sh_link;
4209 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
4210 strtab= (char*) (ehdrC + shdr[ strtab_shndx ].sh_offset);
4211 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
4212 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
4213 target_shndx, symtab_shndx ));
4215 for (j = 0; j < nent; j++) {
4216 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4217 /* This #ifdef only serves to avoid unused-var warnings. */
4218 Elf_Addr offset = rtab[j].r_offset;
4219 Elf_Addr P = targ + offset;
4221 Elf_Addr info = rtab[j].r_info;
4222 Elf_Addr A = rtab[j].r_addend;
4226 # if defined(sparc_HOST_ARCH)
4227 Elf_Word* pP = (Elf_Word*)P;
4229 # elif defined(powerpc_HOST_ARCH)
4233 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
4234 j, (void*)offset, (void*)info,
4237 IF_DEBUG(linker,debugBelch( " ZERO" ));
4240 Elf_Sym sym = stab[ELF_R_SYM(info)];
4241 /* First see if it is a local symbol. */
4242 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
4243 /* Yes, so we can get the address directly from the ELF symbol
4245 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
4247 (ehdrC + shdr[ sym.st_shndx ].sh_offset
4248 + stab[ELF_R_SYM(info)].st_value);
4249 #ifdef ELF_FUNCTION_DESC
4250 /* Make a function descriptor for this function */
4251 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
4252 S = allocateFunctionDesc(S + A);
4257 /* No, so look up the name in our global table. */
4258 symbol = strtab + sym.st_name;
4259 S_tmp = lookupSymbol( symbol );
4260 S = (Elf_Addr)S_tmp;
4262 #ifdef ELF_FUNCTION_DESC
4263 /* If a function, already a function descriptor - we would
4264 have to copy it to add an offset. */
4265 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
4266 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
4270 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
4273 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
4276 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
4277 (void*)P, (void*)S, (void*)A ));
4278 /* checkProddableBlock ( oc, (void*)P ); */
4282 switch (ELF_R_TYPE(info)) {
4283 # if defined(sparc_HOST_ARCH)
4284 case R_SPARC_WDISP30:
4285 w1 = *pP & 0xC0000000;
4286 w2 = (Elf_Word)((value - P) >> 2);
4287 ASSERT((w2 & 0xC0000000) == 0);
4292 w1 = *pP & 0xFFC00000;
4293 w2 = (Elf_Word)(value >> 10);
4294 ASSERT((w2 & 0xFFC00000) == 0);
4300 w2 = (Elf_Word)(value & 0x3FF);
4301 ASSERT((w2 & ~0x3FF) == 0);
4306 /* According to the Sun documentation:
4308 This relocation type resembles R_SPARC_32, except it refers to an
4309 unaligned word. That is, the word to be relocated must be treated
4310 as four separate bytes with arbitrary alignment, not as a word
4311 aligned according to the architecture requirements.
4314 w2 = (Elf_Word)value;
4316 // SPARC doesn't do misaligned writes of 32 bit words,
4317 // so we have to do this one byte-at-a-time.
4318 char *pPc = (char*)pP;
4319 pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
4320 pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
4321 pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
4322 pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
4326 w2 = (Elf_Word)value;
4329 # elif defined(powerpc_HOST_ARCH)
4330 case R_PPC_ADDR16_LO:
4331 *(Elf32_Half*) P = value;
4334 case R_PPC_ADDR16_HI:
4335 *(Elf32_Half*) P = value >> 16;
4338 case R_PPC_ADDR16_HA:
4339 *(Elf32_Half*) P = (value + 0x8000) >> 16;
4343 *(Elf32_Word *) P = value;
4347 *(Elf32_Word *) P = value - P;
4353 if( delta << 6 >> 6 != delta )
4355 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
4359 if( value == 0 || delta << 6 >> 6 != delta )
4361 barf( "Unable to make SymbolExtra for #%d",
4367 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
4368 | (delta & 0x3fffffc);
4372 #if x86_64_HOST_ARCH
4374 *(Elf64_Xword *)P = value;
4379 #if defined(ALWAYS_PIC)
4380 barf("R_X86_64_PC32 relocation, but ALWAYS_PIC.");
4382 StgInt64 off = value - P;
4383 if (off >= 0x7fffffffL || off < -0x80000000L) {
4384 #if X86_64_ELF_NONPIC_HACK
4385 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4387 off = pltAddress + A - P;
4389 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4390 symbol, off, oc->fileName );
4393 *(Elf64_Word *)P = (Elf64_Word)off;
4400 StgInt64 off = value - P;
4401 *(Elf64_Word *)P = (Elf64_Word)off;
4406 #if defined(ALWAYS_PIC)
4407 barf("R_X86_64_32 relocation, but ALWAYS_PIC.");
4409 if (value >= 0x7fffffffL) {
4410 #if X86_64_ELF_NONPIC_HACK
4411 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4413 value = pltAddress + A;
4415 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4416 symbol, value, oc->fileName );
4419 *(Elf64_Word *)P = (Elf64_Word)value;
4424 #if defined(ALWAYS_PIC)
4425 barf("R_X86_64_32S relocation, but ALWAYS_PIC.");
4427 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
4428 #if X86_64_ELF_NONPIC_HACK
4429 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4431 value = pltAddress + A;
4433 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
4434 symbol, value, oc->fileName );
4437 *(Elf64_Sword *)P = (Elf64_Sword)value;
4441 case R_X86_64_GOTPCREL:
4443 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
4444 StgInt64 off = gotAddress + A - P;
4445 *(Elf64_Word *)P = (Elf64_Word)off;
4449 case R_X86_64_PLT32:
4451 #if defined(ALWAYS_PIC)
4452 barf("R_X86_64_PLT32 relocation, but ALWAYS_PIC.");
4454 StgInt64 off = value - P;
4455 if (off >= 0x7fffffffL || off < -0x80000000L) {
4456 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
4458 off = pltAddress + A - P;
4460 *(Elf64_Word *)P = (Elf64_Word)off;
4467 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
4468 oc->fileName, (lnat)ELF_R_TYPE(info));
4477 ocResolve_ELF ( ObjectCode* oc )
4480 char* ehdrC = (char*)(oc->image);
4481 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
4482 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
4484 /* Process the relocation sections. */
4485 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
4486 if (shdr[shnum].sh_type == SHT_REL) {
4487 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr, shnum );
4491 if (shdr[shnum].sh_type == SHT_RELA) {
4492 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr, shnum );
4497 #if defined(powerpc_HOST_ARCH)
4498 ocFlushInstructionCache( oc );
4505 * PowerPC & X86_64 ELF specifics
4508 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
4510 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
4516 ehdr = (Elf_Ehdr *) oc->image;
4517 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
4519 for( i = 0; i < ehdr->e_shnum; i++ )
4520 if( shdr[i].sh_type == SHT_SYMTAB )
4523 if( i == ehdr->e_shnum )
4525 // Not having a symbol table is not in principle a problem.
4526 // When an object file has no symbols then the 'strip' program
4527 // typically will remove the symbol table entirely.
4528 IF_DEBUG(linker, debugBelch( "The ELF file %s contains no symtab\n",
4529 oc->archiveMemberName ? oc->archiveMemberName : oc->fileName ));
4533 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
4535 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
4536 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
4541 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
4544 #endif /* powerpc */
4548 /* --------------------------------------------------------------------------
4550 * ------------------------------------------------------------------------*/
4552 #if defined(OBJFORMAT_MACHO)
4555 Support for MachO linking on Darwin/MacOS X
4556 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
4558 I hereby formally apologize for the hackish nature of this code.
4559 Things that need to be done:
4560 *) implement ocVerifyImage_MachO
4561 *) add still more sanity checks.
4564 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4565 #define mach_header mach_header_64
4566 #define segment_command segment_command_64
4567 #define section section_64
4568 #define nlist nlist_64
4571 #ifdef powerpc_HOST_ARCH
4573 ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4575 struct mach_header *header = (struct mach_header *) oc->image;
4576 struct load_command *lc = (struct load_command *) (header + 1);
4579 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n"));
4581 for (i = 0; i < header->ncmds; i++) {
4582 if (lc->cmd == LC_SYMTAB) {
4584 // Find out the first and last undefined external
4585 // symbol, so we don't have to allocate too many
4586 // jump islands/GOT entries.
4588 struct symtab_command *symLC = (struct symtab_command *) lc;
4589 unsigned min = symLC->nsyms, max = 0;
4590 struct nlist *nlist =
4591 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
4594 for (i = 0; i < symLC->nsyms; i++) {
4596 if (nlist[i].n_type & N_STAB) {
4598 } else if (nlist[i].n_type & N_EXT) {
4600 if((nlist[i].n_type & N_TYPE) == N_UNDF
4601 && (nlist[i].n_value == 0)) {
4615 return ocAllocateSymbolExtras(oc, max - min + 1, min);
4621 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4624 return ocAllocateSymbolExtras(oc,0,0);
4628 #ifdef x86_64_HOST_ARCH
4630 ocAllocateSymbolExtras_MachO(ObjectCode* oc)
4632 struct mach_header *header = (struct mach_header *) oc->image;
4633 struct load_command *lc = (struct load_command *) (header + 1);
4636 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: start\n"));
4638 for (i = 0; i < header->ncmds; i++) {
4639 if (lc->cmd == LC_SYMTAB) {
4641 // Just allocate one entry for every symbol
4642 struct symtab_command *symLC = (struct symtab_command *) lc;
4644 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: allocate %d symbols\n", symLC->nsyms));
4645 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: done\n"));
4646 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
4649 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
4652 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: allocated no symbols\n"));
4653 IF_DEBUG(linker, debugBelch("ocAllocateSymbolExtras_MachO: done\n"));
4654 return ocAllocateSymbolExtras(oc,0,0);
4659 ocVerifyImage_MachO(ObjectCode * oc)
4661 char *image = (char*) oc->image;
4662 struct mach_header *header = (struct mach_header*) image;
4664 IF_DEBUG(linker, debugBelch("ocVerifyImage_MachO: start\n"));
4666 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
4667 if(header->magic != MH_MAGIC_64) {
4668 errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4669 oc->fileName, MH_MAGIC_64, header->magic);
4673 if(header->magic != MH_MAGIC) {
4674 errorBelch("%s: Bad magic. Expected: %08x, got: %08x.\n",
4675 oc->fileName, MH_MAGIC, header->magic);
4680 // FIXME: do some more verifying here
4681 IF_DEBUG(linker, debugBelch("ocVerifyImage_MachO: done\n"));
4689 struct symtab_command *symLC,
4690 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
4691 unsigned long *indirectSyms,
4692 struct nlist *nlist)
4695 size_t itemSize = 4;
4697 IF_DEBUG(linker, debugBelch("resolveImports: start\n"));
4700 int isJumpTable = 0;
4702 if (strcmp(sect->sectname,"__jump_table") == 0) {
4705 ASSERT(sect->reserved2 == itemSize);
4710 for(i=0; i*itemSize < sect->size;i++)
4712 // according to otool, reserved1 contains the first index into the indirect symbol table
4713 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
4714 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4717 IF_DEBUG(linker, debugBelch("resolveImports: resolving %s\n", nm));
4719 if ((symbol->n_type & N_TYPE) == N_UNDF
4720 && (symbol->n_type & N_EXT) && (symbol->n_value != 0)) {
4721 addr = (void*) (symbol->n_value);
4722 IF_DEBUG(linker, debugBelch("resolveImports: undefined external %s has value %p\n", nm, addr));
4724 addr = lookupSymbol(nm);
4725 IF_DEBUG(linker, debugBelch("resolveImports: looking up %s, %p\n", nm, addr));
4729 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
4736 checkProddableBlock(oc,image + sect->offset + i*itemSize);
4738 *(image + sect->offset + i * itemSize) = 0xe9; // jmp opcode
4739 *(unsigned*)(image + sect->offset + i*itemSize + 1)
4740 = (char*)addr - (image + sect->offset + i*itemSize + 5);
4745 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
4746 ((void**)(image + sect->offset))[i] = addr;
4750 IF_DEBUG(linker, debugBelch("resolveImports: done\n"));
4754 static unsigned long relocateAddress(
4757 struct section* sections,
4758 unsigned long address)
4761 IF_DEBUG(linker, debugBelch("relocateAddress: start\n"));
4762 for (i = 0; i < nSections; i++)
4764 IF_DEBUG(linker, debugBelch(" relocating address in section %d\n", i));
4765 if (sections[i].addr <= address
4766 && address < sections[i].addr + sections[i].size)
4768 return (unsigned long)oc->image
4769 + sections[i].offset + address - sections[i].addr;
4772 barf("Invalid Mach-O file:"
4773 "Address out of bounds while relocating object file");
4777 static int relocateSection(
4780 struct symtab_command *symLC, struct nlist *nlist,
4781 int nSections, struct section* sections, struct section *sect)
4783 struct relocation_info *relocs;
4786 IF_DEBUG(linker, debugBelch("relocateSection: start\n"));
4788 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
4790 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
4792 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
4794 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
4798 IF_DEBUG(linker, debugBelch("relocateSection: number of relocations: %d\n", n));
4800 relocs = (struct relocation_info*) (image + sect->reloff);
4804 #ifdef x86_64_HOST_ARCH
4805 struct relocation_info *reloc = &relocs[i];
4807 char *thingPtr = image + sect->offset + reloc->r_address;
4809 /* We shouldn't need to initialise this, but gcc on OS X 64 bit
4810 complains that it may be used uninitialized if we don't */
4813 int type = reloc->r_type;
4815 checkProddableBlock(oc,thingPtr);
4816 switch(reloc->r_length)
4819 thing = *(uint8_t*)thingPtr;
4820 baseValue = (uint64_t)thingPtr + 1;
4823 thing = *(uint16_t*)thingPtr;
4824 baseValue = (uint64_t)thingPtr + 2;
4827 thing = *(uint32_t*)thingPtr;
4828 baseValue = (uint64_t)thingPtr + 4;
4831 thing = *(uint64_t*)thingPtr;
4832 baseValue = (uint64_t)thingPtr + 8;
4835 barf("Unknown size.");
4839 debugBelch("relocateSection: length = %d, thing = %" PRId64 ", baseValue = %p\n",
4840 reloc->r_length, thing, (char *)baseValue));
4842 if (type == X86_64_RELOC_GOT
4843 || type == X86_64_RELOC_GOT_LOAD)
4845 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4846 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4848 IF_DEBUG(linker, debugBelch("relocateSection: making jump island for %s, extern = %d, X86_64_RELOC_GOT\n", nm, reloc->r_extern));
4849 ASSERT(reloc->r_extern);
4850 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, (unsigned long)lookupSymbol(nm))->addr;
4852 type = X86_64_RELOC_SIGNED;
4854 else if(reloc->r_extern)
4856 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4857 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4859 IF_DEBUG(linker, debugBelch("relocateSection: looking up external symbol %s\n", nm));
4860 IF_DEBUG(linker, debugBelch(" : type = %d\n", symbol->n_type));
4861 IF_DEBUG(linker, debugBelch(" : sect = %d\n", symbol->n_sect));
4862 IF_DEBUG(linker, debugBelch(" : desc = %d\n", symbol->n_desc));
4863 IF_DEBUG(linker, debugBelch(" : value = %p\n", (void *)symbol->n_value));
4864 if ((symbol->n_type & N_TYPE) == N_SECT) {
4865 value = relocateAddress(oc, nSections, sections,
4867 IF_DEBUG(linker, debugBelch("relocateSection, defined external symbol %s, relocated address %p\n", nm, (void *)value));
4870 value = (uint64_t) lookupSymbol(nm);
4871 IF_DEBUG(linker, debugBelch("relocateSection: external symbol %s, address %p\n", nm, (void *)value));
4876 // If the relocation is not through the global offset table
4877 // or external, then set the value to the baseValue. This
4878 // will leave displacements into the __const section
4879 // unchanged (as they ought to be).
4884 IF_DEBUG(linker, debugBelch("relocateSection: value = %p\n", (void *)value));
4886 if (type == X86_64_RELOC_BRANCH)
4888 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4890 ASSERT(reloc->r_extern);
4891 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4894 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4895 type = X86_64_RELOC_SIGNED;
4900 case X86_64_RELOC_UNSIGNED:
4901 ASSERT(!reloc->r_pcrel);
4904 case X86_64_RELOC_SIGNED:
4905 case X86_64_RELOC_SIGNED_1:
4906 case X86_64_RELOC_SIGNED_2:
4907 case X86_64_RELOC_SIGNED_4:
4908 ASSERT(reloc->r_pcrel);
4909 thing += value - baseValue;
4911 case X86_64_RELOC_SUBTRACTOR:
4912 ASSERT(!reloc->r_pcrel);
4916 barf("unkown relocation");
4919 switch(reloc->r_length)
4922 *(uint8_t*)thingPtr = thing;
4925 *(uint16_t*)thingPtr = thing;
4928 *(uint32_t*)thingPtr = thing;
4931 *(uint64_t*)thingPtr = thing;
4935 if(relocs[i].r_address & R_SCATTERED)
4937 struct scattered_relocation_info *scat =
4938 (struct scattered_relocation_info*) &relocs[i];
4942 if(scat->r_length == 2)
4944 unsigned long word = 0;
4945 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4946 checkProddableBlock(oc,wordPtr);
4948 // Note on relocation types:
4949 // i386 uses the GENERIC_RELOC_* types,
4950 // while ppc uses special PPC_RELOC_* types.
4951 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4952 // in both cases, all others are different.
4953 // Therefore, we use GENERIC_RELOC_VANILLA
4954 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4955 // and use #ifdefs for the other types.
4957 // Step 1: Figure out what the relocated value should be
4958 if (scat->r_type == GENERIC_RELOC_VANILLA) {
4960 + (unsigned long) relocateAddress(oc,
4966 #ifdef powerpc_HOST_ARCH
4967 else if(scat->r_type == PPC_RELOC_SECTDIFF
4968 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4969 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4970 || scat->r_type == PPC_RELOC_HA16_SECTDIFF
4971 || scat->r_type == PPC_RELOC_LOCAL_SECTDIFF)
4973 else if(scat->r_type == GENERIC_RELOC_SECTDIFF
4974 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4977 struct scattered_relocation_info *pair =
4978 (struct scattered_relocation_info*) &relocs[i+1];
4980 if (!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR) {
4981 barf("Invalid Mach-O file: "
4982 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4985 word = (unsigned long)
4986 (relocateAddress(oc, nSections, sections, scat->r_value)
4987 - relocateAddress(oc, nSections, sections, pair->r_value));
4990 #ifdef powerpc_HOST_ARCH
4991 else if(scat->r_type == PPC_RELOC_HI16
4992 || scat->r_type == PPC_RELOC_LO16
4993 || scat->r_type == PPC_RELOC_HA16
4994 || scat->r_type == PPC_RELOC_LO14)
4995 { // these are generated by label+offset things
4996 struct relocation_info *pair = &relocs[i+1];
4998 if ((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR) {
4999 barf("Invalid Mach-O file: "
5000 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
5003 if(scat->r_type == PPC_RELOC_LO16)
5005 word = ((unsigned short*) wordPtr)[1];
5006 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
5008 else if(scat->r_type == PPC_RELOC_LO14)
5010 barf("Unsupported Relocation: PPC_RELOC_LO14");
5011 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
5012 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
5014 else if(scat->r_type == PPC_RELOC_HI16)
5016 word = ((unsigned short*) wordPtr)[1] << 16;
5017 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
5019 else if(scat->r_type == PPC_RELOC_HA16)
5021 word = ((unsigned short*) wordPtr)[1] << 16;
5022 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
5026 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
5033 barf ("Don't know how to handle this Mach-O "
5034 "scattered relocation entry: "
5035 "object file %s; entry type %ld; "
5037 OC_INFORMATIVE_FILENAME(oc),
5043 #ifdef powerpc_HOST_ARCH
5044 if(scat->r_type == GENERIC_RELOC_VANILLA
5045 || scat->r_type == PPC_RELOC_SECTDIFF)
5047 if(scat->r_type == GENERIC_RELOC_VANILLA
5048 || scat->r_type == GENERIC_RELOC_SECTDIFF
5049 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
5054 #ifdef powerpc_HOST_ARCH
5055 else if (scat->r_type == PPC_RELOC_LO16_SECTDIFF
5056 || scat->r_type == PPC_RELOC_LO16)
5058 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
5060 else if (scat->r_type == PPC_RELOC_HI16_SECTDIFF
5061 || scat->r_type == PPC_RELOC_HI16)
5063 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
5065 else if (scat->r_type == PPC_RELOC_HA16_SECTDIFF
5066 || scat->r_type == PPC_RELOC_HA16)
5068 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
5069 + ((word & (1<<15)) ? 1 : 0);
5075 barf("Can't handle Mach-O scattered relocation entry "
5076 "with this r_length tag: "
5077 "object file %s; entry type %ld; "
5078 "r_length tag %ld; address %#lx\n",
5079 OC_INFORMATIVE_FILENAME(oc),
5086 else /* scat->r_pcrel */
5088 barf("Don't know how to handle *PC-relative* Mach-O "
5089 "scattered relocation entry: "
5090 "object file %s; entry type %ld; address %#lx\n",
5091 OC_INFORMATIVE_FILENAME(oc),
5098 else /* !(relocs[i].r_address & R_SCATTERED) */
5100 struct relocation_info *reloc = &relocs[i];
5101 if (reloc->r_pcrel && !reloc->r_extern) {
5102 IF_DEBUG(linker, debugBelch("relocateSection: pc relative but not external, skipping\n"));
5106 if (reloc->r_length == 2) {
5107 unsigned long word = 0;
5108 #ifdef powerpc_HOST_ARCH
5109 unsigned long jumpIsland = 0;
5110 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
5111 // to avoid warning and to catch
5115 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
5116 checkProddableBlock(oc,wordPtr);
5118 if (reloc->r_type == GENERIC_RELOC_VANILLA) {
5121 #ifdef powerpc_HOST_ARCH
5122 else if (reloc->r_type == PPC_RELOC_LO16) {
5123 word = ((unsigned short*) wordPtr)[1];
5124 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
5126 else if (reloc->r_type == PPC_RELOC_HI16) {
5127 word = ((unsigned short*) wordPtr)[1] << 16;
5128 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
5130 else if (reloc->r_type == PPC_RELOC_HA16) {
5131 word = ((unsigned short*) wordPtr)[1] << 16;
5132 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
5134 else if (reloc->r_type == PPC_RELOC_BR24) {
5136 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
5140 barf("Can't handle this Mach-O relocation entry "
5142 "object file %s; entry type %ld; address %#lx\n",
5143 OC_INFORMATIVE_FILENAME(oc),
5149 if (!reloc->r_extern) {
5150 long delta = sections[reloc->r_symbolnum-1].offset
5151 - sections[reloc->r_symbolnum-1].addr
5157 struct nlist *symbol = &nlist[reloc->r_symbolnum];
5158 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
5159 void *symbolAddress = lookupSymbol(nm);
5161 if (!symbolAddress) {
5162 errorBelch("\nunknown symbol `%s'", nm);
5166 if (reloc->r_pcrel) {
5167 #ifdef powerpc_HOST_ARCH
5168 // In the .o file, this should be a relative jump to NULL
5169 // and we'll change it to a relative jump to the symbol
5170 ASSERT(word + reloc->r_address == 0);
5171 jumpIsland = (unsigned long)
5172 &makeSymbolExtra(oc,
5174 (unsigned long) symbolAddress)
5176 if (jumpIsland != 0) {
5177 offsetToJumpIsland = word + jumpIsland
5178 - (((long)image) + sect->offset - sect->addr);
5181 word += (unsigned long) symbolAddress
5182 - (((long)image) + sect->offset - sect->addr);
5185 word += (unsigned long) symbolAddress;
5189 if (reloc->r_type == GENERIC_RELOC_VANILLA) {
5193 #ifdef powerpc_HOST_ARCH
5194 else if(reloc->r_type == PPC_RELOC_LO16)
5196 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
5200 else if(reloc->r_type == PPC_RELOC_HI16)
5202 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
5206 else if(reloc->r_type == PPC_RELOC_HA16)
5208 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
5209 + ((word & (1<<15)) ? 1 : 0);
5213 else if(reloc->r_type == PPC_RELOC_BR24)
5215 if ((word & 0x03) != 0) {
5216 barf("%s: unconditional relative branch with a displacement "
5217 "which isn't a multiple of 4 bytes: %#lx",
5218 OC_INFORMATIVE_FILENAME(oc),
5222 if((word & 0xFE000000) != 0xFE000000 &&
5223 (word & 0xFE000000) != 0x00000000) {
5224 // The branch offset is too large.
5225 // Therefore, we try to use a jump island.
5226 if (jumpIsland == 0) {
5227 barf("%s: unconditional relative branch out of range: "
5228 "no jump island available: %#lx",
5229 OC_INFORMATIVE_FILENAME(oc),
5233 word = offsetToJumpIsland;
5235 if((word & 0xFE000000) != 0xFE000000 &&
5236 (word & 0xFE000000) != 0x00000000) {
5237 barf("%s: unconditional relative branch out of range: "
5238 "jump island out of range: %#lx",
5239 OC_INFORMATIVE_FILENAME(oc),
5243 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
5250 barf("Can't handle Mach-O relocation entry (not scattered) "
5251 "with this r_length tag: "
5252 "object file %s; entry type %ld; "
5253 "r_length tag %ld; address %#lx\n",
5254 OC_INFORMATIVE_FILENAME(oc),
5264 IF_DEBUG(linker, debugBelch("relocateSection: done\n"));
5269 ocGetNames_MachO(ObjectCode* oc)
5271 char *image = (char*) oc->image;
5272 struct mach_header *header = (struct mach_header*) image;
5273 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
5274 unsigned i,curSymbol = 0;
5275 struct segment_command *segLC = NULL;
5276 struct section *sections;
5277 struct symtab_command *symLC = NULL;
5278 struct nlist *nlist;
5279 unsigned long commonSize = 0;
5280 char *commonStorage = NULL;
5281 unsigned long commonCounter;
5283 IF_DEBUG(linker,debugBelch("ocGetNames_MachO: start\n"));
5285 for(i=0;i<header->ncmds;i++)
5287 if (lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) {
5288 segLC = (struct segment_command*) lc;
5290 else if (lc->cmd == LC_SYMTAB) {
5291 symLC = (struct symtab_command*) lc;
5294 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
5297 sections = (struct section*) (segLC+1);
5298 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
5302 barf("ocGetNames_MachO: no segment load command");
5305 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: will load %d sections\n", segLC->nsects));
5306 for(i=0;i<segLC->nsects;i++)
5308 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: section %d\n", i));
5310 if (sections[i].size == 0) {
5311 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: found a zero length section, skipping\n"));
5315 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
5317 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
5318 "ocGetNames_MachO(common symbols)");
5319 sections[i].offset = zeroFillArea - image;
5322 if (!strcmp(sections[i].sectname,"__text")) {
5324 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __text section\n"));
5325 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
5326 (void*) (image + sections[i].offset),
5327 (void*) (image + sections[i].offset + sections[i].size));
5329 else if (!strcmp(sections[i].sectname,"__const")) {
5331 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __const section\n"));
5332 addSection(oc, SECTIONKIND_RWDATA,
5333 (void*) (image + sections[i].offset),
5334 (void*) (image + sections[i].offset + sections[i].size));
5336 else if (!strcmp(sections[i].sectname,"__data")) {
5338 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __data section\n"));
5339 addSection(oc, SECTIONKIND_RWDATA,
5340 (void*) (image + sections[i].offset),
5341 (void*) (image + sections[i].offset + sections[i].size));
5343 else if(!strcmp(sections[i].sectname,"__bss")
5344 || !strcmp(sections[i].sectname,"__common")) {
5346 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: adding __bss section\n"));
5347 addSection(oc, SECTIONKIND_RWDATA,
5348 (void*) (image + sections[i].offset),
5349 (void*) (image + sections[i].offset + sections[i].size));
5351 addProddableBlock(oc,
5352 (void *) (image + sections[i].offset),
5356 // count external symbols defined here
5359 for (i = 0; i < symLC->nsyms; i++) {
5360 if (nlist[i].n_type & N_STAB) {
5363 else if(nlist[i].n_type & N_EXT)
5365 if((nlist[i].n_type & N_TYPE) == N_UNDF
5366 && (nlist[i].n_value != 0))
5368 commonSize += nlist[i].n_value;
5371 else if((nlist[i].n_type & N_TYPE) == N_SECT)
5376 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: %d external symbols\n", oc->n_symbols));
5377 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
5378 "ocGetNames_MachO(oc->symbols)");
5382 for(i=0;i<symLC->nsyms;i++)
5384 if(nlist[i].n_type & N_STAB)
5386 else if((nlist[i].n_type & N_TYPE) == N_SECT)
5388 if(nlist[i].n_type & N_EXT)
5390 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
5391 if ((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm)) {
5392 // weak definition, and we already have a definition
5393 IF_DEBUG(linker, debugBelch(" weak: %s\n", nm));
5397 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting %s\n", nm));
5398 ghciInsertStrHashTable(oc->fileName, symhash, nm,
5400 + sections[nlist[i].n_sect-1].offset
5401 - sections[nlist[i].n_sect-1].addr
5402 + nlist[i].n_value);
5403 oc->symbols[curSymbol++] = nm;
5408 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: \t...not external, skipping\n"));
5413 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: \t...not defined in this section, skipping\n"));
5418 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
5419 commonCounter = (unsigned long)commonStorage;
5422 for (i = 0; i < symLC->nsyms; i++) {
5423 if((nlist[i].n_type & N_TYPE) == N_UNDF
5424 && (nlist[i].n_type & N_EXT)
5425 && (nlist[i].n_value != 0)) {
5427 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
5428 unsigned long sz = nlist[i].n_value;
5430 nlist[i].n_value = commonCounter;
5432 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: inserting common symbol: %s\n", nm));
5433 ghciInsertStrHashTable(oc->fileName, symhash, nm,
5434 (void*)commonCounter);
5435 oc->symbols[curSymbol++] = nm;
5437 commonCounter += sz;
5442 IF_DEBUG(linker, debugBelch("ocGetNames_MachO: done\n"));
5447 ocResolve_MachO(ObjectCode* oc)
5449 char *image = (char*) oc->image;
5450 struct mach_header *header = (struct mach_header*) image;
5451 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
5453 struct segment_command *segLC = NULL;
5454 struct section *sections;
5455 struct symtab_command *symLC = NULL;
5456 struct dysymtab_command *dsymLC = NULL;
5457 struct nlist *nlist;
5459 IF_DEBUG(linker, debugBelch("ocResolve_MachO: start\n"));
5460 for (i = 0; i < header->ncmds; i++)
5462 if (lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64) {
5463 segLC = (struct segment_command*) lc;
5464 IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a 32 or 64 bit segment load command\n"));
5466 else if (lc->cmd == LC_SYMTAB) {
5467 symLC = (struct symtab_command*) lc;
5468 IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a symbol table load command\n"));
5470 else if (lc->cmd == LC_DYSYMTAB) {
5471 dsymLC = (struct dysymtab_command*) lc;
5472 IF_DEBUG(linker, debugBelch("ocResolve_MachO: found a dynamic symbol table load command\n"));
5475 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
5478 sections = (struct section*) (segLC+1);
5479 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
5484 unsigned long *indirectSyms
5485 = (unsigned long*) (image + dsymLC->indirectsymoff);
5487 IF_DEBUG(linker, debugBelch("ocResolve_MachO: resolving dsymLC\n"));
5488 for (i = 0; i < segLC->nsects; i++)
5490 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
5491 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
5492 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
5494 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5497 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
5498 || !strcmp(sections[i].sectname,"__pointers"))
5500 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5503 else if(!strcmp(sections[i].sectname,"__jump_table"))
5505 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
5510 IF_DEBUG(linker, debugBelch("ocResolve_MachO: unknown section\n"));
5515 for(i=0;i<segLC->nsects;i++)
5517 IF_DEBUG(linker, debugBelch("ocResolve_MachO: relocating section %d\n", i));
5519 if (!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
5523 #if defined (powerpc_HOST_ARCH)
5524 ocFlushInstructionCache( oc );
5530 #ifdef powerpc_HOST_ARCH
5532 * The Mach-O object format uses leading underscores. But not everywhere.
5533 * There is a small number of runtime support functions defined in
5534 * libcc_dynamic.a whose name does not have a leading underscore.
5535 * As a consequence, we can't get their address from C code.
5536 * We have to use inline assembler just to take the address of a function.
5540 extern void* symbolsWithoutUnderscore[];
5543 machoInitSymbolsWithoutUnderscore(void)
5545 void **p = symbolsWithoutUnderscore;
5546 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
5548 #undef SymI_NeedsProto
5549 #define SymI_NeedsProto(x) \
5550 __asm__ volatile(".long " # x);
5552 RTS_MACHO_NOUNDERLINE_SYMBOLS
5554 __asm__ volatile(".text");
5556 #undef SymI_NeedsProto
5557 #define SymI_NeedsProto(x) \
5558 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
5560 RTS_MACHO_NOUNDERLINE_SYMBOLS
5562 #undef SymI_NeedsProto
5568 * Figure out by how much to shift the entire Mach-O file in memory
5569 * when loading so that its single segment ends up 16-byte-aligned
5572 machoGetMisalignment( FILE * f )
5574 struct mach_header header;
5578 int n = fread(&header, sizeof(header), 1, f);
5580 barf("machoGetMisalignment: can't read the Mach-O header");
5583 fseek(f, -sizeof(header), SEEK_CUR);
5585 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
5586 if(header.magic != MH_MAGIC_64) {
5587 barf("Bad magic. Expected: %08x, got: %08x.",
5588 MH_MAGIC_64, header.magic);
5591 if(header.magic != MH_MAGIC) {
5592 barf("Bad magic. Expected: %08x, got: %08x.",
5593 MH_MAGIC, header.magic);
5597 misalignment = (header.sizeofcmds + sizeof(header))
5600 return misalignment ? (16 - misalignment) : 0;