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
1115 /* Make initLinker idempotent, so we can call it
1116 before evey relevant operation; that means we
1117 don't need to initialise the linker separately */
1118 if (linker_init_done == 1) { return; } else {
1119 linker_init_done = 1;
1123 initMutex(&dl_mutex);
1125 stablehash = allocStrHashTable();
1126 symhash = allocStrHashTable();
1128 /* populate the symbol table with stuff from the RTS */
1129 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
1130 ghciInsertStrHashTable("(GHCi built-in symbols)",
1131 symhash, sym->lbl, sym->addr);
1133 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1134 machoInitSymbolsWithoutUnderscore();
1137 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1138 # if defined(RTLD_DEFAULT)
1139 dl_prog_handle = RTLD_DEFAULT;
1141 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
1142 # endif /* RTLD_DEFAULT */
1144 compileResult = regcomp(&re_invalid,
1145 "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*invalid ELF header",
1147 ASSERT( compileResult == 0 );
1148 compileResult = regcomp(&re_realso,
1149 "GROUP *\\( *(([^ )])+)",
1151 ASSERT( compileResult == 0 );
1154 #if defined(x86_64_HOST_ARCH)
1155 if (RtsFlags.MiscFlags.linkerMemBase != 0) {
1156 // User-override for mmap_32bit_base
1157 mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
1161 #if defined(mingw32_HOST_OS)
1163 * These two libraries cause problems when added to the static link,
1164 * but are necessary for resolving symbols in GHCi, hence we load
1165 * them manually here.
1173 exitLinker( void ) {
1174 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1175 if (linker_init_done == 1) {
1176 regfree(&re_invalid);
1177 regfree(&re_realso);
1179 closeMutex(&dl_mutex);
1185 /* -----------------------------------------------------------------------------
1186 * Loading DLL or .so dynamic libraries
1187 * -----------------------------------------------------------------------------
1189 * Add a DLL from which symbols may be found. In the ELF case, just
1190 * do RTLD_GLOBAL-style add, so no further messing around needs to
1191 * happen in order that symbols in the loaded .so are findable --
1192 * lookupSymbol() will subsequently see them by dlsym on the program's
1193 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
1195 * In the PEi386 case, open the DLLs and put handles to them in a
1196 * linked list. When looking for a symbol, try all handles in the
1197 * list. This means that we need to load even DLLs that are guaranteed
1198 * to be in the ghc.exe image already, just so we can get a handle
1199 * to give to loadSymbol, so that we can find the symbols. For such
1200 * libraries, the LoadLibrary call should be a no-op except for returning
1205 #if defined(OBJFORMAT_PEi386)
1206 /* A record for storing handles into DLLs. */
1211 struct _OpenedDLL* next;
1216 /* A list thereof. */
1217 static OpenedDLL* opened_dlls = NULL;
1220 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1223 internal_dlopen(const char *dll_name)
1226 char *errmsg, *errmsg_copy;
1228 // omitted: RTLD_NOW
1229 // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
1231 debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));
1233 //-------------- Begin critical section ------------------
1234 // This critical section is necessary because dlerror() is not
1235 // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
1236 // Also, the error message returned must be copied to preserve it
1239 ACQUIRE_LOCK(&dl_mutex);
1240 hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
1244 /* dlopen failed; return a ptr to the error msg. */
1246 if (errmsg == NULL) errmsg = "addDLL: unknown error";
1247 errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
1248 strcpy(errmsg_copy, errmsg);
1249 errmsg = errmsg_copy;
1251 RELEASE_LOCK(&dl_mutex);
1252 //--------------- End critical section -------------------
1259 addDLL( char *dll_name )
1261 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
1262 /* ------------------- ELF DLL loader ------------------- */
1265 regmatch_t match[NMATCH];
1268 size_t match_length;
1269 #define MAXLINE 1000
1275 IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
1276 errmsg = internal_dlopen(dll_name);
1278 if (errmsg == NULL) {
1282 // GHC Trac ticket #2615
1283 // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
1284 // contain linker scripts rather than ELF-format object code. This
1285 // code handles the situation by recognizing the real object code
1286 // file name given in the linker script.
1288 // If an "invalid ELF header" error occurs, it is assumed that the
1289 // .so file contains a linker script instead of ELF object code.
1290 // In this case, the code looks for the GROUP ( ... ) linker
1291 // directive. If one is found, the first file name inside the
1292 // parentheses is treated as the name of a dynamic library and the
1293 // code attempts to dlopen that file. If this is also unsuccessful,
1294 // an error message is returned.
1296 // see if the error message is due to an invalid ELF header
1297 IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
1298 result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
1299 IF_DEBUG(linker, debugBelch("result = %i\n", result));
1301 // success -- try to read the named file as a linker script
1302 match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
1304 strncpy(line, (errmsg+(match[1].rm_so)),match_length);
1305 line[match_length] = '\0'; // make sure string is null-terminated
1306 IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
1307 if ((fp = fopen(line, "r")) == NULL) {
1308 return errmsg; // return original error if open fails
1310 // try to find a GROUP ( ... ) command
1311 while (fgets(line, MAXLINE, fp) != NULL) {
1312 IF_DEBUG(linker, debugBelch("input line = %s", line));
1313 if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
1314 // success -- try to dlopen the first named file
1315 IF_DEBUG(linker, debugBelch("match%s\n",""));
1316 line[match[1].rm_eo] = '\0';
1317 errmsg = internal_dlopen(line+match[1].rm_so);
1320 // if control reaches here, no GROUP ( ... ) directive was found
1321 // and the original error message is returned to the caller
1327 # elif defined(OBJFORMAT_PEi386)
1328 /* ------------------- Win32 DLL loader ------------------- */
1336 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
1338 /* See if we've already got it, and ignore if so. */
1339 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1340 if (0 == strcmp(o_dll->name, dll_name))
1344 /* The file name has no suffix (yet) so that we can try
1345 both foo.dll and foo.drv
1347 The documentation for LoadLibrary says:
1348 If no file name extension is specified in the lpFileName
1349 parameter, the default library extension .dll is
1350 appended. However, the file name string can include a trailing
1351 point character (.) to indicate that the module name has no
1354 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
1355 sprintf(buf, "%s.DLL", dll_name);
1356 instance = LoadLibrary(buf);
1357 if (instance == NULL) {
1358 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1359 // KAA: allow loading of drivers (like winspool.drv)
1360 sprintf(buf, "%s.DRV", dll_name);
1361 instance = LoadLibrary(buf);
1362 if (instance == NULL) {
1363 if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
1364 // #1883: allow loading of unix-style libfoo.dll DLLs
1365 sprintf(buf, "lib%s.DLL", dll_name);
1366 instance = LoadLibrary(buf);
1367 if (instance == NULL) {
1374 /* Add this DLL to the list of DLLs in which to search for symbols. */
1375 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
1376 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
1377 strcpy(o_dll->name, dll_name);
1378 o_dll->instance = instance;
1379 o_dll->next = opened_dlls;
1380 opened_dlls = o_dll;
1386 sysErrorBelch(dll_name);
1388 /* LoadLibrary failed; return a ptr to the error msg. */
1389 return "addDLL: could not load DLL";
1392 barf("addDLL: not implemented on this platform");
1396 /* -----------------------------------------------------------------------------
1397 * insert a stable symbol in the hash table
1401 insertStableSymbol(char* obj_name, char* key, StgPtr p)
1403 ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
1407 /* -----------------------------------------------------------------------------
1408 * insert a symbol in the hash table
1411 insertSymbol(char* obj_name, char* key, void* data)
1413 ghciInsertStrHashTable(obj_name, symhash, key, data);
1416 /* -----------------------------------------------------------------------------
1417 * lookup a symbol in the hash table
1420 lookupSymbol( char *lbl )
1424 ASSERT(symhash != NULL);
1425 val = lookupStrHashTable(symhash, lbl);
1428 # if defined(OBJFORMAT_ELF)
1429 return dlsym(dl_prog_handle, lbl);
1430 # elif defined(OBJFORMAT_MACHO)
1432 /* On OS X 10.3 and later, we use dlsym instead of the old legacy
1435 HACK: On OS X, global symbols are prefixed with an underscore.
1436 However, dlsym wants us to omit the leading underscore from the
1437 symbol name. For now, we simply strip it off here (and ONLY
1440 ASSERT(lbl[0] == '_');
1441 return dlsym(dl_prog_handle, lbl+1);
1443 if(NSIsSymbolNameDefined(lbl)) {
1444 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
1445 return NSAddressOfSymbol(symbol);
1449 # endif /* HAVE_DLFCN_H */
1450 # elif defined(OBJFORMAT_PEi386)
1453 sym = lookupSymbolInDLLs(lbl);
1454 if (sym != NULL) { return sym; };
1456 // Also try looking up the symbol without the @N suffix. Some
1457 // DLLs have the suffixes on their symbols, some don't.
1458 zapTrailingAtSign ( lbl );
1459 sym = lookupSymbolInDLLs(lbl);
1460 if (sym != NULL) { return sym; };
1472 /* -----------------------------------------------------------------------------
1473 * Debugging aid: look in GHCi's object symbol tables for symbols
1474 * within DELTA bytes of the specified address, and show their names.
1477 void ghci_enquire ( char* addr );
1479 void ghci_enquire ( char* addr )
1484 const int DELTA = 64;
1489 for (oc = objects; oc; oc = oc->next) {
1490 for (i = 0; i < oc->n_symbols; i++) {
1491 sym = oc->symbols[i];
1492 if (sym == NULL) continue;
1495 a = lookupStrHashTable(symhash, sym);
1498 // debugBelch("ghci_enquire: can't find %s\n", sym);
1500 else if (addr-DELTA <= a && a <= addr+DELTA) {
1501 debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
1509 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1512 mmapForLinker (size_t bytes, nat flags, int fd)
1514 void *map_addr = NULL;
1517 static nat fixed = 0;
1519 pagesize = getpagesize();
1520 size = ROUND_UP(bytes, pagesize);
1522 #if defined(x86_64_HOST_ARCH)
1525 if (mmap_32bit_base != 0) {
1526 map_addr = mmap_32bit_base;
1530 result = mmap(map_addr, size, PROT_EXEC|PROT_READ|PROT_WRITE,
1531 MAP_PRIVATE|TRY_MAP_32BIT|fixed|flags, fd, 0);
1533 if (result == MAP_FAILED) {
1534 sysErrorBelch("mmap %lu bytes at %p",(lnat)size,map_addr);
1535 errorBelch("Try specifying an address with +RTS -xm<addr> -RTS");
1536 stg_exit(EXIT_FAILURE);
1539 #if defined(x86_64_HOST_ARCH)
1540 if (mmap_32bit_base != 0) {
1541 if (result == map_addr) {
1542 mmap_32bit_base = (StgWord8*)map_addr + size;
1544 if ((W_)result > 0x80000000) {
1545 // oops, we were given memory over 2Gb
1546 #if defined(freebsd_HOST_OS) || defined(dragonfly_HOST_OS)
1547 // Some platforms require MAP_FIXED. This is normally
1548 // a bad idea, because MAP_FIXED will overwrite
1549 // existing mappings.
1550 munmap(result,size);
1554 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);
1557 // hmm, we were given memory somewhere else, but it's
1558 // still under 2Gb so we can use it. Next time, ask
1559 // for memory right after the place we just got some
1560 mmap_32bit_base = (StgWord8*)result + size;
1564 if ((W_)result > 0x80000000) {
1565 // oops, we were given memory over 2Gb
1566 // ... try allocating memory somewhere else?;
1567 debugTrace(DEBUG_linker,"MAP_32BIT didn't work; gave us %lu bytes at 0x%p", bytes, result);
1568 munmap(result, size);
1570 // Set a base address and try again... (guess: 1Gb)
1571 mmap_32bit_base = (void*)0x40000000;
1581 /* -----------------------------------------------------------------------------
1582 * Load an obj (populate the global symbol table, but don't resolve yet)
1584 * Returns: 1 if ok, 0 on error.
1587 loadObj( char *path )
1599 /* debugBelch("loadObj %s\n", path ); */
1601 /* Check that we haven't already loaded this object.
1602 Ignore requests to load multiple times */
1606 for (o = objects; o; o = o->next) {
1607 if (0 == strcmp(o->fileName, path)) {
1609 break; /* don't need to search further */
1613 IF_DEBUG(linker, debugBelch(
1614 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1615 "same object file twice:\n"
1617 "GHCi will ignore this, but be warned.\n"
1619 return 1; /* success */
1623 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1625 # if defined(OBJFORMAT_ELF)
1626 oc->formatName = "ELF";
1627 # elif defined(OBJFORMAT_PEi386)
1628 oc->formatName = "PEi386";
1629 # elif defined(OBJFORMAT_MACHO)
1630 oc->formatName = "Mach-O";
1633 barf("loadObj: not implemented on this platform");
1636 r = stat(path, &st);
1637 if (r == -1) { return 0; }
1639 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1640 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1641 strcpy(oc->fileName, path);
1643 oc->fileSize = st.st_size;
1645 oc->sections = NULL;
1646 oc->proddables = NULL;
1648 /* chain it onto the list of objects */
1653 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1655 #if defined(openbsd_HOST_OS)
1656 fd = open(path, O_RDONLY, S_IRUSR);
1658 fd = open(path, O_RDONLY);
1661 barf("loadObj: can't open `%s'", path);
1663 oc->image = mmapForLinker(oc->fileSize, 0, fd);
1667 #else /* !USE_MMAP */
1668 /* load the image into memory */
1669 f = fopen(path, "rb");
1671 barf("loadObj: can't read `%s'", path);
1673 # if defined(mingw32_HOST_OS)
1674 // TODO: We would like to use allocateExec here, but allocateExec
1675 // cannot currently allocate blocks large enough.
1676 oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
1677 PAGE_EXECUTE_READWRITE);
1678 # elif defined(darwin_HOST_OS)
1679 // In a Mach-O .o file, all sections can and will be misaligned
1680 // if the total size of the headers is not a multiple of the
1681 // desired alignment. This is fine for .o files that only serve
1682 // as input for the static linker, but it's not fine for us,
1683 // as SSE (used by gcc for floating point) and Altivec require
1684 // 16-byte alignment.
1685 // We calculate the correct alignment from the header before
1686 // reading the file, and then we misalign oc->image on purpose so
1687 // that the actual sections end up aligned again.
1688 oc->misalignment = machoGetMisalignment(f);
1689 oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
1690 oc->image += oc->misalignment;
1692 oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
1697 n = fread ( oc->image, 1, oc->fileSize, f );
1698 if (n != oc->fileSize)
1699 barf("loadObj: error whilst reading `%s'", path);
1702 #endif /* USE_MMAP */
1704 # if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1705 r = ocAllocateSymbolExtras_MachO ( oc );
1706 if (!r) { return r; }
1707 # elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
1708 r = ocAllocateSymbolExtras_ELF ( oc );
1709 if (!r) { return r; }
1712 /* verify the in-memory image */
1713 # if defined(OBJFORMAT_ELF)
1714 r = ocVerifyImage_ELF ( oc );
1715 # elif defined(OBJFORMAT_PEi386)
1716 r = ocVerifyImage_PEi386 ( oc );
1717 # elif defined(OBJFORMAT_MACHO)
1718 r = ocVerifyImage_MachO ( oc );
1720 barf("loadObj: no verify method");
1722 if (!r) { return r; }
1724 /* build the symbol list for this image */
1725 # if defined(OBJFORMAT_ELF)
1726 r = ocGetNames_ELF ( oc );
1727 # elif defined(OBJFORMAT_PEi386)
1728 r = ocGetNames_PEi386 ( oc );
1729 # elif defined(OBJFORMAT_MACHO)
1730 r = ocGetNames_MachO ( oc );
1732 barf("loadObj: no getNames method");
1734 if (!r) { return r; }
1736 /* loaded, but not resolved yet */
1737 oc->status = OBJECT_LOADED;
1742 /* -----------------------------------------------------------------------------
1743 * resolve all the currently unlinked objects in memory
1745 * Returns: 1 if ok, 0 on error.
1755 for (oc = objects; oc; oc = oc->next) {
1756 if (oc->status != OBJECT_RESOLVED) {
1757 # if defined(OBJFORMAT_ELF)
1758 r = ocResolve_ELF ( oc );
1759 # elif defined(OBJFORMAT_PEi386)
1760 r = ocResolve_PEi386 ( oc );
1761 # elif defined(OBJFORMAT_MACHO)
1762 r = ocResolve_MachO ( oc );
1764 barf("resolveObjs: not implemented on this platform");
1766 if (!r) { return r; }
1767 oc->status = OBJECT_RESOLVED;
1773 /* -----------------------------------------------------------------------------
1774 * delete an object from the pool
1777 unloadObj( char *path )
1779 ObjectCode *oc, *prev;
1781 ASSERT(symhash != NULL);
1782 ASSERT(objects != NULL);
1787 for (oc = objects; oc; prev = oc, oc = oc->next) {
1788 if (!strcmp(oc->fileName,path)) {
1790 /* Remove all the mappings for the symbols within this
1795 for (i = 0; i < oc->n_symbols; i++) {
1796 if (oc->symbols[i] != NULL) {
1797 removeStrHashTable(symhash, oc->symbols[i], NULL);
1805 prev->next = oc->next;
1808 // We're going to leave this in place, in case there are
1809 // any pointers from the heap into it:
1810 // #ifdef mingw32_HOST_OS
1811 // VirtualFree(oc->image);
1813 // stgFree(oc->image);
1815 stgFree(oc->fileName);
1816 stgFree(oc->symbols);
1817 stgFree(oc->sections);
1823 errorBelch("unloadObj: can't find `%s' to unload", path);
1827 /* -----------------------------------------------------------------------------
1828 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1829 * which may be prodded during relocation, and abort if we try and write
1830 * outside any of these.
1832 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1835 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1836 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1840 pb->next = oc->proddables;
1841 oc->proddables = pb;
1844 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1847 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1848 char* s = (char*)(pb->start);
1849 char* e = s + pb->size - 1;
1850 char* a = (char*)addr;
1851 /* Assumes that the biggest fixup involves a 4-byte write. This
1852 probably needs to be changed to 8 (ie, +7) on 64-bit
1854 if (a >= s && (a+3) <= e) return;
1856 barf("checkProddableBlock: invalid fixup in runtime linker");
1859 /* -----------------------------------------------------------------------------
1860 * Section management.
1862 static void addSection ( ObjectCode* oc, SectionKind kind,
1863 void* start, void* end )
1865 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1869 s->next = oc->sections;
1872 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1873 start, ((char*)end)-1, end - start + 1, kind );
1878 /* --------------------------------------------------------------------------
1880 * This is about allocating a small chunk of memory for every symbol in the
1881 * object file. We make sure that the SymboLExtras are always "in range" of
1882 * limited-range PC-relative instructions on various platforms by allocating
1883 * them right next to the object code itself.
1886 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
1889 ocAllocateSymbolExtras
1891 Allocate additional space at the end of the object file image to make room
1892 for jump islands (powerpc, x86_64) and GOT entries (x86_64).
1894 PowerPC relative branch instructions have a 24 bit displacement field.
1895 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1896 If a particular imported symbol is outside this range, we have to redirect
1897 the jump to a short piece of new code that just loads the 32bit absolute
1898 address and jumps there.
1899 On x86_64, PC-relative jumps and PC-relative accesses to the GOT are limited
1902 This function just allocates space for one SymbolExtra for every
1903 undefined symbol in the object file. The code for the jump islands is
1904 filled in by makeSymbolExtra below.
1907 static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
1914 int misalignment = 0;
1915 #ifdef darwin_HOST_OS
1916 misalignment = oc->misalignment;
1922 // round up to the nearest 4
1923 aligned = (oc->fileSize + 3) & ~3;
1926 pagesize = getpagesize();
1927 n = ROUND_UP( oc->fileSize, pagesize );
1928 m = ROUND_UP( aligned + sizeof (SymbolExtra) * count, pagesize );
1930 /* we try to use spare space at the end of the last page of the
1931 * image for the jump islands, but if there isn't enough space
1932 * then we have to map some (anonymously, remembering MAP_32BIT).
1934 if( m > n ) // we need to allocate more pages
1936 oc->symbol_extras = mmapForLinker(sizeof(SymbolExtra) * count,
1941 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1944 oc->image -= misalignment;
1945 oc->image = stgReallocBytes( oc->image,
1947 aligned + sizeof (SymbolExtra) * count,
1948 "ocAllocateSymbolExtras" );
1949 oc->image += misalignment;
1951 oc->symbol_extras = (SymbolExtra *) (oc->image + aligned);
1952 #endif /* USE_MMAP */
1954 memset( oc->symbol_extras, 0, sizeof (SymbolExtra) * count );
1957 oc->symbol_extras = NULL;
1959 oc->first_symbol_extra = first;
1960 oc->n_symbol_extras = count;
1965 static SymbolExtra* makeSymbolExtra( ObjectCode* oc,
1966 unsigned long symbolNumber,
1967 unsigned long target )
1971 ASSERT( symbolNumber >= oc->first_symbol_extra
1972 && symbolNumber - oc->first_symbol_extra < oc->n_symbol_extras);
1974 extra = &oc->symbol_extras[symbolNumber - oc->first_symbol_extra];
1976 #ifdef powerpc_HOST_ARCH
1977 // lis r12, hi16(target)
1978 extra->jumpIsland.lis_r12 = 0x3d80;
1979 extra->jumpIsland.hi_addr = target >> 16;
1981 // ori r12, r12, lo16(target)
1982 extra->jumpIsland.ori_r12_r12 = 0x618c;
1983 extra->jumpIsland.lo_addr = target & 0xffff;
1986 extra->jumpIsland.mtctr_r12 = 0x7d8903a6;
1989 extra->jumpIsland.bctr = 0x4e800420;
1991 #ifdef x86_64_HOST_ARCH
1993 static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
1994 extra->addr = target;
1995 memcpy(extra->jumpIsland, jmp, 6);
2003 /* --------------------------------------------------------------------------
2004 * PowerPC specifics (instruction cache flushing)
2005 * ------------------------------------------------------------------------*/
2007 #ifdef powerpc_TARGET_ARCH
2009 ocFlushInstructionCache
2011 Flush the data & instruction caches.
2012 Because the PPC has split data/instruction caches, we have to
2013 do that whenever we modify code at runtime.
2016 static void ocFlushInstructionCache( ObjectCode *oc )
2018 int n = (oc->fileSize + sizeof( SymbolExtra ) * oc->n_symbol_extras + 3) / 4;
2019 unsigned long *p = (unsigned long *) oc->image;
2023 __asm__ volatile ( "dcbf 0,%0\n\t"
2031 __asm__ volatile ( "sync\n\t"
2037 /* --------------------------------------------------------------------------
2038 * PEi386 specifics (Win32 targets)
2039 * ------------------------------------------------------------------------*/
2041 /* The information for this linker comes from
2042 Microsoft Portable Executable
2043 and Common Object File Format Specification
2044 revision 5.1 January 1998
2045 which SimonM says comes from the MS Developer Network CDs.
2047 It can be found there (on older CDs), but can also be found
2050 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
2052 (this is Rev 6.0 from February 1999).
2054 Things move, so if that fails, try searching for it via
2056 http://www.google.com/search?q=PE+COFF+specification
2058 The ultimate reference for the PE format is the Winnt.h
2059 header file that comes with the Platform SDKs; as always,
2060 implementations will drift wrt their documentation.
2062 A good background article on the PE format is Matt Pietrek's
2063 March 1994 article in Microsoft System Journal (MSJ)
2064 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
2065 Win32 Portable Executable File Format." The info in there
2066 has recently been updated in a two part article in
2067 MSDN magazine, issues Feb and March 2002,
2068 "Inside Windows: An In-Depth Look into the Win32 Portable
2069 Executable File Format"
2071 John Levine's book "Linkers and Loaders" contains useful
2076 #if defined(OBJFORMAT_PEi386)
2080 typedef unsigned char UChar;
2081 typedef unsigned short UInt16;
2082 typedef unsigned int UInt32;
2089 UInt16 NumberOfSections;
2090 UInt32 TimeDateStamp;
2091 UInt32 PointerToSymbolTable;
2092 UInt32 NumberOfSymbols;
2093 UInt16 SizeOfOptionalHeader;
2094 UInt16 Characteristics;
2098 #define sizeof_COFF_header 20
2105 UInt32 VirtualAddress;
2106 UInt32 SizeOfRawData;
2107 UInt32 PointerToRawData;
2108 UInt32 PointerToRelocations;
2109 UInt32 PointerToLinenumbers;
2110 UInt16 NumberOfRelocations;
2111 UInt16 NumberOfLineNumbers;
2112 UInt32 Characteristics;
2116 #define sizeof_COFF_section 40
2123 UInt16 SectionNumber;
2126 UChar NumberOfAuxSymbols;
2130 #define sizeof_COFF_symbol 18
2135 UInt32 VirtualAddress;
2136 UInt32 SymbolTableIndex;
2141 #define sizeof_COFF_reloc 10
2144 /* From PE spec doc, section 3.3.2 */
2145 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
2146 windows.h -- for the same purpose, but I want to know what I'm
2148 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
2149 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
2150 #define MYIMAGE_FILE_DLL 0x2000
2151 #define MYIMAGE_FILE_SYSTEM 0x1000
2152 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
2153 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
2154 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
2156 /* From PE spec doc, section 5.4.2 and 5.4.4 */
2157 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
2158 #define MYIMAGE_SYM_CLASS_STATIC 3
2159 #define MYIMAGE_SYM_UNDEFINED 0
2161 /* From PE spec doc, section 4.1 */
2162 #define MYIMAGE_SCN_CNT_CODE 0x00000020
2163 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
2164 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
2166 /* From PE spec doc, section 5.2.1 */
2167 #define MYIMAGE_REL_I386_DIR32 0x0006
2168 #define MYIMAGE_REL_I386_REL32 0x0014
2171 /* We use myindex to calculate array addresses, rather than
2172 simply doing the normal subscript thing. That's because
2173 some of the above structs have sizes which are not
2174 a whole number of words. GCC rounds their sizes up to a
2175 whole number of words, which means that the address calcs
2176 arising from using normal C indexing or pointer arithmetic
2177 are just plain wrong. Sigh.
2180 myindex ( int scale, void* base, int index )
2183 ((UChar*)base) + scale * index;
2188 printName ( UChar* name, UChar* strtab )
2190 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2191 UInt32 strtab_offset = * (UInt32*)(name+4);
2192 debugBelch("%s", strtab + strtab_offset );
2195 for (i = 0; i < 8; i++) {
2196 if (name[i] == 0) break;
2197 debugBelch("%c", name[i] );
2204 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
2206 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2207 UInt32 strtab_offset = * (UInt32*)(name+4);
2208 strncpy ( dst, strtab+strtab_offset, dstSize );
2214 if (name[i] == 0) break;
2224 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
2227 /* If the string is longer than 8 bytes, look in the
2228 string table for it -- this will be correctly zero terminated.
2230 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
2231 UInt32 strtab_offset = * (UInt32*)(name+4);
2232 return ((UChar*)strtab) + strtab_offset;
2234 /* Otherwise, if shorter than 8 bytes, return the original,
2235 which by defn is correctly terminated.
2237 if (name[7]==0) return name;
2238 /* The annoying case: 8 bytes. Copy into a temporary
2239 (which is never freed ...)
2241 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
2243 strncpy(newstr,name,8);
2249 /* Just compares the short names (first 8 chars) */
2250 static COFF_section *
2251 findPEi386SectionCalled ( ObjectCode* oc, char* name )
2255 = (COFF_header*)(oc->image);
2256 COFF_section* sectab
2258 ((UChar*)(oc->image))
2259 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2261 for (i = 0; i < hdr->NumberOfSections; i++) {
2264 COFF_section* section_i
2266 myindex ( sizeof_COFF_section, sectab, i );
2267 n1 = (UChar*) &(section_i->Name);
2269 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
2270 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
2271 n1[6]==n2[6] && n1[7]==n2[7])
2280 zapTrailingAtSign ( UChar* sym )
2282 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
2284 if (sym[0] == 0) return;
2286 while (sym[i] != 0) i++;
2289 while (j > 0 && my_isdigit(sym[j])) j--;
2290 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
2295 lookupSymbolInDLLs ( UChar *lbl )
2300 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
2301 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
2303 if (lbl[0] == '_') {
2304 /* HACK: if the name has an initial underscore, try stripping
2305 it off & look that up first. I've yet to verify whether there's
2306 a Rule that governs whether an initial '_' *should always* be
2307 stripped off when mapping from import lib name to the DLL name.
2309 sym = GetProcAddress(o_dll->instance, (lbl+1));
2311 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
2315 sym = GetProcAddress(o_dll->instance, lbl);
2317 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
2326 ocVerifyImage_PEi386 ( ObjectCode* oc )
2331 COFF_section* sectab;
2332 COFF_symbol* symtab;
2334 /* debugBelch("\nLOADING %s\n", oc->fileName); */
2335 hdr = (COFF_header*)(oc->image);
2336 sectab = (COFF_section*) (
2337 ((UChar*)(oc->image))
2338 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2340 symtab = (COFF_symbol*) (
2341 ((UChar*)(oc->image))
2342 + hdr->PointerToSymbolTable
2344 strtab = ((UChar*)symtab)
2345 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2347 if (hdr->Machine != 0x14c) {
2348 errorBelch("%s: Not x86 PEi386", oc->fileName);
2351 if (hdr->SizeOfOptionalHeader != 0) {
2352 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
2355 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
2356 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
2357 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
2358 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
2359 errorBelch("%s: Not a PEi386 object file", oc->fileName);
2362 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
2363 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
2364 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
2366 (int)(hdr->Characteristics));
2369 /* If the string table size is way crazy, this might indicate that
2370 there are more than 64k relocations, despite claims to the
2371 contrary. Hence this test. */
2372 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
2374 if ( (*(UInt32*)strtab) > 600000 ) {
2375 /* Note that 600k has no special significance other than being
2376 big enough to handle the almost-2MB-sized lumps that
2377 constitute HSwin32*.o. */
2378 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
2383 /* No further verification after this point; only debug printing. */
2385 IF_DEBUG(linker, i=1);
2386 if (i == 0) return 1;
2388 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
2389 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
2390 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
2393 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
2394 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
2395 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
2396 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
2397 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
2398 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
2399 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
2401 /* Print the section table. */
2403 for (i = 0; i < hdr->NumberOfSections; i++) {
2405 COFF_section* sectab_i
2407 myindex ( sizeof_COFF_section, sectab, i );
2414 printName ( sectab_i->Name, strtab );
2424 sectab_i->VirtualSize,
2425 sectab_i->VirtualAddress,
2426 sectab_i->SizeOfRawData,
2427 sectab_i->PointerToRawData,
2428 sectab_i->NumberOfRelocations,
2429 sectab_i->PointerToRelocations,
2430 sectab_i->PointerToRawData
2432 reltab = (COFF_reloc*) (
2433 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2436 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2437 /* If the relocation field (a short) has overflowed, the
2438 * real count can be found in the first reloc entry.
2440 * See Section 4.1 (last para) of the PE spec (rev6.0).
2442 COFF_reloc* rel = (COFF_reloc*)
2443 myindex ( sizeof_COFF_reloc, reltab, 0 );
2444 noRelocs = rel->VirtualAddress;
2447 noRelocs = sectab_i->NumberOfRelocations;
2451 for (; j < noRelocs; j++) {
2453 COFF_reloc* rel = (COFF_reloc*)
2454 myindex ( sizeof_COFF_reloc, reltab, j );
2456 " type 0x%-4x vaddr 0x%-8x name `",
2458 rel->VirtualAddress );
2459 sym = (COFF_symbol*)
2460 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
2461 /* Hmm..mysterious looking offset - what's it for? SOF */
2462 printName ( sym->Name, strtab -10 );
2469 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
2470 debugBelch("---START of string table---\n");
2471 for (i = 4; i < *(Int32*)strtab; i++) {
2473 debugBelch("\n"); else
2474 debugBelch("%c", strtab[i] );
2476 debugBelch("--- END of string table---\n");
2481 COFF_symbol* symtab_i;
2482 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2483 symtab_i = (COFF_symbol*)
2484 myindex ( sizeof_COFF_symbol, symtab, i );
2490 printName ( symtab_i->Name, strtab );
2499 (Int32)(symtab_i->SectionNumber),
2500 (UInt32)symtab_i->Type,
2501 (UInt32)symtab_i->StorageClass,
2502 (UInt32)symtab_i->NumberOfAuxSymbols
2504 i += symtab_i->NumberOfAuxSymbols;
2514 ocGetNames_PEi386 ( ObjectCode* oc )
2517 COFF_section* sectab;
2518 COFF_symbol* symtab;
2525 hdr = (COFF_header*)(oc->image);
2526 sectab = (COFF_section*) (
2527 ((UChar*)(oc->image))
2528 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2530 symtab = (COFF_symbol*) (
2531 ((UChar*)(oc->image))
2532 + hdr->PointerToSymbolTable
2534 strtab = ((UChar*)(oc->image))
2535 + hdr->PointerToSymbolTable
2536 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2538 /* Allocate space for any (local, anonymous) .bss sections. */
2540 for (i = 0; i < hdr->NumberOfSections; i++) {
2543 COFF_section* sectab_i
2545 myindex ( sizeof_COFF_section, sectab, i );
2546 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2547 /* sof 10/05: the PE spec text isn't too clear regarding what
2548 * the SizeOfRawData field is supposed to hold for object
2549 * file sections containing just uninitialized data -- for executables,
2550 * it is supposed to be zero; unclear what it's supposed to be
2551 * for object files. However, VirtualSize is guaranteed to be
2552 * zero for object files, which definitely suggests that SizeOfRawData
2553 * will be non-zero (where else would the size of this .bss section be
2554 * stored?) Looking at the COFF_section info for incoming object files,
2555 * this certainly appears to be the case.
2557 * => I suspect we've been incorrectly handling .bss sections in (relocatable)
2558 * object files up until now. This turned out to bite us with ghc-6.4.1's use
2559 * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
2560 * variable decls into to the .bss section. (The specific function in Q which
2561 * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
2563 if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
2564 /* This is a non-empty .bss section. Allocate zeroed space for
2565 it, and set its PointerToRawData field such that oc->image +
2566 PointerToRawData == addr_of_zeroed_space. */
2567 bss_sz = sectab_i->VirtualSize;
2568 if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
2569 zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
2570 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2571 addProddableBlock(oc, zspace, bss_sz);
2572 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2575 /* Copy section information into the ObjectCode. */
2577 for (i = 0; i < hdr->NumberOfSections; i++) {
2583 = SECTIONKIND_OTHER;
2584 COFF_section* sectab_i
2586 myindex ( sizeof_COFF_section, sectab, i );
2587 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2590 /* I'm sure this is the Right Way to do it. However, the
2591 alternative of testing the sectab_i->Name field seems to
2592 work ok with Cygwin.
2594 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2595 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2596 kind = SECTIONKIND_CODE_OR_RODATA;
2599 if (0==strcmp(".text",sectab_i->Name) ||
2600 0==strcmp(".rdata",sectab_i->Name)||
2601 0==strcmp(".rodata",sectab_i->Name))
2602 kind = SECTIONKIND_CODE_OR_RODATA;
2603 if (0==strcmp(".data",sectab_i->Name) ||
2604 0==strcmp(".bss",sectab_i->Name))
2605 kind = SECTIONKIND_RWDATA;
2607 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2608 sz = sectab_i->SizeOfRawData;
2609 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2611 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2612 end = start + sz - 1;
2614 if (kind == SECTIONKIND_OTHER
2615 /* Ignore sections called which contain stabs debugging
2617 && 0 != strcmp(".stab", sectab_i->Name)
2618 && 0 != strcmp(".stabstr", sectab_i->Name)
2619 /* ignore constructor section for now */
2620 && 0 != strcmp(".ctors", sectab_i->Name)
2621 /* ignore section generated from .ident */
2622 && 0!= strcmp("/4", sectab_i->Name)
2623 /* ignore unknown section that appeared in gcc 3.4.5(?) */
2624 && 0!= strcmp(".reloc", sectab_i->Name)
2626 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2630 if (kind != SECTIONKIND_OTHER && end >= start) {
2631 addSection(oc, kind, start, end);
2632 addProddableBlock(oc, start, end - start + 1);
2636 /* Copy exported symbols into the ObjectCode. */
2638 oc->n_symbols = hdr->NumberOfSymbols;
2639 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2640 "ocGetNames_PEi386(oc->symbols)");
2641 /* Call me paranoid; I don't care. */
2642 for (i = 0; i < oc->n_symbols; i++)
2643 oc->symbols[i] = NULL;
2647 COFF_symbol* symtab_i;
2648 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2649 symtab_i = (COFF_symbol*)
2650 myindex ( sizeof_COFF_symbol, symtab, i );
2654 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2655 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2656 /* This symbol is global and defined, viz, exported */
2657 /* for MYIMAGE_SYMCLASS_EXTERNAL
2658 && !MYIMAGE_SYM_UNDEFINED,
2659 the address of the symbol is:
2660 address of relevant section + offset in section
2662 COFF_section* sectabent
2663 = (COFF_section*) myindex ( sizeof_COFF_section,
2665 symtab_i->SectionNumber-1 );
2666 addr = ((UChar*)(oc->image))
2667 + (sectabent->PointerToRawData
2671 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2672 && symtab_i->Value > 0) {
2673 /* This symbol isn't in any section at all, ie, global bss.
2674 Allocate zeroed space for it. */
2675 addr = stgCallocBytes(1, symtab_i->Value,
2676 "ocGetNames_PEi386(non-anonymous bss)");
2677 addSection(oc, SECTIONKIND_RWDATA, addr,
2678 ((UChar*)addr) + symtab_i->Value - 1);
2679 addProddableBlock(oc, addr, symtab_i->Value);
2680 /* debugBelch("BSS section at 0x%x\n", addr); */
2683 if (addr != NULL ) {
2684 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2685 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2686 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2687 ASSERT(i >= 0 && i < oc->n_symbols);
2688 /* cstring_from_COFF_symbol_name always succeeds. */
2689 oc->symbols[i] = sname;
2690 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2694 "IGNORING symbol %d\n"
2698 printName ( symtab_i->Name, strtab );
2707 (Int32)(symtab_i->SectionNumber),
2708 (UInt32)symtab_i->Type,
2709 (UInt32)symtab_i->StorageClass,
2710 (UInt32)symtab_i->NumberOfAuxSymbols
2715 i += symtab_i->NumberOfAuxSymbols;
2724 ocResolve_PEi386 ( ObjectCode* oc )
2727 COFF_section* sectab;
2728 COFF_symbol* symtab;
2738 /* ToDo: should be variable-sized? But is at least safe in the
2739 sense of buffer-overrun-proof. */
2741 /* debugBelch("resolving for %s\n", oc->fileName); */
2743 hdr = (COFF_header*)(oc->image);
2744 sectab = (COFF_section*) (
2745 ((UChar*)(oc->image))
2746 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2748 symtab = (COFF_symbol*) (
2749 ((UChar*)(oc->image))
2750 + hdr->PointerToSymbolTable
2752 strtab = ((UChar*)(oc->image))
2753 + hdr->PointerToSymbolTable
2754 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2756 for (i = 0; i < hdr->NumberOfSections; i++) {
2757 COFF_section* sectab_i
2759 myindex ( sizeof_COFF_section, sectab, i );
2762 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2765 /* Ignore sections called which contain stabs debugging
2767 if (0 == strcmp(".stab", sectab_i->Name)
2768 || 0 == strcmp(".stabstr", sectab_i->Name)
2769 || 0 == strcmp(".ctors", sectab_i->Name))
2772 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2773 /* If the relocation field (a short) has overflowed, the
2774 * real count can be found in the first reloc entry.
2776 * See Section 4.1 (last para) of the PE spec (rev6.0).
2778 * Nov2003 update: the GNU linker still doesn't correctly
2779 * handle the generation of relocatable object files with
2780 * overflown relocations. Hence the output to warn of potential
2783 COFF_reloc* rel = (COFF_reloc*)
2784 myindex ( sizeof_COFF_reloc, reltab, 0 );
2785 noRelocs = rel->VirtualAddress;
2787 /* 10/05: we now assume (and check for) a GNU ld that is capable
2788 * of handling object files with (>2^16) of relocs.
2791 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2796 noRelocs = sectab_i->NumberOfRelocations;
2801 for (; j < noRelocs; j++) {
2803 COFF_reloc* reltab_j
2805 myindex ( sizeof_COFF_reloc, reltab, j );
2807 /* the location to patch */
2809 ((UChar*)(oc->image))
2810 + (sectab_i->PointerToRawData
2811 + reltab_j->VirtualAddress
2812 - sectab_i->VirtualAddress )
2814 /* the existing contents of pP */
2816 /* the symbol to connect to */
2817 sym = (COFF_symbol*)
2818 myindex ( sizeof_COFF_symbol,
2819 symtab, reltab_j->SymbolTableIndex );
2822 "reloc sec %2d num %3d: type 0x%-4x "
2823 "vaddr 0x%-8x name `",
2825 (UInt32)reltab_j->Type,
2826 reltab_j->VirtualAddress );
2827 printName ( sym->Name, strtab );
2828 debugBelch("'\n" ));
2830 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2831 COFF_section* section_sym
2832 = findPEi386SectionCalled ( oc, sym->Name );
2834 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2837 S = ((UInt32)(oc->image))
2838 + (section_sym->PointerToRawData
2841 copyName ( sym->Name, strtab, symbol, 1000-1 );
2842 S = (UInt32) lookupSymbol( symbol );
2843 if ((void*)S != NULL) goto foundit;
2844 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
2848 checkProddableBlock(oc, pP);
2849 switch (reltab_j->Type) {
2850 case MYIMAGE_REL_I386_DIR32:
2853 case MYIMAGE_REL_I386_REL32:
2854 /* Tricky. We have to insert a displacement at
2855 pP which, when added to the PC for the _next_
2856 insn, gives the address of the target (S).
2857 Problem is to know the address of the next insn
2858 when we only know pP. We assume that this
2859 literal field is always the last in the insn,
2860 so that the address of the next insn is pP+4
2861 -- hence the constant 4.
2862 Also I don't know if A should be added, but so
2863 far it has always been zero.
2865 SOF 05/2005: 'A' (old contents of *pP) have been observed
2866 to contain values other than zero (the 'wx' object file
2867 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2868 So, add displacement to old value instead of asserting
2869 A to be zero. Fixes wxhaskell-related crashes, and no other
2870 ill effects have been observed.
2872 Update: the reason why we're seeing these more elaborate
2873 relocations is due to a switch in how the NCG compiles SRTs
2874 and offsets to them from info tables. SRTs live in .(ro)data,
2875 while info tables live in .text, causing GAS to emit REL32/DISP32
2876 relocations with non-zero values. Adding the displacement is
2877 the right thing to do.
2879 *pP = S - ((UInt32)pP) - 4 + A;
2882 debugBelch("%s: unhandled PEi386 relocation type %d",
2883 oc->fileName, reltab_j->Type);
2890 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2894 #endif /* defined(OBJFORMAT_PEi386) */
2897 /* --------------------------------------------------------------------------
2899 * ------------------------------------------------------------------------*/
2901 #if defined(OBJFORMAT_ELF)
2906 #if defined(sparc_HOST_ARCH)
2907 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2908 #elif defined(i386_HOST_ARCH)
2909 # define ELF_TARGET_386 /* Used inside <elf.h> */
2910 #elif defined(x86_64_HOST_ARCH)
2911 # define ELF_TARGET_X64_64
2915 #if !defined(openbsd_HOST_OS)
2918 /* openbsd elf has things in different places, with diff names */
2919 # include <elf_abi.h>
2920 # include <machine/reloc.h>
2921 # define R_386_32 RELOC_32
2922 # define R_386_PC32 RELOC_PC32
2925 /* If elf.h doesn't define it */
2926 # ifndef R_X86_64_PC64
2927 # define R_X86_64_PC64 24
2931 * Define a set of types which can be used for both ELF32 and ELF64
2935 #define ELFCLASS ELFCLASS64
2936 #define Elf_Addr Elf64_Addr
2937 #define Elf_Word Elf64_Word
2938 #define Elf_Sword Elf64_Sword
2939 #define Elf_Ehdr Elf64_Ehdr
2940 #define Elf_Phdr Elf64_Phdr
2941 #define Elf_Shdr Elf64_Shdr
2942 #define Elf_Sym Elf64_Sym
2943 #define Elf_Rel Elf64_Rel
2944 #define Elf_Rela Elf64_Rela
2945 #define ELF_ST_TYPE ELF64_ST_TYPE
2946 #define ELF_ST_BIND ELF64_ST_BIND
2947 #define ELF_R_TYPE ELF64_R_TYPE
2948 #define ELF_R_SYM ELF64_R_SYM
2950 #define ELFCLASS ELFCLASS32
2951 #define Elf_Addr Elf32_Addr
2952 #define Elf_Word Elf32_Word
2953 #define Elf_Sword Elf32_Sword
2954 #define Elf_Ehdr Elf32_Ehdr
2955 #define Elf_Phdr Elf32_Phdr
2956 #define Elf_Shdr Elf32_Shdr
2957 #define Elf_Sym Elf32_Sym
2958 #define Elf_Rel Elf32_Rel
2959 #define Elf_Rela Elf32_Rela
2961 #define ELF_ST_TYPE ELF32_ST_TYPE
2964 #define ELF_ST_BIND ELF32_ST_BIND
2967 #define ELF_R_TYPE ELF32_R_TYPE
2970 #define ELF_R_SYM ELF32_R_SYM
2976 * Functions to allocate entries in dynamic sections. Currently we simply
2977 * preallocate a large number, and we don't check if a entry for the given
2978 * target already exists (a linear search is too slow). Ideally these
2979 * entries would be associated with symbols.
2982 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2983 #define GOT_SIZE 0x20000
2984 #define FUNCTION_TABLE_SIZE 0x10000
2985 #define PLT_SIZE 0x08000
2988 static Elf_Addr got[GOT_SIZE];
2989 static unsigned int gotIndex;
2990 static Elf_Addr gp_val = (Elf_Addr)got;
2993 allocateGOTEntry(Elf_Addr target)
2997 if (gotIndex >= GOT_SIZE)
2998 barf("Global offset table overflow");
3000 entry = &got[gotIndex++];
3002 return (Elf_Addr)entry;
3006 #ifdef ELF_FUNCTION_DESC
3012 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
3013 static unsigned int functionTableIndex;
3016 allocateFunctionDesc(Elf_Addr target)
3018 FunctionDesc *entry;
3020 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
3021 barf("Function table overflow");
3023 entry = &functionTable[functionTableIndex++];
3025 entry->gp = (Elf_Addr)gp_val;
3026 return (Elf_Addr)entry;
3030 copyFunctionDesc(Elf_Addr target)
3032 FunctionDesc *olddesc = (FunctionDesc *)target;
3033 FunctionDesc *newdesc;
3035 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
3036 newdesc->gp = olddesc->gp;
3037 return (Elf_Addr)newdesc;
3044 unsigned char code[sizeof(plt_code)];
3048 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
3050 PLTEntry *plt = (PLTEntry *)oc->plt;
3053 if (oc->pltIndex >= PLT_SIZE)
3054 barf("Procedure table overflow");
3056 entry = &plt[oc->pltIndex++];
3057 memcpy(entry->code, plt_code, sizeof(entry->code));
3058 PLT_RELOC(entry->code, target);
3059 return (Elf_Addr)entry;
3065 return (PLT_SIZE * sizeof(PLTEntry));
3071 * Generic ELF functions
3075 findElfSection ( void* objImage, Elf_Word sh_type )
3077 char* ehdrC = (char*)objImage;
3078 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3079 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
3080 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3084 for (i = 0; i < ehdr->e_shnum; i++) {
3085 if (shdr[i].sh_type == sh_type
3086 /* Ignore the section header's string table. */
3087 && i != ehdr->e_shstrndx
3088 /* Ignore string tables named .stabstr, as they contain
3090 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3092 ptr = ehdrC + shdr[i].sh_offset;
3100 ocVerifyImage_ELF ( ObjectCode* oc )
3104 int i, j, nent, nstrtab, nsymtabs;
3108 char* ehdrC = (char*)(oc->image);
3109 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3111 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
3112 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
3113 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
3114 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
3115 errorBelch("%s: not an ELF object", oc->fileName);
3119 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
3120 errorBelch("%s: unsupported ELF format", oc->fileName);
3124 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
3125 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
3127 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
3128 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
3130 errorBelch("%s: unknown endiannness", oc->fileName);
3134 if (ehdr->e_type != ET_REL) {
3135 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
3138 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
3140 IF_DEBUG(linker,debugBelch( "Architecture is " ));
3141 switch (ehdr->e_machine) {
3142 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
3143 #ifdef EM_SPARC32PLUS
3144 case EM_SPARC32PLUS:
3146 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
3148 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
3150 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
3152 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
3153 #elif defined(EM_AMD64)
3154 case EM_AMD64: IF_DEBUG(linker,debugBelch( "amd64" )); break;
3156 default: IF_DEBUG(linker,debugBelch( "unknown" ));
3157 errorBelch("%s: unknown architecture (e_machine == %d)"
3158 , oc->fileName, ehdr->e_machine);
3162 IF_DEBUG(linker,debugBelch(
3163 "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
3164 (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
3166 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
3168 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3170 if (ehdr->e_shstrndx == SHN_UNDEF) {
3171 errorBelch("%s: no section header string table", oc->fileName);
3174 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
3176 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
3179 for (i = 0; i < ehdr->e_shnum; i++) {
3180 IF_DEBUG(linker,debugBelch("%2d: ", i ));
3181 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
3182 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
3183 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
3184 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
3185 ehdrC + shdr[i].sh_offset,
3186 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
3188 if (shdr[i].sh_type == SHT_REL) {
3189 IF_DEBUG(linker,debugBelch("Rel " ));
3190 } else if (shdr[i].sh_type == SHT_RELA) {
3191 IF_DEBUG(linker,debugBelch("RelA " ));
3193 IF_DEBUG(linker,debugBelch(" "));
3196 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
3200 IF_DEBUG(linker,debugBelch( "\nString tables" ));
3203 for (i = 0; i < ehdr->e_shnum; i++) {
3204 if (shdr[i].sh_type == SHT_STRTAB
3205 /* Ignore the section header's string table. */
3206 && i != ehdr->e_shstrndx
3207 /* Ignore string tables named .stabstr, as they contain
3209 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
3211 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
3212 strtab = ehdrC + shdr[i].sh_offset;
3217 errorBelch("%s: no string tables, or too many", oc->fileName);
3222 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
3223 for (i = 0; i < ehdr->e_shnum; i++) {
3224 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3225 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
3227 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3228 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3229 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
3231 (long)shdr[i].sh_size % sizeof(Elf_Sym)
3233 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
3234 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
3237 for (j = 0; j < nent; j++) {
3238 IF_DEBUG(linker,debugBelch(" %2d ", j ));
3239 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
3240 (int)stab[j].st_shndx,
3241 (int)stab[j].st_size,
3242 (char*)stab[j].st_value ));
3244 IF_DEBUG(linker,debugBelch("type=" ));
3245 switch (ELF_ST_TYPE(stab[j].st_info)) {
3246 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
3247 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
3248 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
3249 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
3250 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
3251 default: IF_DEBUG(linker,debugBelch("? " )); break;
3253 IF_DEBUG(linker,debugBelch(" " ));
3255 IF_DEBUG(linker,debugBelch("bind=" ));
3256 switch (ELF_ST_BIND(stab[j].st_info)) {
3257 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
3258 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
3259 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
3260 default: IF_DEBUG(linker,debugBelch("? " )); break;
3262 IF_DEBUG(linker,debugBelch(" " ));
3264 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
3268 if (nsymtabs == 0) {
3269 errorBelch("%s: didn't find any symbol tables", oc->fileName);
3276 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
3280 if (hdr->sh_type == SHT_PROGBITS
3281 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
3282 /* .text-style section */
3283 return SECTIONKIND_CODE_OR_RODATA;
3286 if (hdr->sh_type == SHT_PROGBITS
3287 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3288 /* .data-style section */
3289 return SECTIONKIND_RWDATA;
3292 if (hdr->sh_type == SHT_PROGBITS
3293 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
3294 /* .rodata-style section */
3295 return SECTIONKIND_CODE_OR_RODATA;
3298 if (hdr->sh_type == SHT_NOBITS
3299 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
3300 /* .bss-style section */
3302 return SECTIONKIND_RWDATA;
3305 return SECTIONKIND_OTHER;
3310 ocGetNames_ELF ( ObjectCode* oc )
3315 char* ehdrC = (char*)(oc->image);
3316 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
3317 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
3318 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3320 ASSERT(symhash != NULL);
3323 errorBelch("%s: no strtab", oc->fileName);
3328 for (i = 0; i < ehdr->e_shnum; i++) {
3329 /* Figure out what kind of section it is. Logic derived from
3330 Figure 1.14 ("Special Sections") of the ELF document
3331 ("Portable Formats Specification, Version 1.1"). */
3333 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
3335 if (is_bss && shdr[i].sh_size > 0) {
3336 /* This is a non-empty .bss section. Allocate zeroed space for
3337 it, and set its .sh_offset field such that
3338 ehdrC + .sh_offset == addr_of_zeroed_space. */
3339 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
3340 "ocGetNames_ELF(BSS)");
3341 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
3343 debugBelch("BSS section at 0x%x, size %d\n",
3344 zspace, shdr[i].sh_size);
3348 /* fill in the section info */
3349 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
3350 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
3351 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
3352 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
3355 if (shdr[i].sh_type != SHT_SYMTAB) continue;
3357 /* copy stuff into this module's object symbol table */
3358 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
3359 nent = shdr[i].sh_size / sizeof(Elf_Sym);
3361 oc->n_symbols = nent;
3362 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
3363 "ocGetNames_ELF(oc->symbols)");
3365 for (j = 0; j < nent; j++) {
3367 char isLocal = FALSE; /* avoids uninit-var warning */
3369 char* nm = strtab + stab[j].st_name;
3370 int secno = stab[j].st_shndx;
3372 /* Figure out if we want to add it; if so, set ad to its
3373 address. Otherwise leave ad == NULL. */
3375 if (secno == SHN_COMMON) {
3377 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
3379 debugBelch("COMMON symbol, size %d name %s\n",
3380 stab[j].st_size, nm);
3382 /* Pointless to do addProddableBlock() for this area,
3383 since the linker should never poke around in it. */
3386 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
3387 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
3389 /* and not an undefined symbol */
3390 && stab[j].st_shndx != SHN_UNDEF
3391 /* and not in a "special section" */
3392 && stab[j].st_shndx < SHN_LORESERVE
3394 /* and it's a not a section or string table or anything silly */
3395 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
3396 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
3397 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
3400 /* Section 0 is the undefined section, hence > and not >=. */
3401 ASSERT(secno > 0 && secno < ehdr->e_shnum);
3403 if (shdr[secno].sh_type == SHT_NOBITS) {
3404 debugBelch(" BSS symbol, size %d off %d name %s\n",
3405 stab[j].st_size, stab[j].st_value, nm);
3408 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
3409 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
3412 #ifdef ELF_FUNCTION_DESC
3413 /* dlsym() and the initialisation table both give us function
3414 * descriptors, so to be consistent we store function descriptors
3415 * in the symbol table */
3416 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
3417 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
3419 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s\n",
3420 ad, oc->fileName, nm ));
3425 /* And the decision is ... */
3429 oc->symbols[j] = nm;
3432 /* Ignore entirely. */
3434 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
3438 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
3439 strtab + stab[j].st_name ));
3442 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
3443 (int)ELF_ST_BIND(stab[j].st_info),
3444 (int)ELF_ST_TYPE(stab[j].st_info),
3445 (int)stab[j].st_shndx,
3446 strtab + stab[j].st_name
3449 oc->symbols[j] = NULL;
3458 /* Do ELF relocations which lack an explicit addend. All x86-linux
3459 relocations appear to be of this form. */
3461 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3462 Elf_Shdr* shdr, int shnum,
3463 Elf_Sym* stab, char* strtab )
3468 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3469 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3470 int target_shndx = shdr[shnum].sh_info;
3471 int symtab_shndx = shdr[shnum].sh_link;
3473 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3474 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3475 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3476 target_shndx, symtab_shndx ));
3478 /* Skip sections that we're not interested in. */
3481 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3482 if (kind == SECTIONKIND_OTHER) {
3483 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3488 for (j = 0; j < nent; j++) {
3489 Elf_Addr offset = rtab[j].r_offset;
3490 Elf_Addr info = rtab[j].r_info;
3492 Elf_Addr P = ((Elf_Addr)targ) + offset;
3493 Elf_Word* pP = (Elf_Word*)P;
3498 StgStablePtr stablePtr;
3501 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3502 j, (void*)offset, (void*)info ));
3504 IF_DEBUG(linker,debugBelch( " ZERO" ));
3507 Elf_Sym sym = stab[ELF_R_SYM(info)];
3508 /* First see if it is a local symbol. */
3509 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3510 /* Yes, so we can get the address directly from the ELF symbol
3512 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3514 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3515 + stab[ELF_R_SYM(info)].st_value);
3518 symbol = strtab + sym.st_name;
3519 stablePtr = (StgStablePtr)lookupHashTable(stablehash, (StgWord)symbol);
3520 if (NULL == stablePtr) {
3521 /* No, so look up the name in our global table. */
3522 S_tmp = lookupSymbol( symbol );
3523 S = (Elf_Addr)S_tmp;
3525 stableVal = deRefStablePtr( stablePtr );
3527 S = (Elf_Addr)S_tmp;
3531 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3534 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3537 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3538 (void*)P, (void*)S, (void*)A ));
3539 checkProddableBlock ( oc, pP );
3543 switch (ELF_R_TYPE(info)) {
3544 # ifdef i386_HOST_ARCH
3545 case R_386_32: *pP = value; break;
3546 case R_386_PC32: *pP = value - P; break;
3549 errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
3550 oc->fileName, (lnat)ELF_R_TYPE(info));
3558 /* Do ELF relocations for which explicit addends are supplied.
3559 sparc-solaris relocations appear to be of this form. */
3561 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3562 Elf_Shdr* shdr, int shnum,
3563 Elf_Sym* stab, char* strtab )
3566 char *symbol = NULL;
3568 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3569 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3570 int target_shndx = shdr[shnum].sh_info;
3571 int symtab_shndx = shdr[shnum].sh_link;
3573 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3574 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3575 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3576 target_shndx, symtab_shndx ));
3578 for (j = 0; j < nent; j++) {
3579 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3580 /* This #ifdef only serves to avoid unused-var warnings. */
3581 Elf_Addr offset = rtab[j].r_offset;
3582 Elf_Addr P = targ + offset;
3584 Elf_Addr info = rtab[j].r_info;
3585 Elf_Addr A = rtab[j].r_addend;
3589 # if defined(sparc_HOST_ARCH)
3590 Elf_Word* pP = (Elf_Word*)P;
3592 # elif defined(powerpc_HOST_ARCH)
3596 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3597 j, (void*)offset, (void*)info,
3600 IF_DEBUG(linker,debugBelch( " ZERO" ));
3603 Elf_Sym sym = stab[ELF_R_SYM(info)];
3604 /* First see if it is a local symbol. */
3605 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3606 /* Yes, so we can get the address directly from the ELF symbol
3608 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3610 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3611 + stab[ELF_R_SYM(info)].st_value);
3612 #ifdef ELF_FUNCTION_DESC
3613 /* Make a function descriptor for this function */
3614 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3615 S = allocateFunctionDesc(S + A);
3620 /* No, so look up the name in our global table. */
3621 symbol = strtab + sym.st_name;
3622 S_tmp = lookupSymbol( symbol );
3623 S = (Elf_Addr)S_tmp;
3625 #ifdef ELF_FUNCTION_DESC
3626 /* If a function, already a function descriptor - we would
3627 have to copy it to add an offset. */
3628 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3629 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3633 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3636 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3639 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3640 (void*)P, (void*)S, (void*)A ));
3641 /* checkProddableBlock ( oc, (void*)P ); */
3645 switch (ELF_R_TYPE(info)) {
3646 # if defined(sparc_HOST_ARCH)
3647 case R_SPARC_WDISP30:
3648 w1 = *pP & 0xC0000000;
3649 w2 = (Elf_Word)((value - P) >> 2);
3650 ASSERT((w2 & 0xC0000000) == 0);
3655 w1 = *pP & 0xFFC00000;
3656 w2 = (Elf_Word)(value >> 10);
3657 ASSERT((w2 & 0xFFC00000) == 0);
3663 w2 = (Elf_Word)(value & 0x3FF);
3664 ASSERT((w2 & ~0x3FF) == 0);
3669 /* According to the Sun documentation:
3671 This relocation type resembles R_SPARC_32, except it refers to an
3672 unaligned word. That is, the word to be relocated must be treated
3673 as four separate bytes with arbitrary alignment, not as a word
3674 aligned according to the architecture requirements.
3677 w2 = (Elf_Word)value;
3679 // SPARC doesn't do misaligned writes of 32 bit words,
3680 // so we have to do this one byte-at-a-time.
3681 char *pPc = (char*)pP;
3682 pPc[0] = (char) ((Elf_Word)(w2 & 0xff000000) >> 24);
3683 pPc[1] = (char) ((Elf_Word)(w2 & 0x00ff0000) >> 16);
3684 pPc[2] = (char) ((Elf_Word)(w2 & 0x0000ff00) >> 8);
3685 pPc[3] = (char) ((Elf_Word)(w2 & 0x000000ff));
3689 w2 = (Elf_Word)value;
3692 # elif defined(powerpc_HOST_ARCH)
3693 case R_PPC_ADDR16_LO:
3694 *(Elf32_Half*) P = value;
3697 case R_PPC_ADDR16_HI:
3698 *(Elf32_Half*) P = value >> 16;
3701 case R_PPC_ADDR16_HA:
3702 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3706 *(Elf32_Word *) P = value;
3710 *(Elf32_Word *) P = value - P;
3716 if( delta << 6 >> 6 != delta )
3718 value = (Elf_Addr) (&makeSymbolExtra( oc, ELF_R_SYM(info), value )
3722 if( value == 0 || delta << 6 >> 6 != delta )
3724 barf( "Unable to make SymbolExtra for #%d",
3730 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3731 | (delta & 0x3fffffc);
3735 #if x86_64_HOST_ARCH
3737 *(Elf64_Xword *)P = value;
3742 StgInt64 off = value - P;
3743 if (off >= 0x7fffffffL || off < -0x80000000L) {
3744 #if X86_64_ELF_NONPIC_HACK
3745 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3747 off = pltAddress + A - P;
3749 barf("R_X86_64_PC32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3750 symbol, off, oc->fileName );
3753 *(Elf64_Word *)P = (Elf64_Word)off;
3759 StgInt64 off = value - P;
3760 *(Elf64_Word *)P = (Elf64_Word)off;
3765 if (value >= 0x7fffffffL) {
3766 #if X86_64_ELF_NONPIC_HACK
3767 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3769 value = pltAddress + A;
3771 barf("R_X86_64_32 relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3772 symbol, value, oc->fileName );
3775 *(Elf64_Word *)P = (Elf64_Word)value;
3779 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3780 #if X86_64_ELF_NONPIC_HACK
3781 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3783 value = pltAddress + A;
3785 barf("R_X86_64_32S relocation out of range: %s = %p\nRecompile %s with -fPIC.",
3786 symbol, value, oc->fileName );
3789 *(Elf64_Sword *)P = (Elf64_Sword)value;
3792 case R_X86_64_GOTPCREL:
3794 StgInt64 gotAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)->addr;
3795 StgInt64 off = gotAddress + A - P;
3796 *(Elf64_Word *)P = (Elf64_Word)off;
3800 case R_X86_64_PLT32:
3802 StgInt64 off = value - P;
3803 if (off >= 0x7fffffffL || off < -0x80000000L) {
3804 StgInt64 pltAddress = (StgInt64) &makeSymbolExtra(oc, ELF_R_SYM(info), S)
3806 off = pltAddress + A - P;
3808 *(Elf64_Word *)P = (Elf64_Word)off;
3814 errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
3815 oc->fileName, (lnat)ELF_R_TYPE(info));
3824 ocResolve_ELF ( ObjectCode* oc )
3828 Elf_Sym* stab = NULL;
3829 char* ehdrC = (char*)(oc->image);
3830 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3831 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3833 /* first find "the" symbol table */
3834 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3836 /* also go find the string table */
3837 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3839 if (stab == NULL || strtab == NULL) {
3840 errorBelch("%s: can't find string or symbol table", oc->fileName);
3844 /* Process the relocation sections. */
3845 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3846 if (shdr[shnum].sh_type == SHT_REL) {
3847 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3848 shnum, stab, strtab );
3852 if (shdr[shnum].sh_type == SHT_RELA) {
3853 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3854 shnum, stab, strtab );
3859 #if defined(powerpc_HOST_ARCH)
3860 ocFlushInstructionCache( oc );
3867 * PowerPC & X86_64 ELF specifics
3870 #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3872 static int ocAllocateSymbolExtras_ELF( ObjectCode *oc )
3878 ehdr = (Elf_Ehdr *) oc->image;
3879 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3881 for( i = 0; i < ehdr->e_shnum; i++ )
3882 if( shdr[i].sh_type == SHT_SYMTAB )
3885 if( i == ehdr->e_shnum )
3887 errorBelch( "This ELF file contains no symtab" );
3891 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3893 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3894 (int) shdr[i].sh_entsize, (int) sizeof( Elf_Sym ) );
3899 return ocAllocateSymbolExtras( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3902 #endif /* powerpc */
3906 /* --------------------------------------------------------------------------
3908 * ------------------------------------------------------------------------*/
3910 #if defined(OBJFORMAT_MACHO)
3913 Support for MachO linking on Darwin/MacOS X
3914 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3916 I hereby formally apologize for the hackish nature of this code.
3917 Things that need to be done:
3918 *) implement ocVerifyImage_MachO
3919 *) add still more sanity checks.
3922 #if x86_64_HOST_ARCH || powerpc64_HOST_ARCH
3923 #define mach_header mach_header_64
3924 #define segment_command segment_command_64
3925 #define section section_64
3926 #define nlist nlist_64
3929 #ifdef powerpc_HOST_ARCH
3930 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3932 struct mach_header *header = (struct mach_header *) oc->image;
3933 struct load_command *lc = (struct load_command *) (header + 1);
3936 for( i = 0; i < header->ncmds; i++ )
3938 if( lc->cmd == LC_SYMTAB )
3940 // Find out the first and last undefined external
3941 // symbol, so we don't have to allocate too many
3943 struct symtab_command *symLC = (struct symtab_command *) lc;
3944 unsigned min = symLC->nsyms, max = 0;
3945 struct nlist *nlist =
3946 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3948 for(i=0;i<symLC->nsyms;i++)
3950 if(nlist[i].n_type & N_STAB)
3952 else if(nlist[i].n_type & N_EXT)
3954 if((nlist[i].n_type & N_TYPE) == N_UNDF
3955 && (nlist[i].n_value == 0))
3965 return ocAllocateSymbolExtras(oc, max - min + 1, min);
3970 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3972 return ocAllocateSymbolExtras(oc,0,0);
3975 #ifdef x86_64_HOST_ARCH
3976 static int ocAllocateSymbolExtras_MachO(ObjectCode* oc)
3978 struct mach_header *header = (struct mach_header *) oc->image;
3979 struct load_command *lc = (struct load_command *) (header + 1);
3982 for( i = 0; i < header->ncmds; i++ )
3984 if( lc->cmd == LC_SYMTAB )
3986 // Just allocate one entry for every symbol
3987 struct symtab_command *symLC = (struct symtab_command *) lc;
3989 return ocAllocateSymbolExtras(oc, symLC->nsyms, 0);
3992 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3994 return ocAllocateSymbolExtras(oc,0,0);
3998 static int ocVerifyImage_MachO(ObjectCode* oc)
4000 char *image = (char*) oc->image;
4001 struct mach_header *header = (struct mach_header*) image;
4003 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4004 if(header->magic != MH_MAGIC_64)
4007 if(header->magic != MH_MAGIC)
4010 // FIXME: do some more verifying here
4014 static int resolveImports(
4017 struct symtab_command *symLC,
4018 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
4019 unsigned long *indirectSyms,
4020 struct nlist *nlist)
4023 size_t itemSize = 4;
4026 int isJumpTable = 0;
4027 if(!strcmp(sect->sectname,"__jump_table"))
4031 ASSERT(sect->reserved2 == itemSize);
4035 for(i=0; i*itemSize < sect->size;i++)
4037 // according to otool, reserved1 contains the first index into the indirect symbol table
4038 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
4039 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4042 if((symbol->n_type & N_TYPE) == N_UNDF
4043 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
4044 addr = (void*) (symbol->n_value);
4046 addr = lookupSymbol(nm);
4049 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
4057 checkProddableBlock(oc,image + sect->offset + i*itemSize);
4058 *(image + sect->offset + i*itemSize) = 0xe9; // jmp
4059 *(unsigned*)(image + sect->offset + i*itemSize + 1)
4060 = (char*)addr - (image + sect->offset + i*itemSize + 5);
4065 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
4066 ((void**)(image + sect->offset))[i] = addr;
4073 static unsigned long relocateAddress(
4076 struct section* sections,
4077 unsigned long address)
4080 for(i = 0; i < nSections; i++)
4082 if(sections[i].addr <= address
4083 && address < sections[i].addr + sections[i].size)
4085 return (unsigned long)oc->image
4086 + sections[i].offset + address - sections[i].addr;
4089 barf("Invalid Mach-O file:"
4090 "Address out of bounds while relocating object file");
4094 static int relocateSection(
4097 struct symtab_command *symLC, struct nlist *nlist,
4098 int nSections, struct section* sections, struct section *sect)
4100 struct relocation_info *relocs;
4103 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
4105 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
4107 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
4109 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
4113 relocs = (struct relocation_info*) (image + sect->reloff);
4117 #ifdef x86_64_HOST_ARCH
4118 struct relocation_info *reloc = &relocs[i];
4120 char *thingPtr = image + sect->offset + reloc->r_address;
4122 /* We shouldn't need to initialise this, but gcc on OS X 64 bit
4123 complains that it may be used uninitialized if we don't */
4126 int type = reloc->r_type;
4128 checkProddableBlock(oc,thingPtr);
4129 switch(reloc->r_length)
4132 thing = *(uint8_t*)thingPtr;
4133 baseValue = (uint64_t)thingPtr + 1;
4136 thing = *(uint16_t*)thingPtr;
4137 baseValue = (uint64_t)thingPtr + 2;
4140 thing = *(uint32_t*)thingPtr;
4141 baseValue = (uint64_t)thingPtr + 4;
4144 thing = *(uint64_t*)thingPtr;
4145 baseValue = (uint64_t)thingPtr + 8;
4148 barf("Unknown size.");
4151 if(type == X86_64_RELOC_GOT
4152 || type == X86_64_RELOC_GOT_LOAD)
4154 ASSERT(reloc->r_extern);
4155 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)->addr;
4157 type = X86_64_RELOC_SIGNED;
4159 else if(reloc->r_extern)
4161 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4162 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4163 if(symbol->n_value == 0)
4164 value = (uint64_t) lookupSymbol(nm);
4166 value = relocateAddress(oc, nSections, sections,
4171 value = sections[reloc->r_symbolnum-1].offset
4172 - sections[reloc->r_symbolnum-1].addr
4176 if(type == X86_64_RELOC_BRANCH)
4178 if((int32_t)(value - baseValue) != (int64_t)(value - baseValue))
4180 ASSERT(reloc->r_extern);
4181 value = (uint64_t) &makeSymbolExtra(oc, reloc->r_symbolnum, value)
4184 ASSERT((int32_t)(value - baseValue) == (int64_t)(value - baseValue));
4185 type = X86_64_RELOC_SIGNED;
4190 case X86_64_RELOC_UNSIGNED:
4191 ASSERT(!reloc->r_pcrel);
4194 case X86_64_RELOC_SIGNED:
4195 ASSERT(reloc->r_pcrel);
4196 thing += value - baseValue;
4198 case X86_64_RELOC_SUBTRACTOR:
4199 ASSERT(!reloc->r_pcrel);
4203 barf("unkown relocation");
4206 switch(reloc->r_length)
4209 *(uint8_t*)thingPtr = thing;
4212 *(uint16_t*)thingPtr = thing;
4215 *(uint32_t*)thingPtr = thing;
4218 *(uint64_t*)thingPtr = thing;
4222 if(relocs[i].r_address & R_SCATTERED)
4224 struct scattered_relocation_info *scat =
4225 (struct scattered_relocation_info*) &relocs[i];
4229 if(scat->r_length == 2)
4231 unsigned long word = 0;
4232 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
4233 checkProddableBlock(oc,wordPtr);
4235 // Note on relocation types:
4236 // i386 uses the GENERIC_RELOC_* types,
4237 // while ppc uses special PPC_RELOC_* types.
4238 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
4239 // in both cases, all others are different.
4240 // Therefore, we use GENERIC_RELOC_VANILLA
4241 // and GENERIC_RELOC_PAIR instead of the PPC variants,
4242 // and use #ifdefs for the other types.
4244 // Step 1: Figure out what the relocated value should be
4245 if(scat->r_type == GENERIC_RELOC_VANILLA)
4247 word = *wordPtr + (unsigned long) relocateAddress(
4254 #ifdef powerpc_HOST_ARCH
4255 else if(scat->r_type == PPC_RELOC_SECTDIFF
4256 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
4257 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
4258 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
4260 else if(scat->r_type == GENERIC_RELOC_SECTDIFF
4261 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4264 struct scattered_relocation_info *pair =
4265 (struct scattered_relocation_info*) &relocs[i+1];
4267 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
4268 barf("Invalid Mach-O file: "
4269 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
4271 word = (unsigned long)
4272 (relocateAddress(oc, nSections, sections, scat->r_value)
4273 - relocateAddress(oc, nSections, sections, pair->r_value));
4276 #ifdef powerpc_HOST_ARCH
4277 else if(scat->r_type == PPC_RELOC_HI16
4278 || scat->r_type == PPC_RELOC_LO16
4279 || scat->r_type == PPC_RELOC_HA16
4280 || scat->r_type == PPC_RELOC_LO14)
4281 { // these are generated by label+offset things
4282 struct relocation_info *pair = &relocs[i+1];
4283 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
4284 barf("Invalid Mach-O file: "
4285 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
4287 if(scat->r_type == PPC_RELOC_LO16)
4289 word = ((unsigned short*) wordPtr)[1];
4290 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4292 else if(scat->r_type == PPC_RELOC_LO14)
4294 barf("Unsupported Relocation: PPC_RELOC_LO14");
4295 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
4296 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4298 else if(scat->r_type == PPC_RELOC_HI16)
4300 word = ((unsigned short*) wordPtr)[1] << 16;
4301 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4303 else if(scat->r_type == PPC_RELOC_HA16)
4305 word = ((unsigned short*) wordPtr)[1] << 16;
4306 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4310 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
4318 barf ("Don't know how to handle this Mach-O "
4319 "scattered relocation entry: "
4320 "object file %s; entry type %ld; "
4322 oc->fileName, scat->r_type, scat->r_address);
4326 #ifdef powerpc_HOST_ARCH
4327 if(scat->r_type == GENERIC_RELOC_VANILLA
4328 || scat->r_type == PPC_RELOC_SECTDIFF)
4330 if(scat->r_type == GENERIC_RELOC_VANILLA
4331 || scat->r_type == GENERIC_RELOC_SECTDIFF
4332 || scat->r_type == GENERIC_RELOC_LOCAL_SECTDIFF)
4337 #ifdef powerpc_HOST_ARCH
4338 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
4340 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4342 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
4344 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4346 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
4348 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4349 + ((word & (1<<15)) ? 1 : 0);
4355 barf("Can't handle Mach-O scattered relocation entry "
4356 "with this r_length tag: "
4357 "object file %s; entry type %ld; "
4358 "r_length tag %ld; address %#lx\n",
4359 oc->fileName, scat->r_type, scat->r_length,
4364 else /* scat->r_pcrel */
4366 barf("Don't know how to handle *PC-relative* Mach-O "
4367 "scattered relocation entry: "
4368 "object file %s; entry type %ld; address %#lx\n",
4369 oc->fileName, scat->r_type, scat->r_address);
4374 else /* !(relocs[i].r_address & R_SCATTERED) */
4376 struct relocation_info *reloc = &relocs[i];
4377 if(reloc->r_pcrel && !reloc->r_extern)
4380 if(reloc->r_length == 2)
4382 unsigned long word = 0;
4383 #ifdef powerpc_HOST_ARCH
4384 unsigned long jumpIsland = 0;
4385 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
4386 // to avoid warning and to catch
4390 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
4391 checkProddableBlock(oc,wordPtr);
4393 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4397 #ifdef powerpc_HOST_ARCH
4398 else if(reloc->r_type == PPC_RELOC_LO16)
4400 word = ((unsigned short*) wordPtr)[1];
4401 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
4403 else if(reloc->r_type == PPC_RELOC_HI16)
4405 word = ((unsigned short*) wordPtr)[1] << 16;
4406 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
4408 else if(reloc->r_type == PPC_RELOC_HA16)
4410 word = ((unsigned short*) wordPtr)[1] << 16;
4411 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
4413 else if(reloc->r_type == PPC_RELOC_BR24)
4416 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
4421 barf("Can't handle this Mach-O relocation entry "
4423 "object file %s; entry type %ld; address %#lx\n",
4424 oc->fileName, reloc->r_type, reloc->r_address);
4428 if(!reloc->r_extern)
4431 sections[reloc->r_symbolnum-1].offset
4432 - sections[reloc->r_symbolnum-1].addr
4439 struct nlist *symbol = &nlist[reloc->r_symbolnum];
4440 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
4441 void *symbolAddress = lookupSymbol(nm);
4444 errorBelch("\nunknown symbol `%s'", nm);
4450 #ifdef powerpc_HOST_ARCH
4451 // In the .o file, this should be a relative jump to NULL
4452 // and we'll change it to a relative jump to the symbol
4453 ASSERT(word + reloc->r_address == 0);
4454 jumpIsland = (unsigned long)
4455 &makeSymbolExtra(oc,
4457 (unsigned long) symbolAddress)
4461 offsetToJumpIsland = word + jumpIsland
4462 - (((long)image) + sect->offset - sect->addr);
4465 word += (unsigned long) symbolAddress
4466 - (((long)image) + sect->offset - sect->addr);
4470 word += (unsigned long) symbolAddress;
4474 if(reloc->r_type == GENERIC_RELOC_VANILLA)
4479 #ifdef powerpc_HOST_ARCH
4480 else if(reloc->r_type == PPC_RELOC_LO16)
4482 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
4485 else if(reloc->r_type == PPC_RELOC_HI16)
4487 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
4490 else if(reloc->r_type == PPC_RELOC_HA16)
4492 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
4493 + ((word & (1<<15)) ? 1 : 0);
4496 else if(reloc->r_type == PPC_RELOC_BR24)
4498 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4500 // The branch offset is too large.
4501 // Therefore, we try to use a jump island.
4504 barf("unconditional relative branch out of range: "
4505 "no jump island available");
4508 word = offsetToJumpIsland;
4509 if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
4510 barf("unconditional relative branch out of range: "
4511 "jump island out of range");
4513 *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
4520 barf("Can't handle Mach-O relocation entry (not scattered) "
4521 "with this r_length tag: "
4522 "object file %s; entry type %ld; "
4523 "r_length tag %ld; address %#lx\n",
4524 oc->fileName, reloc->r_type, reloc->r_length,
4534 static int ocGetNames_MachO(ObjectCode* oc)
4536 char *image = (char*) oc->image;
4537 struct mach_header *header = (struct mach_header*) image;
4538 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4539 unsigned i,curSymbol = 0;
4540 struct segment_command *segLC = NULL;
4541 struct section *sections;
4542 struct symtab_command *symLC = NULL;
4543 struct nlist *nlist;
4544 unsigned long commonSize = 0;
4545 char *commonStorage = NULL;
4546 unsigned long commonCounter;
4548 for(i=0;i<header->ncmds;i++)
4550 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4551 segLC = (struct segment_command*) lc;
4552 else if(lc->cmd == LC_SYMTAB)
4553 symLC = (struct symtab_command*) lc;
4554 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4557 sections = (struct section*) (segLC+1);
4558 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4562 barf("ocGetNames_MachO: no segment load command");
4564 for(i=0;i<segLC->nsects;i++)
4566 if(sections[i].size == 0)
4569 if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
4571 char * zeroFillArea = stgCallocBytes(1,sections[i].size,
4572 "ocGetNames_MachO(common symbols)");
4573 sections[i].offset = zeroFillArea - image;
4576 if(!strcmp(sections[i].sectname,"__text"))
4577 addSection(oc, SECTIONKIND_CODE_OR_RODATA,
4578 (void*) (image + sections[i].offset),
4579 (void*) (image + sections[i].offset + sections[i].size));
4580 else if(!strcmp(sections[i].sectname,"__const"))
4581 addSection(oc, SECTIONKIND_RWDATA,
4582 (void*) (image + sections[i].offset),
4583 (void*) (image + sections[i].offset + sections[i].size));
4584 else if(!strcmp(sections[i].sectname,"__data"))
4585 addSection(oc, SECTIONKIND_RWDATA,
4586 (void*) (image + sections[i].offset),
4587 (void*) (image + sections[i].offset + sections[i].size));
4588 else if(!strcmp(sections[i].sectname,"__bss")
4589 || !strcmp(sections[i].sectname,"__common"))
4590 addSection(oc, SECTIONKIND_RWDATA,
4591 (void*) (image + sections[i].offset),
4592 (void*) (image + sections[i].offset + sections[i].size));
4594 addProddableBlock(oc, (void*) (image + sections[i].offset),
4598 // count external symbols defined here
4602 for(i=0;i<symLC->nsyms;i++)
4604 if(nlist[i].n_type & N_STAB)
4606 else if(nlist[i].n_type & N_EXT)
4608 if((nlist[i].n_type & N_TYPE) == N_UNDF
4609 && (nlist[i].n_value != 0))
4611 commonSize += nlist[i].n_value;
4614 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4619 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
4620 "ocGetNames_MachO(oc->symbols)");
4624 for(i=0;i<symLC->nsyms;i++)
4626 if(nlist[i].n_type & N_STAB)
4628 else if((nlist[i].n_type & N_TYPE) == N_SECT)
4630 if(nlist[i].n_type & N_EXT)
4632 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4633 if((nlist[i].n_desc & N_WEAK_DEF) && lookupSymbol(nm))
4634 ; // weak definition, and we already have a definition
4637 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4639 + sections[nlist[i].n_sect-1].offset
4640 - sections[nlist[i].n_sect-1].addr
4641 + nlist[i].n_value);
4642 oc->symbols[curSymbol++] = nm;
4649 commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
4650 commonCounter = (unsigned long)commonStorage;
4653 for(i=0;i<symLC->nsyms;i++)
4655 if((nlist[i].n_type & N_TYPE) == N_UNDF
4656 && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
4658 char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
4659 unsigned long sz = nlist[i].n_value;
4661 nlist[i].n_value = commonCounter;
4663 ghciInsertStrHashTable(oc->fileName, symhash, nm,
4664 (void*)commonCounter);
4665 oc->symbols[curSymbol++] = nm;
4667 commonCounter += sz;
4674 static int ocResolve_MachO(ObjectCode* oc)
4676 char *image = (char*) oc->image;
4677 struct mach_header *header = (struct mach_header*) image;
4678 struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
4680 struct segment_command *segLC = NULL;
4681 struct section *sections;
4682 struct symtab_command *symLC = NULL;
4683 struct dysymtab_command *dsymLC = NULL;
4684 struct nlist *nlist;
4686 for(i=0;i<header->ncmds;i++)
4688 if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
4689 segLC = (struct segment_command*) lc;
4690 else if(lc->cmd == LC_SYMTAB)
4691 symLC = (struct symtab_command*) lc;
4692 else if(lc->cmd == LC_DYSYMTAB)
4693 dsymLC = (struct dysymtab_command*) lc;
4694 lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
4697 sections = (struct section*) (segLC+1);
4698 nlist = symLC ? (struct nlist*) (image + symLC->symoff)
4703 unsigned long *indirectSyms
4704 = (unsigned long*) (image + dsymLC->indirectsymoff);
4706 for(i=0;i<segLC->nsects;i++)
4708 if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
4709 || !strcmp(sections[i].sectname,"__la_sym_ptr2")
4710 || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
4712 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4715 else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
4716 || !strcmp(sections[i].sectname,"__pointers"))
4718 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4721 else if(!strcmp(sections[i].sectname,"__jump_table"))
4723 if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
4729 for(i=0;i<segLC->nsects;i++)
4731 if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,§ions[i]))
4735 #if defined (powerpc_HOST_ARCH)
4736 ocFlushInstructionCache( oc );
4742 #ifdef powerpc_HOST_ARCH
4744 * The Mach-O object format uses leading underscores. But not everywhere.
4745 * There is a small number of runtime support functions defined in
4746 * libcc_dynamic.a whose name does not have a leading underscore.
4747 * As a consequence, we can't get their address from C code.
4748 * We have to use inline assembler just to take the address of a function.
4752 static void machoInitSymbolsWithoutUnderscore()
4754 extern void* symbolsWithoutUnderscore[];
4755 void **p = symbolsWithoutUnderscore;
4756 __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
4758 #undef SymI_NeedsProto
4759 #define SymI_NeedsProto(x) \
4760 __asm__ volatile(".long " # x);
4762 RTS_MACHO_NOUNDERLINE_SYMBOLS
4764 __asm__ volatile(".text");
4766 #undef SymI_NeedsProto
4767 #define SymI_NeedsProto(x) \
4768 ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
4770 RTS_MACHO_NOUNDERLINE_SYMBOLS
4772 #undef SymI_NeedsProto
4777 * Figure out by how much to shift the entire Mach-O file in memory
4778 * when loading so that its single segment ends up 16-byte-aligned
4780 static int machoGetMisalignment( FILE * f )
4782 struct mach_header header;
4785 fread(&header, sizeof(header), 1, f);
4788 #if x86_64_TARGET_ARCH || powerpc64_TARGET_ARCH
4789 if(header.magic != MH_MAGIC_64)
4792 if(header.magic != MH_MAGIC)
4796 misalignment = (header.sizeofcmds + sizeof(header))
4799 return misalignment ? (16 - misalignment) : 0;