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>.
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 #ifdef HAVE_SYS_TYPES_H
37 #include <sys/types.h>
45 #ifdef HAVE_SYS_STAT_H
49 #if defined(HAVE_DLFCN_H)
53 #if defined(cygwin32_HOST_OS)
58 #ifdef HAVE_SYS_TIME_H
62 #include <sys/fcntl.h>
63 #include <sys/termios.h>
64 #include <sys/utime.h>
65 #include <sys/utsname.h>
69 #if defined(ia64_HOST_ARCH) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
74 #if defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
82 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
83 # define OBJFORMAT_ELF
84 # include <regex.h> // regex is already used by dlopen() so this is OK
85 // to use here without requiring an additional lib
86 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
87 # define OBJFORMAT_PEi386
90 #elif defined(darwin_HOST_OS)
91 # define OBJFORMAT_MACHO
93 # include <mach-o/loader.h>
94 # include <mach-o/nlist.h>
95 # include <mach-o/reloc.h>
96 #if !defined(HAVE_DLFCN_H)
97 # include <mach-o/dyld.h>
99 #if defined(powerpc_HOST_ARCH)
100 # include <mach-o/ppc/reloc.h>
102 #if defined(x86_64_HOST_ARCH)
103 # include <mach-o/x86_64/reloc.h>
107 /* Hash table mapping symbol names to Symbol */
108 static /*Str*/HashTable *symhash;
110 /* Hash table mapping symbol names to StgStablePtr */
111 static /*Str*/HashTable *stablehash;
113 /* List of currently loaded objects */
114 ObjectCode *objects = NULL; /* initially empty */
116 #if defined(OBJFORMAT_ELF)
117 static int ocVerifyImage_ELF ( ObjectCode* oc );
118 static int ocGetNames_ELF ( ObjectCode* oc );
119 static int ocResolve_ELF ( ObjectCode* oc );
120 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
121 static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
123 #elif defined(OBJFORMAT_PEi386)
124 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
125 static int ocGetNames_PEi386 ( ObjectCode* oc );
126 static int ocResolve_PEi386 ( ObjectCode* oc );
127 static void *lookupSymbolInDLLs ( unsigned char *lbl );
128 static void zapTrailingAtSign ( unsigned char *sym );
129 #elif defined(OBJFORMAT_MACHO)
130 static int ocVerifyImage_MachO ( ObjectCode* oc );
131 static int ocGetNames_MachO ( ObjectCode* oc );
132 static int ocResolve_MachO ( ObjectCode* oc );
134 static int machoGetMisalignment( FILE * );
135 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
136 static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
138 #ifdef powerpc_HOST_ARCH
139 static void machoInitSymbolsWithoutUnderscore( void );
143 /* on x86_64 we have a problem with relocating symbol references in
144 * code that was compiled without -fPIC. By default, the small memory
145 * model is used, which assumes that symbol references can fit in a
146 * 32-bit slot. The system dynamic linker makes this work for
147 * references to shared libraries by either (a) allocating a jump
148 * table slot for code references, or (b) moving the symbol at load
149 * time (and copying its contents, if necessary) for data references.
151 * We unfortunately can't tell whether symbol references are to code
152 * or data. So for now we assume they are code (the vast majority
153 * are), and allocate jump-table slots. Unfortunately this will
154 * SILENTLY generate crashing code for data references. This hack is
155 * enabled by X86_64_ELF_NONPIC_HACK.
157 * One workaround is to use shared Haskell libraries. This is
158 * coming. Another workaround is to keep the static libraries but
159 * compile them with -fPIC, because that will generate PIC references
160 * to data which can be relocated. The PIC code is still too green to
161 * do this systematically, though.
164 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
166 * Naming Scheme for Symbol Macros
168 * SymI_*: symbol is internal to the RTS. It resides in an object
169 * file/library that is statically.
170 * SymE_*: symbol is external to the RTS library. It might be linked
173 * Sym*_HasProto : the symbol prototype is imported in an include file
174 * or defined explicitly
175 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
176 * default proto extern void sym(void);
178 #define X86_64_ELF_NONPIC_HACK 1
180 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
181 * small memory model on this architecture (see gcc docs,
184 * MAP_32BIT not available on OpenBSD/amd64
186 #if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
187 #define TRY_MAP_32BIT MAP_32BIT
189 #define TRY_MAP_32BIT 0
193 * Due to the small memory model (see above), on x86_64 we have to map
194 * all our non-PIC object files into the low 2Gb of the address space
195 * (why 2Gb and not 4Gb? Because all addresses must be reachable
196 * using a 32-bit signed PC-relative offset). On Linux we can do this
197 * using the MAP_32BIT flag to mmap(), however on other OSs
198 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
199 * can't do this. So on these systems, we have to pick a base address
200 * in the low 2Gb of the address space and try to allocate memory from
203 * We pick a default address based on the OS, but also make this
204 * configurable via an RTS flag (+RTS -xm)
206 #if defined(x86_64_HOST_ARCH)
208 #if defined(MAP_32BIT)
209 // Try to use MAP_32BIT
210 #define MMAP_32BIT_BASE_DEFAULT 0
213 #define MMAP_32BIT_BASE_DEFAULT 0x40000000
216 static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
219 /* MAP_ANONYMOUS is MAP_ANON on some systems, e.g. OpenBSD */
220 #if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
221 #define MAP_ANONYMOUS MAP_ANON
224 /* -----------------------------------------------------------------------------
225 * Built-in symbols from the RTS
228 typedef struct _RtsSymbolVal {
233 #define Maybe_Stable_Names SymI_HasProto(stg_mkWeakzh) \
234 SymI_HasProto(stg_mkWeakForeignEnvzh) \
235 SymI_HasProto(stg_makeStableNamezh) \
236 SymI_HasProto(stg_finalizzeWeakzh)
238 #if !defined (mingw32_HOST_OS)
239 #define RTS_POSIX_ONLY_SYMBOLS \
240 SymI_HasProto(__hscore_get_saved_termios) \
241 SymI_HasProto(__hscore_set_saved_termios) \
242 SymI_HasProto(shutdownHaskellAndSignal) \
243 SymI_HasProto(lockFile) \
244 SymI_HasProto(unlockFile) \
245 SymI_HasProto(signal_handlers) \
246 SymI_HasProto(stg_sig_install) \
247 SymI_NeedsProto(nocldstop)
250 #if defined (cygwin32_HOST_OS)
251 #define RTS_MINGW_ONLY_SYMBOLS /**/
252 /* Don't have the ability to read import libs / archives, so
253 * we have to stupidly list a lot of what libcygwin.a
256 #define RTS_CYGWIN_ONLY_SYMBOLS \
257 SymI_HasProto(regfree) \
258 SymI_HasProto(regexec) \
259 SymI_HasProto(regerror) \
260 SymI_HasProto(regcomp) \
261 SymI_HasProto(__errno) \
262 SymI_HasProto(access) \
263 SymI_HasProto(chmod) \
264 SymI_HasProto(chdir) \
265 SymI_HasProto(close) \
266 SymI_HasProto(creat) \
268 SymI_HasProto(dup2) \
269 SymI_HasProto(fstat) \
270 SymI_HasProto(fcntl) \
271 SymI_HasProto(getcwd) \
272 SymI_HasProto(getenv) \
273 SymI_HasProto(lseek) \
274 SymI_HasProto(open) \
275 SymI_HasProto(fpathconf) \
276 SymI_HasProto(pathconf) \
277 SymI_HasProto(stat) \
279 SymI_HasProto(tanh) \
280 SymI_HasProto(cosh) \
281 SymI_HasProto(sinh) \
282 SymI_HasProto(atan) \
283 SymI_HasProto(acos) \
284 SymI_HasProto(asin) \
290 SymI_HasProto(sqrt) \
291 SymI_HasProto(localtime_r) \
292 SymI_HasProto(gmtime_r) \
293 SymI_HasProto(mktime) \
294 SymI_NeedsProto(_imp___tzname) \
295 SymI_HasProto(gettimeofday) \
296 SymI_HasProto(timezone) \
297 SymI_HasProto(tcgetattr) \
298 SymI_HasProto(tcsetattr) \
299 SymI_HasProto(memcpy) \
300 SymI_HasProto(memmove) \
301 SymI_HasProto(realloc) \
302 SymI_HasProto(malloc) \
303 SymI_HasProto(free) \
304 SymI_HasProto(fork) \
305 SymI_HasProto(lstat) \
306 SymI_HasProto(isatty) \
307 SymI_HasProto(mkdir) \
308 SymI_HasProto(opendir) \
309 SymI_HasProto(readdir) \
310 SymI_HasProto(rewinddir) \
311 SymI_HasProto(closedir) \
312 SymI_HasProto(link) \
313 SymI_HasProto(mkfifo) \
314 SymI_HasProto(pipe) \
315 SymI_HasProto(read) \
316 SymI_HasProto(rename) \
317 SymI_HasProto(rmdir) \
318 SymI_HasProto(select) \
319 SymI_HasProto(system) \
320 SymI_HasProto(write) \
321 SymI_HasProto(strcmp) \
322 SymI_HasProto(strcpy) \
323 SymI_HasProto(strncpy) \
324 SymI_HasProto(strerror) \
325 SymI_HasProto(sigaddset) \
326 SymI_HasProto(sigemptyset) \
327 SymI_HasProto(sigprocmask) \
328 SymI_HasProto(umask) \
329 SymI_HasProto(uname) \
330 SymI_HasProto(unlink) \
331 SymI_HasProto(utime) \
332 SymI_HasProto(waitpid)
334 #elif !defined(mingw32_HOST_OS)
335 #define RTS_MINGW_ONLY_SYMBOLS /**/
336 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
337 #else /* defined(mingw32_HOST_OS) */
338 #define RTS_POSIX_ONLY_SYMBOLS /**/
339 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
341 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
343 #define RTS_MINGW_EXTRA_SYMS \
344 SymI_NeedsProto(_imp____mb_cur_max) \
345 SymI_NeedsProto(_imp___pctype)
347 #define RTS_MINGW_EXTRA_SYMS
350 #if HAVE_GETTIMEOFDAY
351 #define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
353 #define RTS_MINGW_GETTIMEOFDAY_SYM /**/
356 #if HAVE___MINGW_VFPRINTF
357 #define RTS___MINGW_VFPRINTF_SYM SymI_HasProto(__mingw_vfprintf)
359 #define RTS___MINGW_VFPRINTF_SYM /**/
362 /* These are statically linked from the mingw libraries into the ghc
363 executable, so we have to employ this hack. */
364 #define RTS_MINGW_ONLY_SYMBOLS \
365 SymI_HasProto(stg_asyncReadzh) \
366 SymI_HasProto(stg_asyncWritezh) \
367 SymI_HasProto(stg_asyncDoProczh) \
368 SymI_HasProto(memset) \
369 SymI_HasProto(inet_ntoa) \
370 SymI_HasProto(inet_addr) \
371 SymI_HasProto(htonl) \
372 SymI_HasProto(recvfrom) \
373 SymI_HasProto(listen) \
374 SymI_HasProto(bind) \
375 SymI_HasProto(shutdown) \
376 SymI_HasProto(connect) \
377 SymI_HasProto(htons) \
378 SymI_HasProto(ntohs) \
379 SymI_HasProto(getservbyname) \
380 SymI_HasProto(getservbyport) \
381 SymI_HasProto(getprotobynumber) \
382 SymI_HasProto(getprotobyname) \
383 SymI_HasProto(gethostbyname) \
384 SymI_HasProto(gethostbyaddr) \
385 SymI_HasProto(gethostname) \
386 SymI_HasProto(strcpy) \
387 SymI_HasProto(strncpy) \
388 SymI_HasProto(abort) \
389 SymI_NeedsProto(_alloca) \
390 SymI_NeedsProto(isxdigit) \
391 SymI_NeedsProto(isupper) \
392 SymI_NeedsProto(ispunct) \
393 SymI_NeedsProto(islower) \
394 SymI_NeedsProto(isspace) \
395 SymI_NeedsProto(isprint) \
396 SymI_NeedsProto(isdigit) \
397 SymI_NeedsProto(iscntrl) \
398 SymI_NeedsProto(isalpha) \
399 SymI_NeedsProto(isalnum) \
400 SymI_NeedsProto(isascii) \
401 RTS___MINGW_VFPRINTF_SYM \
402 SymI_HasProto(strcmp) \
403 SymI_HasProto(memmove) \
404 SymI_HasProto(realloc) \
405 SymI_HasProto(malloc) \
407 SymI_HasProto(tanh) \
408 SymI_HasProto(cosh) \
409 SymI_HasProto(sinh) \
410 SymI_HasProto(atan) \
411 SymI_HasProto(acos) \
412 SymI_HasProto(asin) \
418 SymI_HasProto(sqrt) \
419 SymI_HasProto(powf) \
420 SymI_HasProto(tanhf) \
421 SymI_HasProto(coshf) \
422 SymI_HasProto(sinhf) \
423 SymI_HasProto(atanf) \
424 SymI_HasProto(acosf) \
425 SymI_HasProto(asinf) \
426 SymI_HasProto(tanf) \
427 SymI_HasProto(cosf) \
428 SymI_HasProto(sinf) \
429 SymI_HasProto(expf) \
430 SymI_HasProto(logf) \
431 SymI_HasProto(sqrtf) \
433 SymI_HasProto(erfc) \
434 SymI_HasProto(erff) \
435 SymI_HasProto(erfcf) \
436 SymI_HasProto(memcpy) \
437 SymI_HasProto(rts_InstallConsoleEvent) \
438 SymI_HasProto(rts_ConsoleHandlerDone) \
439 SymI_NeedsProto(mktime) \
440 SymI_NeedsProto(_imp___timezone) \
441 SymI_NeedsProto(_imp___tzname) \
442 SymI_NeedsProto(_imp__tzname) \
443 SymI_NeedsProto(_imp___iob) \
444 SymI_NeedsProto(_imp___osver) \
445 SymI_NeedsProto(localtime) \
446 SymI_NeedsProto(gmtime) \
447 SymI_NeedsProto(opendir) \
448 SymI_NeedsProto(readdir) \
449 SymI_NeedsProto(rewinddir) \
450 RTS_MINGW_EXTRA_SYMS \
451 RTS_MINGW_GETTIMEOFDAY_SYM \
452 SymI_NeedsProto(closedir)
455 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
456 #define RTS_DARWIN_ONLY_SYMBOLS \
457 SymI_NeedsProto(asprintf$LDBLStub) \
458 SymI_NeedsProto(err$LDBLStub) \
459 SymI_NeedsProto(errc$LDBLStub) \
460 SymI_NeedsProto(errx$LDBLStub) \
461 SymI_NeedsProto(fprintf$LDBLStub) \
462 SymI_NeedsProto(fscanf$LDBLStub) \
463 SymI_NeedsProto(fwprintf$LDBLStub) \
464 SymI_NeedsProto(fwscanf$LDBLStub) \
465 SymI_NeedsProto(printf$LDBLStub) \
466 SymI_NeedsProto(scanf$LDBLStub) \
467 SymI_NeedsProto(snprintf$LDBLStub) \
468 SymI_NeedsProto(sprintf$LDBLStub) \
469 SymI_NeedsProto(sscanf$LDBLStub) \
470 SymI_NeedsProto(strtold$LDBLStub) \
471 SymI_NeedsProto(swprintf$LDBLStub) \
472 SymI_NeedsProto(swscanf$LDBLStub) \
473 SymI_NeedsProto(syslog$LDBLStub) \
474 SymI_NeedsProto(vasprintf$LDBLStub) \
475 SymI_NeedsProto(verr$LDBLStub) \
476 SymI_NeedsProto(verrc$LDBLStub) \
477 SymI_NeedsProto(verrx$LDBLStub) \
478 SymI_NeedsProto(vfprintf$LDBLStub) \
479 SymI_NeedsProto(vfscanf$LDBLStub) \
480 SymI_NeedsProto(vfwprintf$LDBLStub) \
481 SymI_NeedsProto(vfwscanf$LDBLStub) \
482 SymI_NeedsProto(vprintf$LDBLStub) \
483 SymI_NeedsProto(vscanf$LDBLStub) \
484 SymI_NeedsProto(vsnprintf$LDBLStub) \
485 SymI_NeedsProto(vsprintf$LDBLStub) \
486 SymI_NeedsProto(vsscanf$LDBLStub) \
487 SymI_NeedsProto(vswprintf$LDBLStub) \
488 SymI_NeedsProto(vswscanf$LDBLStub) \
489 SymI_NeedsProto(vsyslog$LDBLStub) \
490 SymI_NeedsProto(vwarn$LDBLStub) \
491 SymI_NeedsProto(vwarnc$LDBLStub) \
492 SymI_NeedsProto(vwarnx$LDBLStub) \
493 SymI_NeedsProto(vwprintf$LDBLStub) \
494 SymI_NeedsProto(vwscanf$LDBLStub) \
495 SymI_NeedsProto(warn$LDBLStub) \
496 SymI_NeedsProto(warnc$LDBLStub) \
497 SymI_NeedsProto(warnx$LDBLStub) \
498 SymI_NeedsProto(wcstold$LDBLStub) \
499 SymI_NeedsProto(wprintf$LDBLStub) \
500 SymI_NeedsProto(wscanf$LDBLStub)
502 #define RTS_DARWIN_ONLY_SYMBOLS
506 # define MAIN_CAP_SYM SymI_HasProto(MainCapability)
508 # define MAIN_CAP_SYM
511 #if !defined(mingw32_HOST_OS)
512 #define RTS_USER_SIGNALS_SYMBOLS \
513 SymI_HasProto(setIOManagerPipe) \
514 SymI_HasProto(ioManagerWakeup) \
515 SymI_HasProto(ioManagerSync) \
516 SymI_HasProto(blockUserSignals) \
517 SymI_HasProto(unblockUserSignals)
519 #define RTS_USER_SIGNALS_SYMBOLS \
520 SymI_HasProto(ioManagerWakeup) \
521 SymI_HasProto(sendIOManagerEvent) \
522 SymI_HasProto(readIOManagerEvent) \
523 SymI_HasProto(getIOManagerEvent) \
524 SymI_HasProto(console_handler)
527 #define RTS_LIBFFI_SYMBOLS \
528 SymE_NeedsProto(ffi_prep_cif) \
529 SymE_NeedsProto(ffi_call) \
530 SymE_NeedsProto(ffi_type_void) \
531 SymE_NeedsProto(ffi_type_float) \
532 SymE_NeedsProto(ffi_type_double) \
533 SymE_NeedsProto(ffi_type_sint64) \
534 SymE_NeedsProto(ffi_type_uint64) \
535 SymE_NeedsProto(ffi_type_sint32) \
536 SymE_NeedsProto(ffi_type_uint32) \
537 SymE_NeedsProto(ffi_type_sint16) \
538 SymE_NeedsProto(ffi_type_uint16) \
539 SymE_NeedsProto(ffi_type_sint8) \
540 SymE_NeedsProto(ffi_type_uint8) \
541 SymE_NeedsProto(ffi_type_pointer)
543 #ifdef TABLES_NEXT_TO_CODE
544 #define RTS_RET_SYMBOLS /* nothing */
546 #define RTS_RET_SYMBOLS \
547 SymI_HasProto(stg_enter_ret) \
548 SymI_HasProto(stg_gc_fun_ret) \
549 SymI_HasProto(stg_ap_v_ret) \
550 SymI_HasProto(stg_ap_f_ret) \
551 SymI_HasProto(stg_ap_d_ret) \
552 SymI_HasProto(stg_ap_l_ret) \
553 SymI_HasProto(stg_ap_n_ret) \
554 SymI_HasProto(stg_ap_p_ret) \
555 SymI_HasProto(stg_ap_pv_ret) \
556 SymI_HasProto(stg_ap_pp_ret) \
557 SymI_HasProto(stg_ap_ppv_ret) \
558 SymI_HasProto(stg_ap_ppp_ret) \
559 SymI_HasProto(stg_ap_pppv_ret) \
560 SymI_HasProto(stg_ap_pppp_ret) \
561 SymI_HasProto(stg_ap_ppppp_ret) \
562 SymI_HasProto(stg_ap_pppppp_ret)
565 /* Modules compiled with -ticky may mention ticky counters */
566 /* This list should marry up with the one in $(TOP)/includes/stg/Ticky.h */
567 #define RTS_TICKY_SYMBOLS \
568 SymI_NeedsProto(ticky_entry_ctrs) \
569 SymI_NeedsProto(top_ct) \
571 SymI_HasProto(ENT_VIA_NODE_ctr) \
572 SymI_HasProto(ENT_STATIC_THK_ctr) \
573 SymI_HasProto(ENT_DYN_THK_ctr) \
574 SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr) \
575 SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr) \
576 SymI_HasProto(ENT_STATIC_CON_ctr) \
577 SymI_HasProto(ENT_DYN_CON_ctr) \
578 SymI_HasProto(ENT_STATIC_IND_ctr) \
579 SymI_HasProto(ENT_DYN_IND_ctr) \
580 SymI_HasProto(ENT_PERM_IND_ctr) \
581 SymI_HasProto(ENT_PAP_ctr) \
582 SymI_HasProto(ENT_AP_ctr) \
583 SymI_HasProto(ENT_AP_STACK_ctr) \
584 SymI_HasProto(ENT_BH_ctr) \
585 SymI_HasProto(UNKNOWN_CALL_ctr) \
586 SymI_HasProto(SLOW_CALL_v_ctr) \
587 SymI_HasProto(SLOW_CALL_f_ctr) \
588 SymI_HasProto(SLOW_CALL_d_ctr) \
589 SymI_HasProto(SLOW_CALL_l_ctr) \
590 SymI_HasProto(SLOW_CALL_n_ctr) \
591 SymI_HasProto(SLOW_CALL_p_ctr) \
592 SymI_HasProto(SLOW_CALL_pv_ctr) \
593 SymI_HasProto(SLOW_CALL_pp_ctr) \
594 SymI_HasProto(SLOW_CALL_ppv_ctr) \
595 SymI_HasProto(SLOW_CALL_ppp_ctr) \
596 SymI_HasProto(SLOW_CALL_pppv_ctr) \
597 SymI_HasProto(SLOW_CALL_pppp_ctr) \
598 SymI_HasProto(SLOW_CALL_ppppp_ctr) \
599 SymI_HasProto(SLOW_CALL_pppppp_ctr) \
600 SymI_HasProto(SLOW_CALL_OTHER_ctr) \
601 SymI_HasProto(ticky_slow_call_unevald) \
602 SymI_HasProto(SLOW_CALL_ctr) \
603 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_ctr) \
604 SymI_HasProto(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr) \
605 SymI_HasProto(KNOWN_CALL_ctr) \
606 SymI_HasProto(KNOWN_CALL_TOO_FEW_ARGS_ctr) \
607 SymI_HasProto(KNOWN_CALL_EXTRA_ARGS_ctr) \
608 SymI_HasProto(SLOW_CALL_FUN_TOO_FEW_ctr) \
609 SymI_HasProto(SLOW_CALL_FUN_CORRECT_ctr) \
610 SymI_HasProto(SLOW_CALL_FUN_TOO_MANY_ctr) \
611 SymI_HasProto(SLOW_CALL_PAP_TOO_FEW_ctr) \
612 SymI_HasProto(SLOW_CALL_PAP_CORRECT_ctr) \
613 SymI_HasProto(SLOW_CALL_PAP_TOO_MANY_ctr) \
614 SymI_HasProto(SLOW_CALL_UNEVALD_ctr) \
615 SymI_HasProto(UPDF_OMITTED_ctr) \
616 SymI_HasProto(UPDF_PUSHED_ctr) \
617 SymI_HasProto(CATCHF_PUSHED_ctr) \
618 SymI_HasProto(UPDF_RCC_PUSHED_ctr) \
619 SymI_HasProto(UPDF_RCC_OMITTED_ctr) \
620 SymI_HasProto(UPD_SQUEEZED_ctr) \
621 SymI_HasProto(UPD_CON_IN_NEW_ctr) \
622 SymI_HasProto(UPD_CON_IN_PLACE_ctr) \
623 SymI_HasProto(UPD_PAP_IN_NEW_ctr) \
624 SymI_HasProto(UPD_PAP_IN_PLACE_ctr) \
625 SymI_HasProto(ALLOC_HEAP_ctr) \
626 SymI_HasProto(ALLOC_HEAP_tot) \
627 SymI_HasProto(ALLOC_FUN_ctr) \
628 SymI_HasProto(ALLOC_FUN_adm) \
629 SymI_HasProto(ALLOC_FUN_gds) \
630 SymI_HasProto(ALLOC_FUN_slp) \
631 SymI_HasProto(UPD_NEW_IND_ctr) \
632 SymI_HasProto(UPD_NEW_PERM_IND_ctr) \
633 SymI_HasProto(UPD_OLD_IND_ctr) \
634 SymI_HasProto(UPD_OLD_PERM_IND_ctr) \
635 SymI_HasProto(UPD_BH_UPDATABLE_ctr) \
636 SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr) \
637 SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr) \
638 SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr) \
639 SymI_HasProto(GC_SEL_ABANDONED_ctr) \
640 SymI_HasProto(GC_SEL_MINOR_ctr) \
641 SymI_HasProto(GC_SEL_MAJOR_ctr) \
642 SymI_HasProto(GC_FAILED_PROMOTION_ctr) \
643 SymI_HasProto(ALLOC_UP_THK_ctr) \
644 SymI_HasProto(ALLOC_SE_THK_ctr) \
645 SymI_HasProto(ALLOC_THK_adm) \
646 SymI_HasProto(ALLOC_THK_gds) \
647 SymI_HasProto(ALLOC_THK_slp) \
648 SymI_HasProto(ALLOC_CON_ctr) \
649 SymI_HasProto(ALLOC_CON_adm) \
650 SymI_HasProto(ALLOC_CON_gds) \
651 SymI_HasProto(ALLOC_CON_slp) \
652 SymI_HasProto(ALLOC_TUP_ctr) \
653 SymI_HasProto(ALLOC_TUP_adm) \
654 SymI_HasProto(ALLOC_TUP_gds) \
655 SymI_HasProto(ALLOC_TUP_slp) \
656 SymI_HasProto(ALLOC_BH_ctr) \
657 SymI_HasProto(ALLOC_BH_adm) \
658 SymI_HasProto(ALLOC_BH_gds) \
659 SymI_HasProto(ALLOC_BH_slp) \
660 SymI_HasProto(ALLOC_PRIM_ctr) \
661 SymI_HasProto(ALLOC_PRIM_adm) \
662 SymI_HasProto(ALLOC_PRIM_gds) \
663 SymI_HasProto(ALLOC_PRIM_slp) \
664 SymI_HasProto(ALLOC_PAP_ctr) \
665 SymI_HasProto(ALLOC_PAP_adm) \
666 SymI_HasProto(ALLOC_PAP_gds) \
667 SymI_HasProto(ALLOC_PAP_slp) \
668 SymI_HasProto(ALLOC_TSO_ctr) \
669 SymI_HasProto(ALLOC_TSO_adm) \
670 SymI_HasProto(ALLOC_TSO_gds) \
671 SymI_HasProto(ALLOC_TSO_slp) \
672 SymI_HasProto(RET_NEW_ctr) \
673 SymI_HasProto(RET_OLD_ctr) \
674 SymI_HasProto(RET_UNBOXED_TUP_ctr) \
675 SymI_HasProto(RET_SEMI_loads_avoided)
678 // On most platforms, the garbage collector rewrites references
679 // to small integer and char objects to a set of common, shared ones.
681 // We don't do this when compiling to Windows DLLs at the moment because
682 // it doesn't support cross package data references well.
684 #if defined(__PIC__) && defined(mingw32_HOST_OS)
685 #define RTS_INTCHAR_SYMBOLS
687 #define RTS_INTCHAR_SYMBOLS \
688 SymI_HasProto(stg_CHARLIKE_closure) \
689 SymI_HasProto(stg_INTLIKE_closure)
693 #define RTS_SYMBOLS \
696 SymI_HasProto(StgReturn) \
697 SymI_HasProto(stg_enter_info) \
698 SymI_HasProto(stg_gc_void_info) \
699 SymI_HasProto(__stg_gc_enter_1) \
700 SymI_HasProto(stg_gc_noregs) \
701 SymI_HasProto(stg_gc_unpt_r1_info) \
702 SymI_HasProto(stg_gc_unpt_r1) \
703 SymI_HasProto(stg_gc_unbx_r1_info) \
704 SymI_HasProto(stg_gc_unbx_r1) \
705 SymI_HasProto(stg_gc_f1_info) \
706 SymI_HasProto(stg_gc_f1) \
707 SymI_HasProto(stg_gc_d1_info) \
708 SymI_HasProto(stg_gc_d1) \
709 SymI_HasProto(stg_gc_l1_info) \
710 SymI_HasProto(stg_gc_l1) \
711 SymI_HasProto(__stg_gc_fun) \
712 SymI_HasProto(stg_gc_fun_info) \
713 SymI_HasProto(stg_gc_gen) \
714 SymI_HasProto(stg_gc_gen_info) \
715 SymI_HasProto(stg_gc_gen_hp) \
716 SymI_HasProto(stg_gc_ut) \
717 SymI_HasProto(stg_gen_yield) \
718 SymI_HasProto(stg_yield_noregs) \
719 SymI_HasProto(stg_yield_to_interpreter) \
720 SymI_HasProto(stg_gen_block) \
721 SymI_HasProto(stg_block_noregs) \
722 SymI_HasProto(stg_block_1) \
723 SymI_HasProto(stg_block_takemvar) \
724 SymI_HasProto(stg_block_putmvar) \
726 SymI_HasProto(MallocFailHook) \
727 SymI_HasProto(OnExitHook) \
728 SymI_HasProto(OutOfHeapHook) \
729 SymI_HasProto(StackOverflowHook) \
730 SymI_HasProto(addDLL) \
731 SymI_HasProto(__int_encodeDouble) \
732 SymI_HasProto(__word_encodeDouble) \
733 SymI_HasProto(__2Int_encodeDouble) \
734 SymI_HasProto(__int_encodeFloat) \
735 SymI_HasProto(__word_encodeFloat) \
736 SymI_HasProto(stg_atomicallyzh) \
737 SymI_HasProto(barf) \
738 SymI_HasProto(debugBelch) \
739 SymI_HasProto(errorBelch) \
740 SymI_HasProto(sysErrorBelch) \
741 SymI_HasProto(stg_asyncExceptionsBlockedzh) \
742 SymI_HasProto(stg_blockAsyncExceptionszh) \
743 SymI_HasProto(stg_catchzh) \
744 SymI_HasProto(stg_catchRetryzh) \
745 SymI_HasProto(stg_catchSTMzh) \
746 SymI_HasProto(stg_checkzh) \
747 SymI_HasProto(closure_flags) \
748 SymI_HasProto(cmp_thread) \
749 SymI_HasProto(createAdjustor) \
750 SymI_HasProto(stg_decodeDoublezu2Intzh) \
751 SymI_HasProto(stg_decodeFloatzuIntzh) \
752 SymI_HasProto(defaultsHook) \
753 SymI_HasProto(stg_delayzh) \
754 SymI_HasProto(stg_deRefWeakzh) \
755 SymI_HasProto(stg_deRefStablePtrzh) \
756 SymI_HasProto(dirty_MUT_VAR) \
757 SymI_HasProto(stg_forkzh) \
758 SymI_HasProto(stg_forkOnzh) \
759 SymI_HasProto(forkProcess) \
760 SymI_HasProto(forkOS_createThread) \
761 SymI_HasProto(freeHaskellFunctionPtr) \
762 SymI_HasProto(getOrSetTypeableStore) \
763 SymI_HasProto(getOrSetGHCConcSignalHandlerStore) \
764 SymI_HasProto(getOrSetGHCConcPendingEventsStore) \
765 SymI_HasProto(getOrSetGHCConcPendingDelaysStore) \
766 SymI_HasProto(getOrSetGHCConcIOManagerThreadStore) \
767 SymI_HasProto(getOrSetGHCConcProddingStore) \
768 SymI_HasProto(genSymZh) \
769 SymI_HasProto(genericRaise) \
770 SymI_HasProto(getProgArgv) \
771 SymI_HasProto(getFullProgArgv) \
772 SymI_HasProto(getStablePtr) \
773 SymI_HasProto(hs_init) \
774 SymI_HasProto(hs_exit) \
775 SymI_HasProto(hs_set_argv) \
776 SymI_HasProto(hs_add_root) \
777 SymI_HasProto(hs_perform_gc) \
778 SymI_HasProto(hs_free_stable_ptr) \
779 SymI_HasProto(hs_free_fun_ptr) \
780 SymI_HasProto(hs_hpc_rootModule) \
781 SymI_HasProto(hs_hpc_module) \
782 SymI_HasProto(initLinker) \
783 SymI_HasProto(stg_unpackClosurezh) \
784 SymI_HasProto(stg_getApStackValzh) \
785 SymI_HasProto(stg_getSparkzh) \
786 SymI_HasProto(stg_isCurrentThreadBoundzh) \
787 SymI_HasProto(stg_isEmptyMVarzh) \
788 SymI_HasProto(stg_killThreadzh) \
789 SymI_HasProto(loadObj) \
790 SymI_HasProto(insertStableSymbol) \
791 SymI_HasProto(insertSymbol) \
792 SymI_HasProto(lookupSymbol) \
793 SymI_HasProto(stg_makeStablePtrzh) \
794 SymI_HasProto(stg_mkApUpd0zh) \
795 SymI_HasProto(stg_myThreadIdzh) \
796 SymI_HasProto(stg_labelThreadzh) \
797 SymI_HasProto(stg_newArrayzh) \
798 SymI_HasProto(stg_newBCOzh) \
799 SymI_HasProto(stg_newByteArrayzh) \
800 SymI_HasProto_redirect(newCAF, newDynCAF) \
801 SymI_HasProto(stg_newMVarzh) \
802 SymI_HasProto(stg_newMutVarzh) \
803 SymI_HasProto(stg_newTVarzh) \
804 SymI_HasProto(stg_noDuplicatezh) \
805 SymI_HasProto(stg_atomicModifyMutVarzh) \
806 SymI_HasProto(stg_newPinnedByteArrayzh) \
807 SymI_HasProto(stg_newAlignedPinnedByteArrayzh) \
808 SymI_HasProto(newSpark) \
809 SymI_HasProto(performGC) \
810 SymI_HasProto(performMajorGC) \
811 SymI_HasProto(prog_argc) \
812 SymI_HasProto(prog_argv) \
813 SymI_HasProto(stg_putMVarzh) \
814 SymI_HasProto(stg_raisezh) \
815 SymI_HasProto(stg_raiseIOzh) \
816 SymI_HasProto(stg_readTVarzh) \
817 SymI_HasProto(stg_readTVarIOzh) \
818 SymI_HasProto(resumeThread) \
819 SymI_HasProto(resolveObjs) \
820 SymI_HasProto(stg_retryzh) \
821 SymI_HasProto(rts_apply) \
822 SymI_HasProto(rts_checkSchedStatus) \
823 SymI_HasProto(rts_eval) \
824 SymI_HasProto(rts_evalIO) \
825 SymI_HasProto(rts_evalLazyIO) \
826 SymI_HasProto(rts_evalStableIO) \
827 SymI_HasProto(rts_eval_) \
828 SymI_HasProto(rts_getBool) \
829 SymI_HasProto(rts_getChar) \
830 SymI_HasProto(rts_getDouble) \
831 SymI_HasProto(rts_getFloat) \
832 SymI_HasProto(rts_getInt) \
833 SymI_HasProto(rts_getInt8) \
834 SymI_HasProto(rts_getInt16) \
835 SymI_HasProto(rts_getInt32) \
836 SymI_HasProto(rts_getInt64) \
837 SymI_HasProto(rts_getPtr) \
838 SymI_HasProto(rts_getFunPtr) \
839 SymI_HasProto(rts_getStablePtr) \
840 SymI_HasProto(rts_getThreadId) \
841 SymI_HasProto(rts_getWord) \
842 SymI_HasProto(rts_getWord8) \
843 SymI_HasProto(rts_getWord16) \
844 SymI_HasProto(rts_getWord32) \
845 SymI_HasProto(rts_getWord64) \
846 SymI_HasProto(rts_lock) \
847 SymI_HasProto(rts_mkBool) \
848 SymI_HasProto(rts_mkChar) \
849 SymI_HasProto(rts_mkDouble) \
850 SymI_HasProto(rts_mkFloat) \
851 SymI_HasProto(rts_mkInt) \
852 SymI_HasProto(rts_mkInt8) \
853 SymI_HasProto(rts_mkInt16) \
854 SymI_HasProto(rts_mkInt32) \
855 SymI_HasProto(rts_mkInt64) \
856 SymI_HasProto(rts_mkPtr) \
857 SymI_HasProto(rts_mkFunPtr) \
858 SymI_HasProto(rts_mkStablePtr) \
859 SymI_HasProto(rts_mkString) \
860 SymI_HasProto(rts_mkWord) \
861 SymI_HasProto(rts_mkWord8) \
862 SymI_HasProto(rts_mkWord16) \
863 SymI_HasProto(rts_mkWord32) \
864 SymI_HasProto(rts_mkWord64) \
865 SymI_HasProto(rts_unlock) \
866 SymI_HasProto(rts_unsafeGetMyCapability) \
867 SymI_HasProto(rtsSupportsBoundThreads) \
868 SymI_HasProto(setProgArgv) \
869 SymI_HasProto(startupHaskell) \
870 SymI_HasProto(shutdownHaskell) \
871 SymI_HasProto(shutdownHaskellAndExit) \
872 SymI_HasProto(stable_ptr_table) \
873 SymI_HasProto(stackOverflow) \
874 SymI_HasProto(stg_CAF_BLACKHOLE_info) \
875 SymI_HasProto(__stg_EAGER_BLACKHOLE_info) \
876 SymI_HasProto(startTimer) \
877 SymI_HasProto(stg_MVAR_CLEAN_info) \
878 SymI_HasProto(stg_MVAR_DIRTY_info) \
879 SymI_HasProto(stg_IND_STATIC_info) \
880 SymI_HasProto(stg_ARR_WORDS_info) \
881 SymI_HasProto(stg_MUT_ARR_PTRS_DIRTY_info) \
882 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN_info) \
883 SymI_HasProto(stg_MUT_ARR_PTRS_FROZEN0_info) \
884 SymI_HasProto(stg_WEAK_info) \
885 SymI_HasProto(stg_ap_v_info) \
886 SymI_HasProto(stg_ap_f_info) \
887 SymI_HasProto(stg_ap_d_info) \
888 SymI_HasProto(stg_ap_l_info) \
889 SymI_HasProto(stg_ap_n_info) \
890 SymI_HasProto(stg_ap_p_info) \
891 SymI_HasProto(stg_ap_pv_info) \
892 SymI_HasProto(stg_ap_pp_info) \
893 SymI_HasProto(stg_ap_ppv_info) \
894 SymI_HasProto(stg_ap_ppp_info) \
895 SymI_HasProto(stg_ap_pppv_info) \
896 SymI_HasProto(stg_ap_pppp_info) \
897 SymI_HasProto(stg_ap_ppppp_info) \
898 SymI_HasProto(stg_ap_pppppp_info) \
899 SymI_HasProto(stg_ap_0_fast) \
900 SymI_HasProto(stg_ap_v_fast) \
901 SymI_HasProto(stg_ap_f_fast) \
902 SymI_HasProto(stg_ap_d_fast) \
903 SymI_HasProto(stg_ap_l_fast) \
904 SymI_HasProto(stg_ap_n_fast) \
905 SymI_HasProto(stg_ap_p_fast) \
906 SymI_HasProto(stg_ap_pv_fast) \
907 SymI_HasProto(stg_ap_pp_fast) \
908 SymI_HasProto(stg_ap_ppv_fast) \
909 SymI_HasProto(stg_ap_ppp_fast) \
910 SymI_HasProto(stg_ap_pppv_fast) \
911 SymI_HasProto(stg_ap_pppp_fast) \
912 SymI_HasProto(stg_ap_ppppp_fast) \
913 SymI_HasProto(stg_ap_pppppp_fast) \
914 SymI_HasProto(stg_ap_1_upd_info) \
915 SymI_HasProto(stg_ap_2_upd_info) \
916 SymI_HasProto(stg_ap_3_upd_info) \
917 SymI_HasProto(stg_ap_4_upd_info) \
918 SymI_HasProto(stg_ap_5_upd_info) \
919 SymI_HasProto(stg_ap_6_upd_info) \
920 SymI_HasProto(stg_ap_7_upd_info) \
921 SymI_HasProto(stg_exit) \
922 SymI_HasProto(stg_sel_0_upd_info) \
923 SymI_HasProto(stg_sel_10_upd_info) \
924 SymI_HasProto(stg_sel_11_upd_info) \
925 SymI_HasProto(stg_sel_12_upd_info) \
926 SymI_HasProto(stg_sel_13_upd_info) \
927 SymI_HasProto(stg_sel_14_upd_info) \
928 SymI_HasProto(stg_sel_15_upd_info) \
929 SymI_HasProto(stg_sel_1_upd_info) \
930 SymI_HasProto(stg_sel_2_upd_info) \
931 SymI_HasProto(stg_sel_3_upd_info) \
932 SymI_HasProto(stg_sel_4_upd_info) \
933 SymI_HasProto(stg_sel_5_upd_info) \
934 SymI_HasProto(stg_sel_6_upd_info) \
935 SymI_HasProto(stg_sel_7_upd_info) \
936 SymI_HasProto(stg_sel_8_upd_info) \
937 SymI_HasProto(stg_sel_9_upd_info) \
938 SymI_HasProto(stg_upd_frame_info) \
939 SymI_HasProto(suspendThread) \
940 SymI_HasProto(stg_takeMVarzh) \
941 SymI_HasProto(stg_threadStatuszh) \
942 SymI_HasProto(stg_tryPutMVarzh) \
943 SymI_HasProto(stg_tryTakeMVarzh) \
944 SymI_HasProto(stg_unblockAsyncExceptionszh) \
945 SymI_HasProto(unloadObj) \
946 SymI_HasProto(stg_unsafeThawArrayzh) \
947 SymI_HasProto(stg_waitReadzh) \
948 SymI_HasProto(stg_waitWritezh) \
949 SymI_HasProto(stg_writeTVarzh) \
950 SymI_HasProto(stg_yieldzh) \
951 SymI_NeedsProto(stg_interp_constr_entry) \
952 SymI_HasProto(alloc_blocks_lim) \
954 SymI_HasProto(allocate) \
955 SymI_HasProto(allocateExec) \
956 SymI_HasProto(freeExec) \
957 SymI_HasProto(getAllocations) \
958 SymI_HasProto(revertCAFs) \
959 SymI_HasProto(RtsFlags) \
960 SymI_NeedsProto(rts_breakpoint_io_action) \
961 SymI_NeedsProto(rts_stop_next_breakpoint) \
962 SymI_NeedsProto(rts_stop_on_exception) \
963 SymI_HasProto(stopTimer) \
964 SymI_HasProto(n_capabilities) \
965 SymI_HasProto(stg_traceCcszh) \
966 SymI_HasProto(stg_traceEventzh) \
967 RTS_USER_SIGNALS_SYMBOLS \
971 // 64-bit support functions in libgcc.a
972 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
973 #define RTS_LIBGCC_SYMBOLS \
974 SymI_NeedsProto(__divdi3) \
975 SymI_NeedsProto(__udivdi3) \
976 SymI_NeedsProto(__moddi3) \
977 SymI_NeedsProto(__umoddi3) \
978 SymI_NeedsProto(__muldi3) \
979 SymI_NeedsProto(__ashldi3) \
980 SymI_NeedsProto(__ashrdi3) \
981 SymI_NeedsProto(__lshrdi3)
983 #define RTS_LIBGCC_SYMBOLS
986 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
987 // Symbols that don't have a leading underscore
988 // on Mac OS X. They have to receive special treatment,
989 // see machoInitSymbolsWithoutUnderscore()
990 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
991 SymI_NeedsProto(saveFP) \
992 SymI_NeedsProto(restFP)
995 /* entirely bogus claims about types of these symbols */
996 #define SymI_NeedsProto(vvv) extern void vvv(void);
997 #if defined(__PIC__) && defined(mingw32_TARGET_OS)
998 #define SymE_HasProto(vvv) SymE_HasProto(vvv);
999 #define SymE_NeedsProto(vvv) extern void _imp__ ## vvv (void);
1001 #define SymE_NeedsProto(vvv) SymI_NeedsProto(vvv);
1002 #define SymE_HasProto(vvv) SymI_HasProto(vvv)
1004 #define SymI_HasProto(vvv) /**/
1005 #define SymI_HasProto_redirect(vvv,xxx) /**/
1008 RTS_POSIX_ONLY_SYMBOLS
1009 RTS_MINGW_ONLY_SYMBOLS
1010 RTS_CYGWIN_ONLY_SYMBOLS
1011 RTS_DARWIN_ONLY_SYMBOLS
1014 #undef SymI_NeedsProto
1015 #undef SymI_HasProto
1016 #undef SymI_HasProto_redirect
1017 #undef SymE_HasProto
1018 #undef SymE_NeedsProto
1020 #ifdef LEADING_UNDERSCORE
1021 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
1023 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
1026 #define SymI_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1028 #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1029 (void*)DLL_IMPORT_DATA_REF(vvv) },
1031 #define SymI_NeedsProto(vvv) SymI_HasProto(vvv)
1032 #define SymE_NeedsProto(vvv) SymE_HasProto(vvv)
1034 // SymI_HasProto_redirect allows us to redirect references to one symbol to
1035 // another symbol. See newCAF/newDynCAF for an example.
1036 #define SymI_HasProto_redirect(vvv,xxx) \
1037 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
1040 static RtsSymbolVal rtsSyms[] = {
1043 RTS_POSIX_ONLY_SYMBOLS
1044 RTS_MINGW_ONLY_SYMBOLS
1045 RTS_CYGWIN_ONLY_SYMBOLS
1046 RTS_DARWIN_ONLY_SYMBOLS
1049 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
1050 // dyld stub code contains references to this,
1051 // but it should never be called because we treat
1052 // lazy pointers as nonlazy.
1053 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
1055 { 0, 0 } /* sentinel */
1060 /* -----------------------------------------------------------------------------
1061 * Insert symbols into hash tables, checking for duplicates.
1064 static void ghciInsertStrHashTable ( char* obj_name,
1070 if (lookupHashTable(table, (StgWord)key) == NULL)
1072 insertStrHashTable(table, (StgWord)key, data);
1077 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
1079 "whilst processing object file\n"
1081 "This could be caused by:\n"
1082 " * Loading two different object files which export the same symbol\n"
1083 " * Specifying the same object file twice on the GHCi command line\n"
1084 " * An incorrect `package.conf' entry, causing some object to be\n"
1086 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
1093 /* -----------------------------------------------------------------------------
1094 * initialize the object linker
1098 static int linker_init_done = 0 ;
1100 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1101 static void *dl_prog_handle;
1102 static regex_t re_invalid;
1103 static regex_t re_realso;
1105 static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
1113 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1117 /* Make initLinker idempotent, so we can call it
1118 before evey relevant operation; that means we
1119 don't need to initialise the linker separately */
1120 if (linker_init_done == 1) { return; } else {
1121 linker_init_done = 1;
1124 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
1125 initMutex(&dl_mutex);
1127 stablehash = allocStrHashTable();
1128 symhash = allocStrHashTable();
1130 /* populate the symbol table with stuff from the RTS */
1131 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1132 ghciInsertStrHashTable("(GHCi built-in symbols)",
1133 symhash, sym->lbl, sym->addr);
1135 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1136 machoInitSymbolsWithoutUnderscore();
1139 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1140 # if defined(RTLD_DEFAULT)
1141 dl_prog_handle = RTLD_DEFAULT;
1143 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1144 # endif /* RTLD_DEFAULT */
1146 compileResult = regcomp(&re_invalid,
1147 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
1149 ASSERT( compileResult == 0 );
1150 compileResult = regcomp(&re_realso,
1151 "GROUP *\\( *(([^ )])+)",
1153 ASSERT( compileResult == 0 );
1156 #if defined(x86_64_HOST_ARCH)
1157 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1158 // User-override for mmap_32bit_base
1159 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1163 #if defined(mingw32_HOST_OS)
1165 * These two libraries cause problems when added to the static link,
1166 * but are necessary for resolving symbols in GHCi, hence we load
1167 * them manually here.
1175 exitLinker( void ) {
1176 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1177 if (linker_init_done == 1) {
1178 regfree(&re_invalid);
1179 regfree(&re_realso);
1181 closeMutex(&dl_mutex);
1187 /* -----------------------------------------------------------------------------
1188 * Loading DLL or .so dynamic libraries
1189 * -----------------------------------------------------------------------------
1191 * Add a DLL from which symbols may be found. In the ELF case, just
1192 * do RTLD_GLOBAL-style add, so no further messing around needs to
1193 * happen in order that symbols in the loaded .so are findable --
1194 * lookupSymbol() will subsequently see them by dlsym on the program's
1195 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1197 * In the PEi386 case, open the DLLs and put handles to them in a
1198 * linked list. When looking for a symbol, try all handles in the
1199 * list. This means that we need to load even DLLs that are guaranteed
1200 * to be in the ghc.exe image already, just so we can get a handle
1201 * to give to loadSymbol, so that we can find the symbols. For such
1202 * libraries, the LoadLibrary call should be a no-op except for returning
1207 #if defined(OBJFORMAT_PEi386)
1208 /* A record for storing handles into DLLs. */
1213 struct _OpenedDLL* next;
1218 /* A list thereof. */
1219 static OpenedDLL* opened_dlls = NULL;
1222 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1225 internal_dlopen(const char *dll_name)
1228 char *errmsg, *errmsg_copy;
1230 // omitted: RTLD_NOW
1231 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1233 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1235 //-------------- Begin critical section ------------------
1236 // This critical section is necessary because dlerror() is not
1237 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1238 // Also, the error message returned must be copied to preserve it
1241 ACQUIRE_LOCK(&dl_mutex);
1242 hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1246 /* dlopen failed; return a ptr to the error msg. */
1248 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1249 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1250 strcpy(errmsg_copy, errmsg);
1251 errmsg = errmsg_copy;
1253 RELEASE_LOCK(&dl_mutex);
1254 //--------------- End critical section -------------------
1261 addDLL( char *dll_name )
1263 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1264 /* ------------------- ELF DLL loader ------------------- */
1267 regmatch_t match[NMATCH];
1270 size_t match_length;
1271 #define MAXLINE 1000
1277 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1278 errmsg = internal_dlopen(dll_name);
1280 if (errmsg == NULL) {
1284 // GHC Trac ticket #2615
1285 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1286 // contain linker scripts rather than ELF-format object code. This
1287 // code handles the situation by recognizing the real object code
1288 // file name given in the linker script.
1290 // If an "invalid ELF header" error occurs, it is assumed that the
1291 // .so file contains a linker script instead of ELF object code.
1292 // In this case, the code looks for the GROUP ( ... ) linker
1293 // directive. If one is found, the first file name inside the
1294 // parentheses is treated as the name of a dynamic library and the
1295 // code attempts to dlopen that file. If this is also unsuccessful,
1296 // an error message is returned.
1298 // see if the error message is due to an invalid ELF header
1299 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1300 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1301 IF_DEBUG(linker, debugBelch("result = %i\n", result));
1303 // success -- try to read the named file as a linker script
1304 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1306 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
1307 line[match_length] = '\0'; // make sure string is null-terminated
1308 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
1309 if ((fp = fopen(line, "r")) == NULL) {
1310 return errmsg; // return original error if open fails
1312 // try to find a GROUP ( ... ) command
1313 while (fgets(line, MAXLINE, fp) != NULL) {
1314 IF_DEBUG(linker, debugBelch("input line = %s", line));
1315 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
1316 // success -- try to dlopen the first named file
1317 IF_DEBUG(linker, debugBelch("match%s\n",""));
1318 line[match[1].rm_eo] = '\0';
1319 errmsg = internal_dlopen(line+match[1].rm_so);
1322 // if control reaches here, no GROUP ( ... ) directive was found
1323 // and the original error message is returned to the caller
1329 # elif defined(OBJFORMAT_PEi386)
1330 /* ------------------- Win32 DLL loader ------------------- */
1338 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1340 /* See if we've already got it, and ignore if so. */
1341 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1342 if (0 == strcmp(o_dll->name, dll_name))
1346 /* The file name has no suffix (yet) so that we can try
1347 both foo.dll and foo.drv
1349 The documentation for LoadLibrary says:
1350 If no file name extension is specified in the lpFileName
1351 parameter, the default library extension .dll is
1352 appended. However, the file name string can include a trailing
1353 point character (.) to indicate that the module name has no
1356 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1357 sprintf(buf, "%s.DLL", dll_name);
1358 instance = LoadLibrary(buf);
1359 if (instance == NULL) {
1360 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1361 // KAA: allow loading of drivers (like winspool.drv)
1362 sprintf(buf, "%s.DRV", dll_name);
1363 instance = LoadLibrary(buf);
1364 if (instance == NULL) {
1365 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1366 // #1883: allow loading of unix-style libfoo.dll DLLs
1367 sprintf(buf, "lib%s.DLL", dll_name);
1368 instance = LoadLibrary(buf);
1369 if (instance == NULL) {
1376 /* Add this DLL to the list of DLLs in which to search for symbols. */
1377 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1378 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1379 strcpy(o_dll->name, dll_name);
1380 o_dll->instance = instance;
1381 o_dll->next = opened_dlls;
1382 opened_dlls = o_dll;
1388 sysErrorBelch(dll_name);
1390 /* LoadLibrary failed; return a ptr to the error msg. */
1391 return "addDLL: could not load DLL";
1394 barf("addDLL: not implemented on this platform");
1398 /* -----------------------------------------------------------------------------
1399 * insert a stable symbol in the hash table
1403 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1405 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1409 /* -----------------------------------------------------------------------------
1410 * insert a symbol in the hash table
1413 insertSymbol(char* obj_name, char* key, void* data)
1415 ghciInsertStrHashTable(obj_name, symhash, key, data);
1418 /* -----------------------------------------------------------------------------
1419 * lookup a symbol in the hash table
1422 lookupSymbol( char *lbl )
1426 ASSERT(symhash != NULL);
1427 val = lookupStrHashTable(symhash, lbl);
1430 # if defined(OBJFORMAT_ELF)
1431 return dlsym(dl_prog_handle, lbl);
1432 # elif defined(OBJFORMAT_MACHO)
1434 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1437 HACK: On OS X, global symbols are prefixed with an underscore.
1438 However, dlsym wants us to omit the leading underscore from the
1439 symbol name. For now, we simply strip it off here (and ONLY
1442 ASSERT(lbl[0] == '_');
1443 return dlsym(dl_prog_handle, lbl+1);
1445 if(NSIsSymbolNameDefined(lbl)) {
1446 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1447 return NSAddressOfSymbol(symbol);
1451 # endif /* HAVE_DLFCN_H */
1452 # elif defined(OBJFORMAT_PEi386)
1455 sym = lookupSymbolInDLLs(lbl);
1456 if (sym != NULL) { return sym; };
1458 // Also try looking up the symbol without the @N suffix. Some
1459 // DLLs have the suffixes on their symbols, some don't.
1460 zapTrailingAtSign ( lbl );
1461 sym = lookupSymbolInDLLs(lbl);
1462 if (sym != NULL) { return sym; };
1474 /* -----------------------------------------------------------------------------
1475 * Debugging aid: look in GHCi's object symbol tables for symbols
1476 * within DELTA bytes of the specified address, and show their names.
1479 void ghci_enquire ( char* addr );
1481 void ghci_enquire ( char* addr )
1486 const int DELTA = 64;
1491 for (oc = objects; oc; oc = oc->next) {
1492 for (i = 0; i < oc->n_symbols; i++) {
1493 sym = oc->symbols[i];
1494 if (sym == NULL) continue;
1497 a = lookupStrHashTable(symhash, sym);
1500 // debugBelch("ghci_enquire: can't find %s\n", sym);
1502 else if (addr-DELTA <= a && a <= addr+DELTA) {
1503 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1511 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1514 mmapForLinker (size_t bytes, nat flags, int fd)
1516 void *map_addr = NULL;
1519 static nat fixed = 0;
1521 pagesize = getpagesize();
1522 size = ROUND_UP(bytes, pagesize);
1524 #if defined(x86_64_HOST_ARCH)
1527 if (mmap_32bit_base != 0) {
1528 map_addr = mmap_32bit_base;
1532 result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
1533 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
1535 if (result == MAP_FAILED) {
1536 sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
1537 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1538 stg_exit(EXIT_FAILURE);
1541 #if defined(x86_64_HOST_ARCH)
1542 if (mmap_32bit_base != 0) {
1543 if (result == map_addr) {
1544 mmap_32bit_base = (StgWord8*)map_addr + size;
1546 if ((W_)result > 0x80000000) {
1547 // oops, we were given memory over 2Gb
1548 #if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)
1549 // Some platforms require MAP_FIXED. This is normally
1550 // a bad idea, because MAP_FIXED will overwrite
1551 // existing mappings.
1552 munmap(result,size);
1556 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);
1559 // hmm, we were given memory somewhere else, but it's
1560 // still under 2Gb so we can use it. Next time, ask
1561 // for memory right after the place we just got some
1562 mmap_32bit_base = (StgWord8*)result + size;
1566 if ((W_)result > 0x80000000) {
1567 // oops, we were given memory over 2Gb
1568 // ... try allocating memory somewhere else?;
1569 debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
1570 munmap(result, size);
1572 // Set a base address and try again... (guess: 1Gb)
1573 mmap_32bit_base = (void*)0x40000000;
1583 /* -----------------------------------------------------------------------------
1584 * Load an obj (populate the global symbol table, but don't resolve yet)
1586 * Returns: 1 if ok, 0 on error.
1589 loadObj( char *path )
1601 /* debugBelch("loadObj %s\n", path ); */
1603 /* Check that we haven't already loaded this object.
1604 Ignore requests to load multiple times */
1608 for (o = objects; o; o = o->next) {
1609 if (0 == strcmp(o->fileName, path)) {
1611 break; /* don't need to search further */
1615 IF_DEBUG(linker, debugBelch(
1616 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1617 "same object file twice:\n"
1619 "GHCi will ignore this, but be warned.\n"
1621 return 1; /* success */
1625 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1627 # if defined(OBJFORMAT_ELF)
1628 oc->formatName = "ELF";
1629 # elif defined(OBJFORMAT_PEi386)
1630 oc->formatName = "PEi386";
1631 # elif defined(OBJFORMAT_MACHO)
1632 oc->formatName = "Mach-O";
1635 barf("loadObj: not implemented on this platform");
1638 r = stat(path, &st);
1639 if (r == -1) { return 0; }
1641 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1642 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1643 strcpy(oc->fileName, path);
1645 oc->fileSize = st.st_size;
1647 oc->sections = NULL;
1648 oc->proddables = NULL;
1650 /* chain it onto the list of objects */
1655 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1657 #if defined(openbsd_HOST_OS)
1658 fd = open(path, O_RDONLY, S_IRUSR);
1660 fd = open(path, O_RDONLY);
1663 barf("loadObj: can't open `%s'", path);
1665 oc->image = mmapForLinker(oc->fileSize, 0, fd);
1669 #else /* !USE_MMAP */
1670 /* load the image into memory */
1671 f = fopen(path, "rb");
1673 barf("loadObj: can't read `%s'", path);
1675 # if defined(mingw32_HOST_OS)
1676 // TODO: We would like to use allocateExec here, but allocateExec
1677 // cannot currently allocate blocks large enough.
1678 oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
1679 PAGE_EXECUTE_READWRITE);
1680 # elif defined(darwin_HOST_OS)
1681 // In a Mach-O .o file, all sections can and will be misaligned
1682 // if the total size of the headers is not a multiple of the
1683 // desired alignment. This is fine for .o files that only serve
1684 // as input for the static linker, but it's not fine for us,
1685 // as SSE (used by gcc for floating point) and Altivec require
1686 // 16-byte alignment.
1687 // We calculate the correct alignment from the header before
1688 // reading the file, and then we misalign oc->image on purpose so
1689 // that the actual sections end up aligned again.
1690 oc->misalignment = machoGetMisalignment(f);
1691 oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
1692 oc->image += oc->misalignment;
1694 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1699 n = fread ( oc->image, 1, oc->fileSize, f );
1700 if (n != oc->fileSize)
1701 barf("loadObj: error whilst reading `%s'", path);
1704 #endif /* USE_MMAP */
1706 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1707 r = ocAllocateSymbolExtras_MachO ( oc );
1708 if (!r) { return r; }
1709 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1710 r = ocAllocateSymbolExtras_ELF ( oc );
1711 if (!r) { return r; }
1714 /* verify the in-memory image */
1715 # if defined(OBJFORMAT_ELF)
1716 r = ocVerifyImage_ELF ( oc );
1717 # elif defined(OBJFORMAT_PEi386)
1718 r = ocVerifyImage_PEi386 ( oc );
1719 # elif defined(OBJFORMAT_MACHO)
1720 r = ocVerifyImage_MachO ( oc );
1722 barf("loadObj: no verify method");
1724 if (!r) { return r; }
1726 /* build the symbol list for this image */
1727 # if defined(OBJFORMAT_ELF)
1728 r = ocGetNames_ELF ( oc );
1729 # elif defined(OBJFORMAT_PEi386)
1730 r = ocGetNames_PEi386 ( oc );
1731 # elif defined(OBJFORMAT_MACHO)
1732 r = ocGetNames_MachO ( oc );
1734 barf("loadObj: no getNames method");
1736 if (!r) { return r; }
1738 /* loaded, but not resolved yet */
1739 oc->status = OBJECT_LOADED;
1744 /* -----------------------------------------------------------------------------
1745 * resolve all the currently unlinked objects in memory
1747 * Returns: 1 if ok, 0 on error.
1757 for (oc = objects; oc; oc = oc->next) {
1758 if (oc->status != OBJECT_RESOLVED) {
1759 # if defined(OBJFORMAT_ELF)
1760 r = ocResolve_ELF ( oc );
1761 # elif defined(OBJFORMAT_PEi386)
1762 r = ocResolve_PEi386 ( oc );
1763 # elif defined(OBJFORMAT_MACHO)
1764 r = ocResolve_MachO ( oc );
1766 barf("resolveObjs: not implemented on this platform");
1768 if (!r) { return r; }
1769 oc->status = OBJECT_RESOLVED;
1775 /* -----------------------------------------------------------------------------
1776 * delete an object from the pool
1779 unloadObj( char *path )
1781 ObjectCode *oc, *prev;
1783 ASSERT(symhash != NULL);
1784 ASSERT(objects != NULL);
1789 for (oc = objects; oc; prev = oc, oc = oc->next) {
1790 if (!strcmp(oc->fileName,path)) {
1792 /* Remove all the mappings for the symbols within this
1797 for (i = 0; i < oc->n_symbols; i++) {
1798 if (oc->symbols[i] != NULL) {
1799 removeStrHashTable(symhash, oc->symbols[i], NULL);
1807 prev->next = oc->next;
1810 // We're going to leave this in place, in case there are
1811 // any pointers from the heap into it:
1812 // #ifdef mingw32_HOST_OS
1813 // VirtualFree(oc->image);
1815 // stgFree(oc->image);
1817 stgFree(oc->fileName);
1818 stgFree(oc->symbols);
1819 stgFree(oc->sections);
1825 errorBelch("unloadObj: can't find `%s' to unload", path);
1829 /* -----------------------------------------------------------------------------
1830 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1831 * which may be prodded during relocation, and abort if we try and write
1832 * outside any of these.
1834 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1837 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1838 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1842 pb->next = oc->proddables;
1843 oc->proddables = pb;
1846 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1849 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1850 char* s = (char*)(pb->start);
1851 char* e = s + pb->size - 1;
1852 char* a = (char*)addr;
1853 /* Assumes that the biggest fixup involves a 4-byte write. This
1854 probably needs to be changed to 8 (ie, +7) on 64-bit
1856 if (a >= s && (a+3) <= e) return;
1858 barf("checkProddableBlock: invalid fixup in runtime linker");
1861 /* -----------------------------------------------------------------------------
1862 * Section management.
1864 static void addSection ( ObjectCode* oc, SectionKind kind,
1865 void* start, void* end )
1867 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1871 s->next = oc->sections;
1874 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1875 start, ((char*)end)-1, end - start + 1, kind );
1880 /* --------------------------------------------------------------------------
1882 * This is about allocating a small chunk of memory for every symbol in the
1883 * object file. We make sure that the SymboLExtras are always "in range" of
1884 * limited-range PC-relative instructions on various platforms by allocating
1885 * them right next to the object code itself.
1888 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
1891 ocAllocateSymbolExtras
1893 Allocate additional space at the end of the object file image to make room
1894 for jump islands (powerpc, x86_64) and GOT entries (x86_64).
1896 PowerPC relative branch instructions have a 24 bit displacement field.
1897 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1898 If a particular imported symbol is outside this range, we have to redirect
1899 the jump to a short piece of new code that just loads the 32bit absolute
1900 address and jumps there.
1901 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
1904 This function just allocates space for one SymbolExtra for every
1905 undefined symbol in the object file. The code for the jump islands is
1906 filled in by makeSymbolExtra below.
1909 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
1916 int misalignment = 0;
1917 #ifdef darwin_HOST_OS
1918 misalignment = oc->misalignment;
1924 // round up to the nearest 4
1925 aligned = (oc->fileSize + 3) & ~3;
1928 pagesize = getpagesize();
1929 n = ROUND_UP( oc->fileSize, pagesize );
1930 m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
1932 /* we try to use spare space at the end of the last page of the
1933 * image for the jump islands, but if there isn't enough space
1934 * then we have to map some (anonymously, remembering MAP_32BIT).
1936 if( m > n ) // we need to allocate more pages
1938 oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
1943 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1946 oc->image -= misalignment;
1947 oc->image = stgReallocBytes( oc->image,
1949 aligned + sizeof (SymbolExtra) * count,
1950 "ocAllocateSymbolExtras" );
1951 oc->image += misalignment;
1953 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1954 #endif /* USE_MMAP */
1956 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
1959 oc->symbol_extras = NULL;
1961 oc->first_symbol_extra = first;
1962 oc->n_symbol_extras = count;
1967 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
1968 unsigned long symbolNumber,
1969 unsigned long target )
1973 ASSERT( symbolNumber >= oc->first_symbol_extra
1974 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
1976 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
1978 #ifdef powerpc_HOST_ARCH
1979 // lis r12, hi16(target)
1980 extra->jumpIsland.lis_r12 = 0x3d80;
1981 extra->jumpIsland.hi_addr = target >> 16;
1983 // ori r12, r12, lo16(target)
1984 extra->jumpIsland.ori_r12_r12 = 0x618c;
1985 extra->jumpIsland.lo_addr = target & 0xffff;
1988 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
1991 extra->jumpIsland.bctr = 0x4e800420;
1993 #ifdef x86_64_HOST_ARCH
1995 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
1996 extra->addr = target;
1997 memcpy(extra->jumpIsland, jmp, 6);
2005 /* --------------------------------------------------------------------------
2006 * PowerPC specifics (instruction cache flushing)
2007 * ------------------------------------------------------------------------*/
2009 #ifdef powerpc_TARGET_ARCH
2011 ocFlushInstructionCache
2013 Flush the data & instruction caches.
2014 Because the PPC has split data/instruction caches, we have to
2015 do that whenever we modify code at runtime.
2018 static void ocFlushInstructionCache( ObjectCode *oc )
2020 int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
2021 unsigned long *p = (unsigned long *) oc->image;
2025 __asm__ volatile ( "dcbf 0,%0\n\t"
2033 __asm__ volatile ( "sync\n\t"
2039 /* --------------------------------------------------------------------------
2040 * PEi386 specifics (Win32 targets)
2041 * ------------------------------------------------------------------------*/
2043 /* The information for this linker comes from
2044 Microsoft Portable Executable
2045 and Common Object File Format Specification
2046 revision 5.1 January 1998
2047 which SimonM says comes from the MS Developer Network CDs.
2049 It can be found there (on older CDs), but can also be found
2052 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
2054 (this is Rev 6.0 from February 1999).
2056 Things move, so if that fails, try searching for it via
2058 http://www.google.com/search?q=PE+COFF+specification
2060 The ultimate reference for the PE format is the Winnt.h
2061 header file that comes with the Platform SDKs; as always,
2062 implementations will drift wrt their documentation.
2064 A good background article on the PE format is Matt Pietrek's
2065 March 1994 article in Microsoft System Journal (MSJ)
2066 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2067 Win32 Portable Executable File Format." The info in there
2068 has recently been updated in a two part article in
2069 MSDN magazine, issues Feb and March 2002,
2070 "Inside Windows: An In-Depth Look into the Win32 Portable
2071 Executable File Format"
2073 John Levine's book "Linkers and Loaders" contains useful
2078 #if defined(OBJFORMAT_PEi386)
2082 typedef unsigned char UChar;
2083 typedef unsigned short UInt16;
2084 typedef unsigned int UInt32;
2091 UInt16 NumberOfSections;
2092 UInt32 TimeDateStamp;
2093 UInt32 PointerToSymbolTable;
2094 UInt32 NumberOfSymbols;
2095 UInt16 SizeOfOptionalHeader;
2096 UInt16 Characteristics;
2100 #define sizeof_COFF_header 20
2107 UInt32 VirtualAddress;
2108 UInt32 SizeOfRawData;
2109 UInt32 PointerToRawData;
2110 UInt32 PointerToRelocations;
2111 UInt32 PointerToLinenumbers;
2112 UInt16 NumberOfRelocations;
2113 UInt16 NumberOfLineNumbers;
2114 UInt32 Characteristics;
2118 #define sizeof_COFF_section 40
2125 UInt16 SectionNumber;
2128 UChar NumberOfAuxSymbols;
2132 #define sizeof_COFF_symbol 18
2137 UInt32 VirtualAddress;
2138 UInt32 SymbolTableIndex;
2143 #define sizeof_COFF_reloc 10
2146 /* From PE spec doc, section 3.3.2 */
2147 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
2148 windows.h -- for the same purpose, but I want to know what I'm
2150 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
2151 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
2152 #define MYIMAGE_FILE_DLL 0x2000
2153 #define MYIMAGE_FILE_SYSTEM 0x1000
2154 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
2155 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
2156 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
2158 /* From PE spec doc, section 5.4.2 and 5.4.4 */
2159 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
2160 #define MYIMAGE_SYM_CLASS_STATIC 3
2161 #define MYIMAGE_SYM_UNDEFINED 0
2163 /* From PE spec doc, section 4.1 */
2164 #define MYIMAGE_SCN_CNT_CODE 0x00000020
2165 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
2166 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
2168 /* From PE spec doc, section 5.2.1 */
2169 #define MYIMAGE_REL_I386_DIR32 0x0006
2170 #define MYIMAGE_REL_I386_REL32 0x0014
2173 /* We use myindex to calculate array addresses, rather than
2174 simply doing the normal subscript thing. That's because
2175 some of the above structs have sizes which are not
2176 a whole number of words. GCC rounds their sizes up to a
2177 whole number of words, which means that the address calcs
2178 arising from using normal C indexing or pointer arithmetic
2179 are just plain wrong. Sigh.
2182 myindex ( int scale, void* base, int index )
2185 ((UChar*)base) + scale * index;
2190 printName ( UChar* name, UChar* strtab )
2192 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2193 UInt32 strtab_offset = * (UInt32*)(name+4);
2194 debugBelch("%s", strtab + strtab_offset );
2197 for (i = 0; i < 8; i++) {
2198 if (name[i] == 0) break;
2199 debugBelch("%c", name[i] );
2206 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
2208 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2209 UInt32 strtab_offset = * (UInt32*)(name+4);
2210 strncpy ( dst, strtab+strtab_offset, dstSize );
2216 if (name[i] == 0) break;
2226 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
2229 /* If the string is longer than 8 bytes, look in the
2230 string table for it -- this will be correctly zero terminated.
2232 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2233 UInt32 strtab_offset = * (UInt32*)(name+4);
2234 return ((UChar*)strtab) + strtab_offset;
2236 /* Otherwise, if shorter than 8 bytes, return the original,
2237 which by defn is correctly terminated.
2239 if (name[7]==0) return name;
2240 /* The annoying case: 8 bytes. Copy into a temporary
2241 (which is never freed ...)
2243 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
2245 strncpy(newstr,name,8);
2251 /* Just compares the short names (first 8 chars) */
2252 static COFF_section *
2253 findPEi386SectionCalled ( ObjectCode* oc, char* name )
2257 = (COFF_header*)(oc->image);
2258 COFF_section* sectab
2260 ((UChar*)(oc->image))
2261 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2263 for (i = 0; i < hdr->NumberOfSections; i++) {
2266 COFF_section* section_i
2268 myindex ( sizeof_COFF_section, sectab, i );
2269 n1 = (UChar*) &(section_i->Name);
2271 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
2272 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
2273 n1[6]==n2[6] && n1[7]==n2[7])
2282 zapTrailingAtSign ( UChar* sym )
2284 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2286 if (sym[0] == 0) return;
2288 while (sym[i] != 0) i++;
2291 while (j > 0 && my_isdigit(sym[j])) j--;
2292 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2297 lookupSymbolInDLLs ( UChar *lbl )
2302 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2303 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
2305 if (lbl[0] == '_') {
2306 /* HACK: if the name has an initial underscore, try stripping
2307 it off & look that up first. I've yet to verify whether there's
2308 a Rule that governs whether an initial '_' *should always* be
2309 stripped off when mapping from import lib name to the DLL name.
2311 sym = GetProcAddress(o_dll->instance, (lbl+1));
2313 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
2317 sym = GetProcAddress(o_dll->instance, lbl);
2319 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
2328 ocVerifyImage_PEi386 ( ObjectCode* oc )
2333 COFF_section* sectab;
2334 COFF_symbol* symtab;
2336 /* debugBelch("\nLOADING %s\n", oc->fileName); */
2337 hdr = (COFF_header*)(oc->image);
2338 sectab = (COFF_section*) (
2339 ((UChar*)(oc->image))
2340 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2342 symtab = (COFF_symbol*) (
2343 ((UChar*)(oc->image))
2344 + hdr->PointerToSymbolTable
2346 strtab = ((UChar*)symtab)
2347 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2349 if (hdr->Machine != 0x14c) {
2350 errorBelch("%s: Not x86 PEi386", oc->fileName);
2353 if (hdr->SizeOfOptionalHeader != 0) {
2354 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2357 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2358 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2359 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2360 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2361 errorBelch("%s: Not a PEi386 object file", oc->fileName);
2364 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2365 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2366 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2368 (int)(hdr->Characteristics));
2371 /* If the string table size is way crazy, this might indicate that
2372 there are more than 64k relocations, despite claims to the
2373 contrary. Hence this test. */
2374 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2376 if ( (*(UInt32*)strtab) > 600000 ) {
2377 /* Note that 600k has no special significance other than being
2378 big enough to handle the almost-2MB-sized lumps that
2379 constitute HSwin32*.o. */
2380 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2385 /* No further verification after this point; only debug printing. */
2387 IF_DEBUG(linker, i=1);
2388 if (i == 0) return 1;
2390 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2391 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2392 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2395 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2396 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2397 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2398 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2399 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2400 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2401 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2403 /* Print the section table. */
2405 for (i = 0; i < hdr->NumberOfSections; i++) {
2407 COFF_section* sectab_i
2409 myindex ( sizeof_COFF_section, sectab, i );
2416 printName ( sectab_i->Name, strtab );
2426 sectab_i->VirtualSize,
2427 sectab_i->VirtualAddress,
2428 sectab_i->SizeOfRawData,
2429 sectab_i->PointerToRawData,
2430 sectab_i->NumberOfRelocations,
2431 sectab_i->PointerToRelocations,
2432 sectab_i->PointerToRawData
2434 reltab = (COFF_reloc*) (
2435 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2438 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2439 /* If the relocation field (a short) has overflowed, the
2440 * real count can be found in the first reloc entry.
2442 * See Section 4.1 (last para) of the PE spec (rev6.0).
2444 COFF_reloc* rel = (COFF_reloc*)
2445 myindex ( sizeof_COFF_reloc, reltab, 0 );
2446 noRelocs = rel->VirtualAddress;
2449 noRelocs = sectab_i->NumberOfRelocations;
2453 for (; j < noRelocs; j++) {
2455 COFF_reloc* rel = (COFF_reloc*)
2456 myindex ( sizeof_COFF_reloc, reltab, j );
2458 " type 0x%-4x vaddr 0x%-8x name `",
2460 rel->VirtualAddress );
2461 sym = (COFF_symbol*)
2462 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2463 /* Hmm..mysterious looking offset - what's it for? SOF */
2464 printName ( sym->Name, strtab -10 );
2471 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2472 debugBelch("---START of string table---\n");
2473 for (i = 4; i < *(Int32*)strtab; i++) {
2475 debugBelch("\n"); else
2476 debugBelch("%c", strtab[i] );
2478 debugBelch("--- END of string table---\n");
2483 COFF_symbol* symtab_i;
2484 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2485 symtab_i = (COFF_symbol*)
2486 myindex ( sizeof_COFF_symbol, symtab, i );
2492 printName ( symtab_i->Name, strtab );
2501 (Int32)(symtab_i->SectionNumber),
2502 (UInt32)symtab_i->Type,
2503 (UInt32)symtab_i->StorageClass,
2504 (UInt32)symtab_i->NumberOfAuxSymbols
2506 i += symtab_i->NumberOfAuxSymbols;
2516 ocGetNames_PEi386 ( ObjectCode* oc )
2519 COFF_section* sectab;
2520 COFF_symbol* symtab;
2527 hdr = (COFF_header*)(oc->image);
2528 sectab = (COFF_section*) (
2529 ((UChar*)(oc->image))
2530 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2532 symtab = (COFF_symbol*) (
2533 ((UChar*)(oc->image))
2534 + hdr->PointerToSymbolTable
2536 strtab = ((UChar*)(oc->image))
2537 + hdr->PointerToSymbolTable
2538 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2540 /* Allocate space for any (local, anonymous) .bss sections. */
2542 for (i = 0; i < hdr->NumberOfSections; i++) {
2545 COFF_section* sectab_i
2547 myindex ( sizeof_COFF_section, sectab, i );
2548 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2549 /* sof 10/05: the PE spec text isn't too clear regarding what
2550 * the SizeOfRawData field is supposed to hold for object
2551 * file sections containing just uninitialized data -- for executables,
2552 * it is supposed to be zero; unclear what it's supposed to be
2553 * for object files. However, VirtualSize is guaranteed to be
2554 * zero for object files, which definitely suggests that SizeOfRawData
2555 * will be non-zero (where else would the size of this .bss section be
2556 * stored?) Looking at the COFF_section info for incoming object files,
2557 * this certainly appears to be the case.
2559 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2560 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2561 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2562 * variable decls into to the .bss section. (The specific function in Q which
2563 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2565 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2566 /* This is a non-empty .bss section. Allocate zeroed space for
2567 it, and set its PointerToRawData field such that oc->image +
2568 PointerToRawData == addr_of_zeroed_space. */
2569 bss_sz = sectab_i->VirtualSize;
2570 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2571 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2572 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2573 addProddableBlock(oc, zspace, bss_sz);
2574 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2577 /* Copy section information into the ObjectCode. */
2579 for (i = 0; i < hdr->NumberOfSections; i++) {
2585 = SECTIONKIND_OTHER;
2586 COFF_section* sectab_i
2588 myindex ( sizeof_COFF_section, sectab, i );
2589 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2592 /* I'm sure this is the Right Way to do it. However, the
2593 alternative of testing the sectab_i->Name field seems to
2594 work ok with Cygwin.
2596 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2597 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2598 kind = SECTIONKIND_CODE_OR_RODATA;
2601 if (0==strcmp(".text",sectab_i->Name) ||
2602 0==strcmp(".rdata",sectab_i->Name)||
2603 0==strcmp(".rodata",sectab_i->Name))
2604 kind = SECTIONKIND_CODE_OR_RODATA;
2605 if (0==strcmp(".data",sectab_i->Name) ||
2606 0==strcmp(".bss",sectab_i->Name))
2607 kind = SECTIONKIND_RWDATA;
2609 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2610 sz = sectab_i->SizeOfRawData;
2611 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2613 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2614 end = start + sz - 1;
2616 if (kind == SECTIONKIND_OTHER
2617 /* Ignore sections called which contain stabs debugging
2619 && 0 != strcmp(".stab", sectab_i->Name)
2620 && 0 != strcmp(".stabstr", sectab_i->Name)
2621 /* ignore constructor section for now */
2622 && 0 != strcmp(".ctors", sectab_i->Name)
2623 /* ignore section generated from .ident */
2624 && 0!= strcmp("/4", sectab_i->Name)
2625 /* ignore unknown section that appeared in gcc 3.4.5(?) */
2626 && 0!= strcmp(".reloc", sectab_i->Name)
2628 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2632 if (kind != SECTIONKIND_OTHER && end >= start) {
2633 addSection(oc, kind, start, end);
2634 addProddableBlock(oc, start, end - start + 1);
2638 /* Copy exported symbols into the ObjectCode. */
2640 oc->n_symbols = hdr->NumberOfSymbols;
2641 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2642 "ocGetNames_PEi386(oc->symbols)");
2643 /* Call me paranoid; I don't care. */
2644 for (i = 0; i < oc->n_symbols; i++)
2645 oc->symbols[i] = NULL;
2649 COFF_symbol* symtab_i;
2650 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2651 symtab_i = (COFF_symbol*)
2652 myindex ( sizeof_COFF_symbol, symtab, i );
2656 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2657 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2658 /* This symbol is global and defined, viz, exported */
2659 /* for MYIMAGE_SYMCLASS_EXTERNAL
2660 && !MYIMAGE_SYM_UNDEFINED,
2661 the address of the symbol is:
2662 address of relevant section + offset in section
2664 COFF_section* sectabent
2665 = (COFF_section*) myindex ( sizeof_COFF_section,
2667 symtab_i->SectionNumber-1 );
2668 addr = ((UChar*)(oc->image))
2669 + (sectabent->PointerToRawData
2673 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2674 && symtab_i->Value > 0) {
2675 /* This symbol isn't in any section at all, ie, global bss.
2676 Allocate zeroed space for it. */
2677 addr = stgCallocBytes(1, symtab_i->Value,
2678 "ocGetNames_PEi386(non-anonymous bss)");
2679 addSection(oc, SECTIONKIND_RWDATA, addr,
2680 ((UChar*)addr) + symtab_i->Value - 1);
2681 addProddableBlock(oc, addr, symtab_i->Value);
2682 /* debugBelch("BSS section at 0x%x\n", addr); */
2685 if (addr != NULL ) {
2686 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2687 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2688 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2689 ASSERT(i >= 0 && i < oc->n_symbols);
2690 /* cstring_from_COFF_symbol_name always succeeds. */
2691 oc->symbols[i] = sname;
2692 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2696 "IGNORING symbol %d\n"
2700 printName ( symtab_i->Name, strtab );
2709 (Int32)(symtab_i->SectionNumber),
2710 (UInt32)symtab_i->Type,
2711 (UInt32)symtab_i->StorageClass,
2712 (UInt32)symtab_i->NumberOfAuxSymbols
2717 i += symtab_i->NumberOfAuxSymbols;
2726 ocResolve_PEi386 ( ObjectCode* oc )
2729 COFF_section* sectab;
2730 COFF_symbol* symtab;
2740 /* ToDo: should be variable-sized? But is at least safe in the
2741 sense of buffer-overrun-proof. */
2743 /* debugBelch("resolving for %s\n", oc->fileName); */
2745 hdr = (COFF_header*)(oc->image);
2746 sectab = (COFF_section*) (
2747 ((UChar*)(oc->image))
2748 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2750 symtab = (COFF_symbol*) (
2751 ((UChar*)(oc->image))
2752 + hdr->PointerToSymbolTable
2754 strtab = ((UChar*)(oc->image))
2755 + hdr->PointerToSymbolTable
2756 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2758 for (i = 0; i < hdr->NumberOfSections; i++) {
2759 COFF_section* sectab_i
2761 myindex ( sizeof_COFF_section, sectab, i );
2764 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2767 /* Ignore sections called which contain stabs debugging
2769 if (0 == strcmp(".stab", sectab_i->Name)
2770 || 0 == strcmp(".stabstr", sectab_i->Name)
2771 || 0 == strcmp(".ctors", sectab_i->Name))
2774 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2775 /* If the relocation field (a short) has overflowed, the
2776 * real count can be found in the first reloc entry.
2778 * See Section 4.1 (last para) of the PE spec (rev6.0).
2780 * Nov2003 update: the GNU linker still doesn't correctly
2781 * handle the generation of relocatable object files with
2782 * overflown relocations. Hence the output to warn of potential
2785 COFF_reloc* rel = (COFF_reloc*)
2786 myindex ( sizeof_COFF_reloc, reltab, 0 );
2787 noRelocs = rel->VirtualAddress;
2789 /* 10/05: we now assume (and check for) a GNU ld that is capable
2790 * of handling object files with (>2^16) of relocs.
2793 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2798 noRelocs = sectab_i->NumberOfRelocations;
2803 for (; j < noRelocs; j++) {
2805 COFF_reloc* reltab_j
2807 myindex ( sizeof_COFF_reloc, reltab, j );
2809 /* the location to patch */
2811 ((UChar*)(oc->image))
2812 + (sectab_i->PointerToRawData
2813 + reltab_j->VirtualAddress
2814 - sectab_i->VirtualAddress )
2816 /* the existing contents of pP */
2818 /* the symbol to connect to */
2819 sym = (COFF_symbol*)
2820 myindex ( sizeof_COFF_symbol,
2821 symtab, reltab_j->SymbolTableIndex );
2824 "reloc sec %2d num %3d: type 0x%-4x "
2825 "vaddr 0x%-8x name `",
2827 (UInt32)reltab_j->Type,
2828 reltab_j->VirtualAddress );
2829 printName ( sym->Name, strtab );
2830 debugBelch("'\n" ));
2832 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2833 COFF_section* section_sym
2834 = findPEi386SectionCalled ( oc, sym->Name );
2836 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2839 S = ((UInt32)(oc->image))
2840 + (section_sym->PointerToRawData
2843 copyName ( sym->Name, strtab, symbol, 1000-1 );
2844 S = (UInt32) lookupSymbol( symbol );
2845 if ((void*)S != NULL) goto foundit;
2846 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2850 checkProddableBlock(oc, pP);
2851 switch (reltab_j->Type) {
2852 case MYIMAGE_REL_I386_DIR32:
2855 case MYIMAGE_REL_I386_REL32:
2856 /* Tricky. We have to insert a displacement at
2857 pP which, when added to the PC for the _next_
2858 insn, gives the address of the target (S).
2859 Problem is to know the address of the next insn
2860 when we only know pP. We assume that this
2861 literal field is always the last in the insn,
2862 so that the address of the next insn is pP+4
2863 -- hence the constant 4.
2864 Also I don't know if A should be added, but so
2865 far it has always been zero.
2867 SOF 05/2005: 'A' (old contents of *pP) have been observed
2868 to contain values other than zero (the 'wx' object file
2869 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2870 So, add displacement to old value instead of asserting
2871 A to be zero. Fixes wxhaskell-related crashes, and no other
2872 ill effects have been observed.
2874 Update: the reason why we're seeing these more elaborate
2875 relocations is due to a switch in how the NCG compiles SRTs
2876 and offsets to them from info tables. SRTs live in .(ro)data,
2877 while info tables live in .text, causing GAS to emit REL32/DISP32
2878 relocations with non-zero values. Adding the displacement is
2879 the right thing to do.
2881 *pP = S - ((UInt32)pP) - 4 + A;
2884 debugBelch("%s: unhandled PEi386 relocation type %d",
2885 oc->fileName, reltab_j->Type);
2892 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2896 #endif /* defined(OBJFORMAT_PEi386) */
2899 /* --------------------------------------------------------------------------
2901 * ------------------------------------------------------------------------*/
2903 #if defined(OBJFORMAT_ELF)
2908 #if defined(sparc_HOST_ARCH)
2909 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2910 #elif defined(i386_HOST_ARCH)
2911 # define ELF_TARGET_386 /* Used inside <elf.h> */
2912 #elif defined(x86_64_HOST_ARCH)
2913 # define ELF_TARGET_X64_64
2917 #if !defined(openbsd_HOST_OS)
2920 /* openbsd elf has things in different places, with diff names */
2921 # include <elf_abi.h>
2922 # include <machine/reloc.h>
2923 # define R_386_32 RELOC_32
2924 # define R_386_PC32 RELOC_PC32
2927 /* If elf.h doesn't define it */
2928 # ifndef R_X86_64_PC64
2929 # define R_X86_64_PC64 24
2933 * Define a set of types which can be used for both ELF32 and ELF64
2937 #define ELFCLASS ELFCLASS64
2938 #define Elf_Addr Elf64_Addr
2939 #define Elf_Word Elf64_Word
2940 #define Elf_Sword Elf64_Sword
2941 #define Elf_Ehdr Elf64_Ehdr
2942 #define Elf_Phdr Elf64_Phdr
2943 #define Elf_Shdr Elf64_Shdr
2944 #define Elf_Sym Elf64_Sym
2945 #define Elf_Rel Elf64_Rel
2946 #define Elf_Rela Elf64_Rela
2947 #define ELF_ST_TYPE ELF64_ST_TYPE
2948 #define ELF_ST_BIND ELF64_ST_BIND
2949 #define ELF_R_TYPE ELF64_R_TYPE
2950 #define ELF_R_SYM ELF64_R_SYM
2952 #define ELFCLASS ELFCLASS32
2953 #define Elf_Addr Elf32_Addr
2954 #define Elf_Word Elf32_Word
2955 #define Elf_Sword Elf32_Sword
2956 #define Elf_Ehdr Elf32_Ehdr
2957 #define Elf_Phdr Elf32_Phdr
2958 #define Elf_Shdr Elf32_Shdr
2959 #define Elf_Sym Elf32_Sym
2960 #define Elf_Rel Elf32_Rel
2961 #define Elf_Rela Elf32_Rela
2963 #define ELF_ST_TYPE ELF32_ST_TYPE
2966 #define ELF_ST_BIND ELF32_ST_BIND
2969 #define ELF_R_TYPE ELF32_R_TYPE
2972 #define ELF_R_SYM ELF32_R_SYM
2978 * Functions to allocate entries in dynamic sections. Currently we simply
2979 * preallocate a large number, and we don't check if a entry for the given
2980 * target already exists (a linear search is too slow). Ideally these
2981 * entries would be associated with symbols.
2984 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2985 #define GOT_SIZE 0x20000
2986 #define FUNCTION_TABLE_SIZE 0x10000
2987 #define PLT_SIZE 0x08000
2990 static Elf_Addr got[GOT_SIZE];
2991 static unsigned int gotIndex;
2992 static Elf_Addr gp_val = (Elf_Addr)got;
2995 allocateGOTEntry(Elf_Addr target)
2999 if (gotIndex >= GOT_SIZE)
3000 barf("Global offset table overflow");
3002 entry = &got[gotIndex++];
3004 return (Elf_Addr)entry;
3008 #ifdef ELF_FUNCTION_DESC
3014 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
3015 static unsigned int functionTableIndex;
3018 allocateFunctionDesc(Elf_Addr target)
3020 FunctionDesc *entry;
3022 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
3023 barf("Function table overflow");
3025 entry = &functionTable[functionTableIndex++];
3027 entry->gp = (Elf_Addr)gp_val;
3028 return (Elf_Addr)entry;
3032 copyFunctionDesc(Elf_Addr target)
3034 FunctionDesc *olddesc = (FunctionDesc *)target;
3035 FunctionDesc *newdesc;
3037 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
3038 newdesc->gp = olddesc->gp;
3039 return (Elf_Addr)newdesc;
3046 unsigned char code[sizeof(plt_code)];
3050 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
3052 PLTEntry *plt = (PLTEntry *)oc->plt;
3055 if (oc->pltIndex >= PLT_SIZE)
3056 barf("Procedure table overflow");
3058 entry = &plt[oc->pltIndex++];
3059 memcpy(entry->code, plt_code, sizeof(entry->code));
3060 PLT_RELOC(entry->code, target);
3061 return (Elf_Addr)entry;
3067 return (PLT_SIZE * sizeof(PLTEntry));
3073 * Generic ELF functions
3077 findElfSection ( void* objImage, Elf_Word sh_type )
3079 char* ehdrC = (char*)objImage;
3080 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3081 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
3082 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3086 for (i = 0; i < ehdr->e_shnum; i++) {
3087 if (shdr[i].sh_type == sh_type
3088 /* Ignore the section header's string table. */
3089 && i != ehdr->e_shstrndx
3090 /* Ignore string tables named .stabstr, as they contain
3092 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3094 ptr = ehdrC + shdr[i].sh_offset;
3102 ocVerifyImage_ELF ( ObjectCode* oc )
3106 int i, j, nent, nstrtab, nsymtabs;
3110 char* ehdrC = (char*)(oc->image);
3111 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3113 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
3114 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
3115 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
3116 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
3117 errorBelch("%s: not an ELF object", oc->fileName);
3121 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
3122 errorBelch("%s: unsupported ELF format", oc->fileName);
3126 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
3127 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
3129 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
3130 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
3132 errorBelch("%s: unknown endiannness", oc->fileName);
3136 if (ehdr->e_type != ET_REL) {
3137 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
3140 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
3142 IF_DEBUG(linker,debugBelch( "Architecture is " ));
3143 switch (ehdr->e_machine) {
3144 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
3145 #ifdef EM_SPARC32PLUS
3146 case EM_SPARC32PLUS:
3148 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
3150 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
3152 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
3154 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
3155 #elif defined(EM_AMD64)
3156 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
3158 default: IF_DEBUG(linker,debugBelch( "unknown" ));
3159 errorBelch("%s: unknown architecture (e_machine == %d)"
3160 , oc->fileName, ehdr->e_machine);
3164 IF_DEBUG(linker,debugBelch(
3165 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
3166 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
3168 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
3170 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3172 if (ehdr->e_shstrndx == SHN_UNDEF) {
3173 errorBelch("%s: no section header string table", oc->fileName);
3176 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
3178 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3181 for (i = 0; i < ehdr->e_shnum; i++) {
3182 IF_DEBUG(linker,debugBelch("%2d: ", i ));
3183 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
3184 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
3185 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
3186 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
3187 ehdrC + shdr[i].sh_offset,
3188 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
3190 if (shdr[i].sh_type == SHT_REL) {
3191 IF_DEBUG(linker,debugBelch("Rel " ));
3192 } else if (shdr[i].sh_type == SHT_RELA) {
3193 IF_DEBUG(linker,debugBelch("RelA " ));
3195 IF_DEBUG(linker,debugBelch(" "));
3198 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
3202 IF_DEBUG(linker,debugBelch( "\nString tables" ));
3205 for (i = 0; i < ehdr->e_shnum; i++) {
3206 if (shdr[i].sh_type == SHT_STRTAB
3207 /* Ignore the section header's string table. */
3208 && i != ehdr->e_shstrndx
3209 /* Ignore string tables named .stabstr, as they contain
3211 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3213 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
3214 strtab = ehdrC + shdr[i].sh_offset;
3219 errorBelch("%s: no string tables, or too many", oc->fileName);
3224 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
3225 for (i = 0; i < ehdr->e_shnum; i++) {
3226 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3227 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
3229 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3230 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3231 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
3233 (long)shdr[i].sh_size % sizeof(Elf_Sym)
3235 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
3236 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
3239 for (j = 0; j < nent; j++) {
3240 IF_DEBUG(linker,debugBelch(" %2d ", j ));
3241 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
3242 (int)stab[j].st_shndx,
3243 (int)stab[j].st_size,
3244 (char*)stab[j].st_value ));
3246 IF_DEBUG(linker,debugBelch("type=" ));
3247 switch (ELF_ST_TYPE(stab[j].st_info)) {
3248 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
3249 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
3250 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
3251 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
3252 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
3253 default: IF_DEBUG(linker,debugBelch("? " )); break;
3255 IF_DEBUG(linker,debugBelch(" " ));
3257 IF_DEBUG(linker,debugBelch("bind=" ));
3258 switch (ELF_ST_BIND(stab[j].st_info)) {
3259 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
3260 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
3261 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
3262 default: IF_DEBUG(linker,debugBelch("? " )); break;
3264 IF_DEBUG(linker,debugBelch(" " ));
3266 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3270 if (nsymtabs == 0) {
3271 errorBelch("%s: didn't find any symbol tables", oc->fileName);
3278 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3282 if (hdr->sh_type == SHT_PROGBITS
3283 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3284 /* .text-style section */
3285 return SECTIONKIND_CODE_OR_RODATA;
3288 if (hdr->sh_type == SHT_PROGBITS
3289 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3290 /* .data-style section */
3291 return SECTIONKIND_RWDATA;
3294 if (hdr->sh_type == SHT_PROGBITS
3295 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3296 /* .rodata-style section */
3297 return SECTIONKIND_CODE_OR_RODATA;
3300 if (hdr->sh_type == SHT_NOBITS
3301 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3302 /* .bss-style section */
3304 return SECTIONKIND_RWDATA;
3307 return SECTIONKIND_OTHER;
3312 ocGetNames_ELF ( ObjectCode* oc )
3317 char* ehdrC = (char*)(oc->image);
3318 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3319 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3320 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3322 ASSERT(symhash != NULL);
3325 errorBelch("%s: no strtab", oc->fileName);
3330 for (i = 0; i < ehdr->e_shnum; i++) {
3331 /* Figure out what kind of section it is. Logic derived from
3332 Figure 1.14 ("Special Sections") of the ELF document
3333 ("Portable Formats Specification, Version 1.1"). */
3335 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3337 if (is_bss && shdr[i].sh_size > 0) {
3338 /* This is a non-empty .bss section. Allocate zeroed space for
3339 it, and set its .sh_offset field such that
3340 ehdrC + .sh_offset == addr_of_zeroed_space. */
3341 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3342 "ocGetNames_ELF(BSS)");
3343 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3345 debugBelch("BSS section at 0x%x, size %d\n",
3346 zspace, shdr[i].sh_size);
3350 /* fill in the section info */
3351 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3352 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3353 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3354 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3357 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3359 /* copy stuff into this module's object symbol table */
3360 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3361 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3363 oc->n_symbols = nent;
3364 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3365 "ocGetNames_ELF(oc->symbols)");
3367 for (j = 0; j < nent; j++) {
3369 char isLocal = FALSE; /* avoids uninit-var warning */
3371 char* nm = strtab + stab[j].st_name;
3372 int secno = stab[j].st_shndx;
3374 /* Figure out if we want to add it; if so, set ad to its
3375 address. Otherwise leave ad == NULL. */
3377 if (secno == SHN_COMMON) {
3379 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3381 debugBelch("COMMON symbol, size %d name %s\n",
3382 stab[j].st_size, nm);
3384 /* Pointless to do addProddableBlock() for this area,
3385 since the linker should never poke around in it. */
3388 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3389 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3391 /* and not an undefined symbol */
3392 && stab[j].st_shndx != SHN_UNDEF
3393 /* and not in a "special section" */
3394 && stab[j].st_shndx < SHN_LORESERVE
3396 /* and it's a not a section or string table or anything silly */
3397 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3398 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3399 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3402 /* Section 0 is the undefined section, hence > and not >=. */
3403 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3405 if (shdr[secno].sh_type == SHT_NOBITS) {
3406 debugBelch(" BSS symbol, size %d off %d name %s\n",
3407 stab[j].st_size, stab[j].st_value, nm);
3410 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3411 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3414 #ifdef ELF_FUNCTION_DESC
3415 /* dlsym() and the initialisation table both give us function
3416 * descriptors, so to be consistent we store function descriptors
3417 * in the symbol table */
3418 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3419 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3421 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
3422 ad, oc->fileName, nm ));
3427 /* And the decision is ... */
3431 oc->symbols[j] = nm;
3434 /* Ignore entirely. */
3436 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3440 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3441 strtab + stab[j].st_name ));
3444 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3445 (int)ELF_ST_BIND(stab[j].st_info),
3446 (int)ELF_ST_TYPE(stab[j].st_info),
3447 (int)stab[j].st_shndx,
3448 strtab + stab[j].st_name
3451 oc->symbols[j] = NULL;
3460 /* Do ELF relocations which lack an explicit addend. All x86-linux
3461 relocations appear to be of this form. */
3463 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3464 Elf_Shdr* shdr, int shnum,
3465 Elf_Sym* stab, char* strtab )
3470 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3471 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3472 int target_shndx = shdr[shnum].sh_info;
3473 int symtab_shndx = shdr[shnum].sh_link;
3475 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3476 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3477 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3478 target_shndx, symtab_shndx ));
3480 /* Skip sections that we're not interested in. */
3483 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3484 if (kind == SECTIONKIND_OTHER) {
3485 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3490 for (j = 0; j < nent; j++) {
3491 Elf_Addr offset = rtab[j].r_offset;
3492 Elf_Addr info = rtab[j].r_info;
3494 Elf_Addr P = ((Elf_Addr)targ) + offset;
3495 Elf_Word* pP = (Elf_Word*)P;
3500 StgStablePtr stablePtr;
3503 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3504 j, (void*)offset, (void*)info ));
3506 IF_DEBUG(linker,debugBelch( " ZERO" ));
3509 Elf_Sym sym = stab[ELF_R_SYM(info)];
3510 /* First see if it is a local symbol. */
3511 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3512 /* Yes, so we can get the address directly from the ELF symbol
3514 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3516 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3517 + stab[ELF_R_SYM(info)].st_value);
3520 symbol = strtab + sym.st_name;
3521 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3522 if (NULL == stablePtr) {
3523 /* No, so look up the name in our global table. */
3524 S_tmp = lookupSymbol( symbol );
3525 S = (Elf_Addr)S_tmp;
3527 stableVal = deRefStablePtr( stablePtr );
3529 S = (Elf_Addr)S_tmp;
3533 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3536 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3539 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3540 (void*)P, (void*)S, (void*)A ));
3541 checkProddableBlock ( oc, pP );
3545 switch (ELF_R_TYPE(info)) {
3546 # ifdef i386_HOST_ARCH
3547 case R_386_32: *pP = value; break;
3548 case R_386_PC32: *pP = value - P; break;
3551 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3552 oc->fileName, (lnat)ELF_R_TYPE(info));
3560 /* Do ELF relocations for which explicit addends are supplied.
3561 sparc-solaris relocations appear to be of this form. */
3563 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3564 Elf_Shdr* shdr, int shnum,
3565 Elf_Sym* stab, char* strtab )
3568 char *symbol = NULL;
3570 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3571 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3572 int target_shndx = shdr[shnum].sh_info;
3573 int symtab_shndx = shdr[shnum].sh_link;
3575 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3576 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3577 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3578 target_shndx, symtab_shndx ));
3580 for (j = 0; j < nent; j++) {
3581 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3582 /* This #ifdef only serves to avoid unused-var warnings. */
3583 Elf_Addr offset = rtab[j].r_offset;
3584 Elf_Addr P = targ + offset;
3586 Elf_Addr info = rtab[j].r_info;
3587 Elf_Addr A = rtab[j].r_addend;
3591 # if defined(sparc_HOST_ARCH)
3592 Elf_Word* pP = (Elf_Word*)P;
3594 # elif defined(powerpc_HOST_ARCH)
3598 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3599 j, (void*)offset, (void*)info,
3602 IF_DEBUG(linker,debugBelch( " ZERO" ));
3605 Elf_Sym sym = stab[ELF_R_SYM(info)];
3606 /* First see if it is a local symbol. */
3607 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3608 /* Yes, so we can get the address directly from the ELF symbol
3610 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3612 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3613 + stab[ELF_R_SYM(info)].st_value);
3614 #ifdef ELF_FUNCTION_DESC
3615 /* Make a function descriptor for this function */
3616 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3617 S = allocateFunctionDesc(S + A);
3622 /* No, so look up the name in our global table. */
3623 symbol = strtab + sym.st_name;
3624 S_tmp = lookupSymbol( symbol );
3625 S = (Elf_Addr)S_tmp;
3627 #ifdef ELF_FUNCTION_DESC
3628 /* If a function, already a function descriptor - we would
3629 have to copy it to add an offset. */
3630 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3631 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3635 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3638 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3641 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3642 (void*)P, (void*)S, (void*)A ));
3643 /* checkProddableBlock ( oc, (void*)P ); */
3647 switch (ELF_R_TYPE(info)) {
3648 # if defined(sparc_HOST_ARCH)
3649 case R_SPARC_WDISP30:
3650 w1 = *pP & 0xC0000000;
3651 w2 = (Elf_Word)((value - P) >> 2);
3652 ASSERT((w2 & 0xC0000000) == 0);
3657 w1 = *pP & 0xFFC00000;
3658 w2 = (Elf_Word)(value >> 10);
3659 ASSERT((w2 & 0xFFC00000) == 0);
3665 w2 = (Elf_Word)(value & 0x3FF);
3666 ASSERT((w2 & ~0x3FF) == 0);
3671 /* According to the Sun documentation:
3673 This relocation type resembles R_SPARC_32, except it refers to an
3674 unaligned word. That is, the word to be relocated must be treated
3675 as four separate bytes with arbitrary alignment, not as a word
3676 aligned according to the architecture requirements.
3679 w2 = (Elf_Word)value;
3681 // SPARC doesn't do misaligned writes of 32 bit words,
3682 // so we have to do this one byte-at-a-time.
3683 char *pPc = (char*)pP;
3684 pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
3685 pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
3686 pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
3687 pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
3691 w2 = (Elf_Word)value;
3694 # elif defined(powerpc_HOST_ARCH)
3695 case R_PPC_ADDR16_LO:
3696 *(Elf32_Half*) P = value;
3699 case R_PPC_ADDR16_HI:
3700 *(Elf32_Half*) P = value >> 16;
3703 case R_PPC_ADDR16_HA:
3704 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3708 *(Elf32_Word *) P = value;
3712 *(Elf32_Word *) P = value - P;
3718 if( delta << 6 >> 6 != delta )
3720 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
3724 if( value == 0 || delta << 6 >> 6 != delta )
3726 barf( "Unable to make SymbolExtra for #%d",
3732 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3733 | (delta & 0x3fffffc);
3737 #if x86_64_HOST_ARCH
3739 *(Elf64_Xword *)P = value;
3744 StgInt64 off = value - P;
3745 if (off >= 0x7fffffffL || off < -0x80000000L) {
3746 #if X86_64_ELF_NONPIC_HACK
3747 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3749 off = pltAddress + A - P;
3751 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3752 symbol, off, oc->fileName );
3755 *(Elf64_Word *)P = (Elf64_Word)off;
3761 StgInt64 off = value - P;
3762 *(Elf64_Word *)P = (Elf64_Word)off;
3767 if (value >= 0x7fffffffL) {
3768 #if X86_64_ELF_NONPIC_HACK
3769 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3771 value = pltAddress + A;
3773 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3774 symbol, value, oc->fileName );
3777 *(Elf64_Word *)P = (Elf64_Word)value;
3781 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3782 #if X86_64_ELF_NONPIC_HACK
3783 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3785 value = pltAddress + A;
3787 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3788 symbol, value, oc->fileName );
3791 *(Elf64_Sword *)P = (Elf64_Sword)value;
3794 case R_X86_64_GOTPCREL:
3796 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
3797 StgInt64 off = gotAddress + A - P;
3798 *(Elf64_Word *)P = (Elf64_Word)off;
3802 case R_X86_64_PLT32:
3804 StgInt64 off = value - P;
3805 if (off >= 0x7fffffffL || off < -0x80000000L) {
3806 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3808 off = pltAddress + A - P;
3810 *(Elf64_Word *)P = (Elf64_Word)off;
3816 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3817 oc->fileName, (lnat)ELF_R_TYPE(info));
3826 ocResolve_ELF ( ObjectCode* oc )
3830 Elf_Sym* stab = NULL;
3831 char* ehdrC = (char*)(oc->image);
3832 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3833 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3835 /* first find "the" symbol table */
3836 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3838 /* also go find the string table */
3839 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3841 if (stab == NULL || strtab == NULL) {
3842 errorBelch("%s: can't find string or symbol table", oc->fileName);
3846 /* Process the relocation sections. */
3847 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3848 if (shdr[shnum].sh_type == SHT_REL) {
3849 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3850 shnum, stab, strtab );
3854 if (shdr[shnum].sh_type == SHT_RELA) {
3855 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3856 shnum, stab, strtab );
3861 #if defined(powerpc_HOST_ARCH)
3862 ocFlushInstructionCache( oc );
3869 * PowerPC & X86_64 ELF specifics
3872 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3874 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
3880 ehdr = (Elf_Ehdr *) oc->image;
3881 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3883 for( i = 0; i < ehdr->e_shnum; i++ )
3884 if( shdr[i].sh_type == SHT_SYMTAB )
3887 if( i == ehdr->e_shnum )
3889 errorBelch( "This ELF file contains no symtab" );
3893 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3895 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3896 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
3901 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3904 #endif /* powerpc */
3908 /* --------------------------------------------------------------------------
3910 * ------------------------------------------------------------------------*/
3912 #if defined(OBJFORMAT_MACHO)
3915 Support for MachO linking on Darwin/MacOS X
3916 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3918 I hereby formally apologize for the hackish nature of this code.
3919 Things that need to be done:
3920 *) implement ocVerifyImage_MachO
3921 *) add still more sanity checks.
3924 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
3925 #define mach_header mach_header_64
3926 #define segment_command segment_command_64
3927 #define section section_64
3928 #define nlist nlist_64
3931 #ifdef powerpc_HOST_ARCH
3932 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3934 struct mach_header *header = (struct mach_header *) oc->image;
3935 struct load_command *lc = (struct load_command *) (header + 1);
3938 for( i = 0; i < header->ncmds; i++ )
3940 if( lc->cmd == LC_SYMTAB )
3942 // Find out the first and last undefined external
3943 // symbol, so we don't have to allocate too many
3945 struct symtab_command *symLC = (struct symtab_command *) lc;
3946 unsigned min = symLC->nsyms, max = 0;
3947 struct nlist *nlist =
3948 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3950 for(i=0;i<symLC->nsyms;i++)
3952 if(nlist[i].n_type & N_STAB)
3954 else if(nlist[i].n_type & N_EXT)
3956 if((nlist[i].n_type & N_TYPE) == N_UNDF
3957 && (nlist[i].n_value == 0))
3967 return ocAllocateSymbolExtras(oc, max - min + 1, min);
3972 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3974 return ocAllocateSymbolExtras(oc,0,0);
3977 #ifdef x86_64_HOST_ARCH
3978 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3980 struct mach_header *header = (struct mach_header *) oc->image;
3981 struct load_command *lc = (struct load_command *) (header + 1);
3984 for( i = 0; i < header->ncmds; i++ )
3986 if( lc->cmd == LC_SYMTAB )
3988 // Just allocate one entry for every symbol
3989 struct symtab_command *symLC = (struct symtab_command *) lc;
3991 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
3994 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3996 return ocAllocateSymbolExtras(oc,0,0);
4000 static int ocVerifyImage_MachO(ObjectCode* oc)
4002 char *image = (char*) oc->image;
4003 struct mach_header *header = (struct mach_header*) image;
4005 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4006 if(header->magic != MH_MAGIC_64)
4009 if(header->magic != MH_MAGIC)
4012 // FIXME: do some more verifying here
4016 static int resolveImports(
4019 struct symtab_command *symLC,
4020 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
4021 unsigned long *indirectSyms,
4022 struct nlist *nlist)
4025 size_t itemSize = 4;
4028 int isJumpTable = 0;
4029 if(!strcmp(sect->sectname,"__jump_table"))
4033 ASSERT(sect->reserved2 == itemSize);
4037 for(i=0; i*itemSize < sect->size;i++)
4039 // according to otool, reserved1 contains the first index into the indirect symbol table
4040 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
4041 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4044 if((symbol->n_type & N_TYPE) == N_UNDF
4045 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
4046 addr = (void*) (symbol->n_value);
4048 addr = lookupSymbol(nm);
4051 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
4059 checkProddableBlock(oc,image + sect->offset + i*itemSize);
4060 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
4061 *(unsigned*)(image + sect->offset + i*itemSize + 1)
4062 = (char*)addr - (image + sect->offset + i*itemSize + 5);
4067 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
4068 ((void**)(image + sect->offset))[i] = addr;
4075 static unsigned long relocateAddress(
4078 struct section* sections,
4079 unsigned long address)
4082 for(i = 0; i < nSections; i++)
4084 if(sections[i].addr <= address
4085 && address < sections[i].addr + sections[i].size)
4087 return (unsigned long)oc->image
4088 + sections[i].offset + address - sections[i].addr;
4091 barf("Invalid Mach-O file:"
4092 "Address out of bounds while relocating object file");
4096 static int relocateSection(
4099 struct symtab_command *symLC, struct nlist *nlist,
4100 int nSections, struct section* sections, struct section *sect)
4102 struct relocation_info *relocs;
4105 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
4107 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
4109 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
4111 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
4115 relocs = (struct relocation_info*) (image + sect->reloff);
4119 #ifdef x86_64_HOST_ARCH
4120 struct relocation_info *reloc = &relocs[i];
4122 char *thingPtr = image + sect->offset + reloc->r_address;
4124 /* We shouldn't need to initialise this, but gcc on OS X 64 bit
4125 complains that it may be used uninitialized if we don't */
4128 int type = reloc->r_type;
4130 checkProddableBlock(oc,thingPtr);
4131 switch(reloc->r_length)
4134 thing = *(uint8_t*)thingPtr;
4135 baseValue = (uint64_t)thingPtr + 1;
4138 thing = *(uint16_t*)thingPtr;
4139 baseValue = (uint64_t)thingPtr + 2;
4142 thing = *(uint32_t*)thingPtr;
4143 baseValue = (uint64_t)thingPtr + 4;
4146 thing = *(uint64_t*)thingPtr;
4147 baseValue = (uint64_t)thingPtr + 8;
4150 barf("Unknown size.");
4153 if(type == X86_64_RELOC_GOT
4154 || type == X86_64_RELOC_GOT_LOAD)
4156 ASSERT(reloc->r_extern);
4157 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
4159 type = X86_64_RELOC_SIGNED;
4161 else if(reloc->r_extern)
4163 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4164 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4165 if(symbol->n_value == 0)
4166 value = (uint64_t) lookupSymbol(nm);
4168 value = relocateAddress(oc, nSections, sections,
4173 value = sections[reloc->r_symbolnum-1].offset
4174 - sections[reloc->r_symbolnum-1].addr
4178 if(type == X86_64_RELOC_BRANCH)
4180 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4182 ASSERT(reloc->r_extern);
4183 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4186 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4187 type = X86_64_RELOC_SIGNED;
4192 case X86_64_RELOC_UNSIGNED:
4193 ASSERT(!reloc->r_pcrel);
4196 case X86_64_RELOC_SIGNED:
4197 ASSERT(reloc->r_pcrel);
4198 thing += value - baseValue;
4200 case X86_64_RELOC_SUBTRACTOR:
4201 ASSERT(!reloc->r_pcrel);
4205 barf("unkown relocation");
4208 switch(reloc->r_length)
4211 *(uint8_t*)thingPtr = thing;
4214 *(uint16_t*)thingPtr = thing;
4217 *(uint32_t*)thingPtr = thing;
4220 *(uint64_t*)thingPtr = thing;
4224 if(relocs[i].r_address & R_SCATTERED)
4226 struct scattered_relocation_info *scat =
4227 (struct scattered_relocation_info*) &relocs[i];
4231 if(scat->r_length == 2)
4233 unsigned long word = 0;
4234 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4235 checkProddableBlock(oc,wordPtr);
4237 // Note on relocation types:
4238 // i386 uses the GENERIC_RELOC_* types,
4239 // while ppc uses special PPC_RELOC_* types.
4240 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4241 // in both cases, all others are different.
4242 // Therefore, we use GENERIC_RELOC_VANILLA
4243 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4244 // and use #ifdefs for the other types.
4246 // Step 1: Figure out what the relocated value should be
4247 if(scat->r_type == GENERIC_RELOC_VANILLA)
4249 word = *wordPtr + (unsigned long) relocateAddress(
4256 #ifdef powerpc_HOST_ARCH
4257 else if(scat->r_type == PPC_RELOC_SECTDIFF
4258 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4259 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4260 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
4262 else if(scat->r_type == GENERIC_RELOC_SECTDIFF
4263 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4266 struct scattered_relocation_info *pair =
4267 (struct scattered_relocation_info*) &relocs[i+1];
4269 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4270 barf("Invalid Mach-O file: "
4271 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4273 word = (unsigned long)
4274 (relocateAddress(oc, nSections, sections, scat->r_value)
4275 - relocateAddress(oc, nSections, sections, pair->r_value));
4278 #ifdef powerpc_HOST_ARCH
4279 else if(scat->r_type == PPC_RELOC_HI16
4280 || scat->r_type == PPC_RELOC_LO16
4281 || scat->r_type == PPC_RELOC_HA16
4282 || scat->r_type == PPC_RELOC_LO14)
4283 { // these are generated by label+offset things
4284 struct relocation_info *pair = &relocs[i+1];
4285 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4286 barf("Invalid Mach-O file: "
4287 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4289 if(scat->r_type == PPC_RELOC_LO16)
4291 word = ((unsigned short*) wordPtr)[1];
4292 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4294 else if(scat->r_type == PPC_RELOC_LO14)
4296 barf("Unsupported Relocation: PPC_RELOC_LO14");
4297 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4298 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4300 else if(scat->r_type == PPC_RELOC_HI16)
4302 word = ((unsigned short*) wordPtr)[1] << 16;
4303 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4305 else if(scat->r_type == PPC_RELOC_HA16)
4307 word = ((unsigned short*) wordPtr)[1] << 16;
4308 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4312 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4320 barf ("Don't know how to handle this Mach-O "
4321 "scattered relocation entry: "
4322 "object file %s; entry type %ld; "
4324 oc->fileName, scat->r_type, scat->r_address);
4328 #ifdef powerpc_HOST_ARCH
4329 if(scat->r_type == GENERIC_RELOC_VANILLA
4330 || scat->r_type == PPC_RELOC_SECTDIFF)
4332 if(scat->r_type == GENERIC_RELOC_VANILLA
4333 || scat->r_type == GENERIC_RELOC_SECTDIFF
4334 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4339 #ifdef powerpc_HOST_ARCH
4340 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4342 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4344 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4346 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4348 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4350 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4351 + ((word & (1<<15)) ? 1 : 0);
4357 barf("Can't handle Mach-O scattered relocation entry "
4358 "with this r_length tag: "
4359 "object file %s; entry type %ld; "
4360 "r_length tag %ld; address %#lx\n",
4361 oc->fileName, scat->r_type, scat->r_length,
4366 else /* scat->r_pcrel */
4368 barf("Don't know how to handle *PC-relative* Mach-O "
4369 "scattered relocation entry: "
4370 "object file %s; entry type %ld; address %#lx\n",
4371 oc->fileName, scat->r_type, scat->r_address);
4376 else /* !(relocs[i].r_address & R_SCATTERED) */
4378 struct relocation_info *reloc = &relocs[i];
4379 if(reloc->r_pcrel && !reloc->r_extern)
4382 if(reloc->r_length == 2)
4384 unsigned long word = 0;
4385 #ifdef powerpc_HOST_ARCH
4386 unsigned long jumpIsland = 0;
4387 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4388 // to avoid warning and to catch
4392 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4393 checkProddableBlock(oc,wordPtr);
4395 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4399 #ifdef powerpc_HOST_ARCH
4400 else if(reloc->r_type == PPC_RELOC_LO16)
4402 word = ((unsigned short*) wordPtr)[1];
4403 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4405 else if(reloc->r_type == PPC_RELOC_HI16)
4407 word = ((unsigned short*) wordPtr)[1] << 16;
4408 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4410 else if(reloc->r_type == PPC_RELOC_HA16)
4412 word = ((unsigned short*) wordPtr)[1] << 16;
4413 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4415 else if(reloc->r_type == PPC_RELOC_BR24)
4418 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4423 barf("Can't handle this Mach-O relocation entry "
4425 "object file %s; entry type %ld; address %#lx\n",
4426 oc->fileName, reloc->r_type, reloc->r_address);
4430 if(!reloc->r_extern)
4433 sections[reloc->r_symbolnum-1].offset
4434 - sections[reloc->r_symbolnum-1].addr
4441 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4442 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4443 void *symbolAddress = lookupSymbol(nm);
4446 errorBelch("\nunknown symbol `%s'", nm);
4452 #ifdef powerpc_HOST_ARCH
4453 // In the .o file, this should be a relative jump to NULL
4454 // and we'll change it to a relative jump to the symbol
4455 ASSERT(word + reloc->r_address == 0);
4456 jumpIsland = (unsigned long)
4457 &makeSymbolExtra(oc,
4459 (unsigned long) symbolAddress)
4463 offsetToJumpIsland = word + jumpIsland
4464 - (((long)image) + sect->offset - sect->addr);
4467 word += (unsigned long) symbolAddress
4468 - (((long)image) + sect->offset - sect->addr);
4472 word += (unsigned long) symbolAddress;
4476 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4481 #ifdef powerpc_HOST_ARCH
4482 else if(reloc->r_type == PPC_RELOC_LO16)
4484 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4487 else if(reloc->r_type == PPC_RELOC_HI16)
4489 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4492 else if(reloc->r_type == PPC_RELOC_HA16)
4494 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4495 + ((word & (1<<15)) ? 1 : 0);
4498 else if(reloc->r_type == PPC_RELOC_BR24)
4500 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4502 // The branch offset is too large.
4503 // Therefore, we try to use a jump island.
4506 barf("unconditional relative branch out of range: "
4507 "no jump island available");
4510 word = offsetToJumpIsland;
4511 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4512 barf("unconditional relative branch out of range: "
4513 "jump island out of range");
4515 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4522 barf("Can't handle Mach-O relocation entry (not scattered) "
4523 "with this r_length tag: "
4524 "object file %s; entry type %ld; "
4525 "r_length tag %ld; address %#lx\n",
4526 oc->fileName, reloc->r_type, reloc->r_length,
4536 static int ocGetNames_MachO(ObjectCode* oc)
4538 char *image = (char*) oc->image;
4539 struct mach_header *header = (struct mach_header*) image;
4540 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4541 unsigned i,curSymbol = 0;
4542 struct segment_command *segLC = NULL;
4543 struct section *sections;
4544 struct symtab_command *symLC = NULL;
4545 struct nlist *nlist;
4546 unsigned long commonSize = 0;
4547 char *commonStorage = NULL;
4548 unsigned long commonCounter;
4550 for(i=0;i<header->ncmds;i++)
4552 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4553 segLC = (struct segment_command*) lc;
4554 else if(lc->cmd == LC_SYMTAB)
4555 symLC = (struct symtab_command*) lc;
4556 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4559 sections = (struct section*) (segLC+1);
4560 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4564 barf("ocGetNames_MachO: no segment load command");
4566 for(i=0;i<segLC->nsects;i++)
4568 if(sections[i].size == 0)
4571 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4573 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4574 "ocGetNames_MachO(common symbols)");
4575 sections[i].offset = zeroFillArea - image;
4578 if(!strcmp(sections[i].sectname,"__text"))
4579 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4580 (void*) (image + sections[i].offset),
4581 (void*) (image + sections[i].offset + sections[i].size));
4582 else if(!strcmp(sections[i].sectname,"__const"))
4583 addSection(oc, SECTIONKIND_RWDATA,
4584 (void*) (image + sections[i].offset),
4585 (void*) (image + sections[i].offset + sections[i].size));
4586 else if(!strcmp(sections[i].sectname,"__data"))
4587 addSection(oc, SECTIONKIND_RWDATA,
4588 (void*) (image + sections[i].offset),
4589 (void*) (image + sections[i].offset + sections[i].size));
4590 else if(!strcmp(sections[i].sectname,"__bss")
4591 || !strcmp(sections[i].sectname,"__common"))
4592 addSection(oc, SECTIONKIND_RWDATA,
4593 (void*) (image + sections[i].offset),
4594 (void*) (image + sections[i].offset + sections[i].size));
4596 addProddableBlock(oc, (void*) (image + sections[i].offset),
4600 // count external symbols defined here
4604 for(i=0;i<symLC->nsyms;i++)
4606 if(nlist[i].n_type & N_STAB)
4608 else if(nlist[i].n_type & N_EXT)
4610 if((nlist[i].n_type & N_TYPE) == N_UNDF
4611 && (nlist[i].n_value != 0))
4613 commonSize += nlist[i].n_value;
4616 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4621 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4622 "ocGetNames_MachO(oc->symbols)");
4626 for(i=0;i<symLC->nsyms;i++)
4628 if(nlist[i].n_type & N_STAB)
4630 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4632 if(nlist[i].n_type & N_EXT)
4634 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4635 if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
4636 ; // weak definition, and we already have a definition
4639 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4641 + sections[nlist[i].n_sect-1].offset
4642 - sections[nlist[i].n_sect-1].addr
4643 + nlist[i].n_value);
4644 oc->symbols[curSymbol++] = nm;
4651 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4652 commonCounter = (unsigned long)commonStorage;
4655 for(i=0;i<symLC->nsyms;i++)
4657 if((nlist[i].n_type & N_TYPE) == N_UNDF
4658 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4660 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4661 unsigned long sz = nlist[i].n_value;
4663 nlist[i].n_value = commonCounter;
4665 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4666 (void*)commonCounter);
4667 oc->symbols[curSymbol++] = nm;
4669 commonCounter += sz;
4676 static int ocResolve_MachO(ObjectCode* oc)
4678 char *image = (char*) oc->image;
4679 struct mach_header *header = (struct mach_header*) image;
4680 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4682 struct segment_command *segLC = NULL;
4683 struct section *sections;
4684 struct symtab_command *symLC = NULL;
4685 struct dysymtab_command *dsymLC = NULL;
4686 struct nlist *nlist;
4688 for(i=0;i<header->ncmds;i++)
4690 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4691 segLC = (struct segment_command*) lc;
4692 else if(lc->cmd == LC_SYMTAB)
4693 symLC = (struct symtab_command*) lc;
4694 else if(lc->cmd == LC_DYSYMTAB)
4695 dsymLC = (struct dysymtab_command*) lc;
4696 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4699 sections = (struct section*) (segLC+1);
4700 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4705 unsigned long *indirectSyms
4706 = (unsigned long*) (image + dsymLC->indirectsymoff);
4708 for(i=0;i<segLC->nsects;i++)
4710 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
4711 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4712 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4714 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4717 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
4718 || !strcmp(sections[i].sectname,"__pointers"))
4720 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4723 else if(!strcmp(sections[i].sectname,"__jump_table"))
4725 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4731 for(i=0;i<segLC->nsects;i++)
4733 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4737 #if defined (powerpc_HOST_ARCH)
4738 ocFlushInstructionCache( oc );
4744 #ifdef powerpc_HOST_ARCH
4746 * The Mach-O object format uses leading underscores. But not everywhere.
4747 * There is a small number of runtime support functions defined in
4748 * libcc_dynamic.a whose name does not have a leading underscore.
4749 * As a consequence, we can't get their address from C code.
4750 * We have to use inline assembler just to take the address of a function.
4754 static void machoInitSymbolsWithoutUnderscore()
4756 extern void* symbolsWithoutUnderscore[];
4757 void **p = symbolsWithoutUnderscore;
4758 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4760 #undef SymI_NeedsProto
4761 #define SymI_NeedsProto(x) \
4762 __asm__ volatile(".long " # x);
4764 RTS_MACHO_NOUNDERLINE_SYMBOLS
4766 __asm__ volatile(".text");
4768 #undef SymI_NeedsProto
4769 #define SymI_NeedsProto(x) \
4770 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4772 RTS_MACHO_NOUNDERLINE_SYMBOLS
4774 #undef SymI_NeedsProto
4779 * Figure out by how much to shift the entire Mach-O file in memory
4780 * when loading so that its single segment ends up 16-byte-aligned
4782 static int machoGetMisalignment( FILE * f )
4784 struct mach_header header;
4787 fread(&header, sizeof(header), 1, f);
4790 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4791 if(header.magic != MH_MAGIC_64)
4794 if(header.magic != MH_MAGIC)
4798 misalignment = (header.sizeofcmds + sizeof(header))
4801 return misalignment ? (16 - misalignment) : 0;