Linker.c 110 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
3
 * (c) The GHC Team, 2000-2004
4 5 6 7 8
 *
 * RTS Object Linker
 *
 * ---------------------------------------------------------------------------*/

sof's avatar
sof committed
9
#if 0
10
#include "PosixSource.h"
sof's avatar
sof committed
11
#endif
12 13 14 15 16 17

//  Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h>.
#ifdef __linux__
#define _GNU_SOURCE
#endif

18 19 20 21 22
#include "Rts.h"
#include "RtsFlags.h"
#include "HsFFI.h"
#include "Hash.h"
#include "Linker.h"
23
#include "LinkerInternals.h"
24
#include "RtsUtils.h"
25
#include "StoragePriv.h"
26
#include "Schedule.h"
27

28
#ifdef HAVE_SYS_TYPES_H
29
#include <sys/types.h>
30 31
#endif

32 33 34
#include <stdlib.h>
#include <string.h>

35
#ifdef HAVE_SYS_STAT_H
36
#include <sys/stat.h>
37
#endif
38

39 40 41
#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
#include <HaskellSupport/dlfcn.h>
#elif defined(HAVE_DLFCN_H)
42
#include <dlfcn.h>
43
#endif
44

sof's avatar
sof committed
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
#if defined(cygwin32_TARGET_OS)
#ifdef HAVE_DIRENT_H
#include <dirent.h>
#endif

#ifdef HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#include <regex.h>
#include <sys/fcntl.h>
#include <sys/termios.h>
#include <sys/utime.h>
#include <sys/utsname.h>
#include <sys/wait.h>
#endif

dons's avatar
dons committed
61
#if defined(ia64_TARGET_ARCH) || defined(openbsd_TARGET_OS)
62 63 64
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
dons's avatar
dons committed
65 66 67 68 69 70 71

#if defined(openbsd_TARGET_OS) 
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#endif

72 73
#endif

dons's avatar
dons committed
74
#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
75
#  define OBJFORMAT_ELF
76
#elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
77
#  define OBJFORMAT_PEi386
78
#  include <windows.h>
sof's avatar
sof committed
79
#  include <math.h>
80
#elif defined(darwin_TARGET_OS)
81
#  include <mach-o/ppc/reloc.h>
82 83 84 85
#  define OBJFORMAT_MACHO
#  include <mach-o/loader.h>
#  include <mach-o/nlist.h>
#  include <mach-o/reloc.h>
86
#  include <mach-o/dyld.h>
87 88
#endif

89
/* Hash table mapping symbol names to Symbol */
90
static /*Str*/HashTable *symhash;
91

92 93 94
/* List of currently loaded objects */
ObjectCode *objects = NULL;	/* initially empty */

95
#if defined(OBJFORMAT_ELF)
96 97 98
static int ocVerifyImage_ELF    ( ObjectCode* oc );
static int ocGetNames_ELF       ( ObjectCode* oc );
static int ocResolve_ELF        ( ObjectCode* oc );
99
#elif defined(OBJFORMAT_PEi386)
100 101 102
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386    ( ObjectCode* oc );
static int ocResolve_PEi386     ( ObjectCode* oc );
103
#elif defined(OBJFORMAT_MACHO)
104
static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
105 106 107
static int ocVerifyImage_MachO    ( ObjectCode* oc );
static int ocGetNames_MachO       ( ObjectCode* oc );
static int ocResolve_MachO        ( ObjectCode* oc );
108

109
static void machoInitSymbolsWithoutUnderscore( void );
110 111 112 113 114 115
#endif

/* -----------------------------------------------------------------------------
 * Built-in symbols from the RTS
 */

116 117 118 119 120 121
typedef struct _RtsSymbolVal {
    char   *lbl;
    void   *addr;
} RtsSymbolVal;


122 123 124 125 126 127 128 129 130 131 132
#if !defined(PAR)
#define Maybe_ForeignObj        SymX(mkForeignObjzh_fast)

#define Maybe_Stable_Names      SymX(mkWeakzh_fast)			\
      				SymX(makeStableNamezh_fast)		\
      				SymX(finalizzeWeakzh_fast)
#else
/* These are not available in GUM!!! -- HWL */
#define Maybe_ForeignObj
#define Maybe_Stable_Names
#endif
133 134

#if !defined (mingw32_TARGET_OS)
135
#define RTS_POSIX_ONLY_SYMBOLS                  \
136 137
      SymX(stg_sig_install)			\
      Sym(nocldstop)
sof's avatar
sof committed
138
#endif
139

sof's avatar
sof committed
140 141 142 143
#if defined (cygwin32_TARGET_OS)
#define RTS_MINGW_ONLY_SYMBOLS /**/
/* Don't have the ability to read import libs / archives, so
 * we have to stupidly list a lot of what libcygwin.a
144
 * exports; sigh.
sof's avatar
sof committed
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221
 */
#define RTS_CYGWIN_ONLY_SYMBOLS                 \
      SymX(regfree)                             \
      SymX(regexec)                             \
      SymX(regerror)                            \
      SymX(regcomp)                             \
      SymX(__errno)                             \
      SymX(access)                              \
      SymX(chmod)                               \
      SymX(chdir)                               \
      SymX(close)                               \
      SymX(creat)                               \
      SymX(dup)                                 \
      SymX(dup2)                                \
      SymX(fstat)                               \
      SymX(fcntl)                               \
      SymX(getcwd)                              \
      SymX(getenv)                              \
      SymX(lseek)                               \
      SymX(open)                                \
      SymX(fpathconf)                           \
      SymX(pathconf)                            \
      SymX(stat)                                \
      SymX(pow)                                 \
      SymX(tanh)                                \
      SymX(cosh)                                \
      SymX(sinh)                                \
      SymX(atan)                                \
      SymX(acos)                                \
      SymX(asin)                                \
      SymX(tan)                                 \
      SymX(cos)                                 \
      SymX(sin)                                 \
      SymX(exp)                                 \
      SymX(log)                                 \
      SymX(sqrt)                                \
      SymX(localtime_r)                         \
      SymX(gmtime_r)                            \
      SymX(mktime)                              \
      Sym(_imp___tzname)                        \
      SymX(gettimeofday)                        \
      SymX(timezone)                            \
      SymX(tcgetattr)                           \
      SymX(tcsetattr)                           \
      SymX(memcpy)                              \
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
      SymX(free)                                \
      SymX(fork)                                \
      SymX(lstat)                               \
      SymX(isatty)                              \
      SymX(mkdir)                               \
      SymX(opendir)                             \
      SymX(readdir)                             \
      SymX(rewinddir)                           \
      SymX(closedir)                            \
      SymX(link)                                \
      SymX(mkfifo)                              \
      SymX(pipe)                                \
      SymX(read)                                \
      SymX(rename)                              \
      SymX(rmdir)                               \
      SymX(select)                              \
      SymX(system)                              \
      SymX(write)                               \
      SymX(strcmp)                              \
      SymX(strcpy)                              \
      SymX(strncpy)                             \
      SymX(strerror)                            \
      SymX(sigaddset)                           \
      SymX(sigemptyset)                         \
      SymX(sigprocmask)                         \
      SymX(umask)                               \
      SymX(uname)                               \
      SymX(unlink)                              \
      SymX(utime)                               \
222
      SymX(waitpid)
223

sof's avatar
sof committed
224 225 226 227 228 229
#elif !defined(mingw32_TARGET_OS)
#define RTS_MINGW_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
#else /* defined(mingw32_TARGET_OS) */
#define RTS_POSIX_ONLY_SYMBOLS  /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
230

231 232 233 234
/* Extra syms gen'ed by mingw-2's gcc-3.2: */
#if __GNUC__>=3
#define RTS_MINGW_EXTRA_SYMS                    \
      Sym(_imp____mb_cur_max)                   \
235
      Sym(_imp___pctype)
236 237 238 239
#else
#define RTS_MINGW_EXTRA_SYMS
#endif

240 241
/* These are statically linked from the mingw libraries into the ghc
   executable, so we have to employ this hack. */
242
#define RTS_MINGW_ONLY_SYMBOLS                  \
sof's avatar
sof committed
243 244
      SymX(asyncReadzh_fast)			\
      SymX(asyncWritezh_fast)			\
sof's avatar
sof committed
245
      SymX(asyncDoProczh_fast)			\
246
      SymX(memset)                              \
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
      SymX(inet_ntoa)                           \
      SymX(inet_addr)                           \
      SymX(htonl)                               \
      SymX(recvfrom)                            \
      SymX(listen)                              \
      SymX(bind)                                \
      SymX(shutdown)                            \
      SymX(connect)                             \
      SymX(htons)                               \
      SymX(ntohs)                               \
      SymX(getservbyname)                       \
      SymX(getservbyport)                       \
      SymX(getprotobynumber)                    \
      SymX(getprotobyname)                      \
      SymX(gethostbyname)                       \
      SymX(gethostbyaddr)                       \
      SymX(gethostname)                         \
      SymX(strcpy)                              \
      SymX(strncpy)                             \
      SymX(abort)                               \
      Sym(_alloca)                              \
      Sym(isxdigit)                             \
      Sym(isupper)                              \
      Sym(ispunct)                              \
      Sym(islower)                              \
      Sym(isspace)                              \
      Sym(isprint)                              \
      Sym(isdigit)                              \
      Sym(iscntrl)                              \
      Sym(isalpha)                              \
      Sym(isalnum)                              \
      SymX(strcmp)                              \
279 280 281
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
282 283 284 285 286 287 288 289 290 291 292 293 294 295
      SymX(pow)                                 \
      SymX(tanh)                                \
      SymX(cosh)                                \
      SymX(sinh)                                \
      SymX(atan)                                \
      SymX(acos)                                \
      SymX(asin)                                \
      SymX(tan)                                 \
      SymX(cos)                                 \
      SymX(sin)                                 \
      SymX(exp)                                 \
      SymX(log)                                 \
      SymX(sqrt)                                \
      SymX(memcpy)                              \
296
      Sym(mktime)                               \
297
      Sym(_imp___timezone)                      \
298
      Sym(_imp___tzname)                        \
299
      Sym(_imp___iob)                           \
300 301 302 303
      Sym(localtime)                            \
      Sym(gmtime)                               \
      Sym(opendir)                              \
      Sym(readdir)                              \
sof's avatar
sof committed
304
      Sym(rewinddir)                            \
305
      RTS_MINGW_EXTRA_SYMS                      \
306
      Sym(closedir)
307
#endif
308

sof's avatar
sof committed
309 310 311 312 313
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
314

315
#define RTS_SYMBOLS				\
316 317 318
      Maybe_ForeignObj				\
      Maybe_Stable_Names			\
      Sym(StgReturn)				\
319 320 321
      SymX(stg_enter_info)			\
      SymX(stg_enter_ret)			\
      SymX(stg_gc_void_info)			\
322 323
      SymX(__stg_gc_enter_1)			\
      SymX(stg_gc_noregs)			\
324
      SymX(stg_gc_unpt_r1_info)			\
325
      SymX(stg_gc_unpt_r1)			\
326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342
      SymX(stg_gc_unbx_r1_info)			\
      SymX(stg_gc_unbx_r1)			\
      SymX(stg_gc_f1_info)			\
      SymX(stg_gc_f1)				\
      SymX(stg_gc_d1_info)			\
      SymX(stg_gc_d1)				\
      SymX(stg_gc_l1_info)			\
      SymX(stg_gc_l1)				\
      SymX(__stg_gc_fun)			\
      SymX(stg_gc_fun_info)			\
      SymX(stg_gc_fun_ret)			\
      SymX(stg_gc_gen)				\
      SymX(stg_gc_gen_info)			\
      SymX(stg_gc_gen_hp)			\
      SymX(stg_gc_ut)				\
      SymX(stg_gen_yield)			\
      SymX(stg_yield_noregs)			\
343
      SymX(stg_yield_to_interpreter)		\
344 345 346 347 348 349
      SymX(stg_gen_block)			\
      SymX(stg_block_noregs)			\
      SymX(stg_block_1)				\
      SymX(stg_block_takemvar)			\
      SymX(stg_block_putmvar)			\
      SymX(stg_seq_frame_info)			\
sof's avatar
sof committed
350
      MAIN_CAP_SYM                              \
351 352 353 354 355 356 357 358 359 360 361 362 363 364 365
      SymX(MallocFailHook)			\
      SymX(OnExitHook)				\
      SymX(OutOfHeapHook)			\
      SymX(StackOverflowHook)			\
      SymX(__encodeDouble)			\
      SymX(__encodeFloat)			\
      SymX(__gmpn_gcd_1)			\
      SymX(__gmpz_cmp)				\
      SymX(__gmpz_cmp_si)			\
      SymX(__gmpz_cmp_ui)			\
      SymX(__gmpz_get_si)			\
      SymX(__gmpz_get_ui)			\
      SymX(__int_encodeDouble)			\
      SymX(__int_encodeFloat)			\
      SymX(andIntegerzh_fast)			\
366
      SymX(barf)				\
367 368 369 370
      SymX(blockAsyncExceptionszh_fast)		\
      SymX(catchzh_fast)			\
      SymX(cmp_thread)				\
      SymX(complementIntegerzh_fast)		\
sof's avatar
sof committed
371 372
      SymX(cmpIntegerzh_fast)	        	\
      SymX(cmpIntegerIntzh_fast)	      	\
373 374 375 376 377
      SymX(createAdjustor)			\
      SymX(decodeDoublezh_fast)			\
      SymX(decodeFloatzh_fast)			\
      SymX(defaultsHook)			\
      SymX(delayzh_fast)			\
sof's avatar
sof committed
378 379
      SymX(deRefWeakzh_fast)			\
      SymX(deRefStablePtrzh_fast)		\
380 381 382
      SymX(divExactIntegerzh_fast)		\
      SymX(divModIntegerzh_fast)		\
      SymX(forkzh_fast)				\
383
      SymX(forkProcess)				\
384
      SymX(forkOS_createThread)			\
385
      SymX(freeHaskellFunctionPtr)		\
sof's avatar
sof committed
386
      SymX(freeStablePtr)		        \
387
      SymX(gcdIntegerzh_fast)			\
sof's avatar
sof committed
388 389
      SymX(gcdIntegerIntzh_fast)		\
      SymX(gcdIntzh_fast)			\
390
      SymX(genSymZh)				\
391 392 393
      SymX(getProgArgv)				\
      SymX(getStablePtr)			\
      SymX(int2Integerzh_fast)			\
sof's avatar
sof committed
394 395
      SymX(integer2Intzh_fast)			\
      SymX(integer2Wordzh_fast)			\
396
      SymX(isCurrentThreadBoundzh_fast)		\
397 398 399 400
      SymX(isDoubleDenormalized)		\
      SymX(isDoubleInfinite)			\
      SymX(isDoubleNaN)				\
      SymX(isDoubleNegativeZero)		\
sof's avatar
sof committed
401
      SymX(isEmptyMVarzh_fast)			\
402 403 404 405 406
      SymX(isFloatDenormalized)			\
      SymX(isFloatInfinite)			\
      SymX(isFloatNaN)				\
      SymX(isFloatNegativeZero)			\
      SymX(killThreadzh_fast)			\
sof's avatar
sof committed
407
      SymX(makeStablePtrzh_fast)		\
408 409
      SymX(minusIntegerzh_fast)			\
      SymX(mkApUpd0zh_fast)			\
sof's avatar
sof committed
410
      SymX(myThreadIdzh_fast)			\
411
      SymX(labelThreadzh_fast)                  \
412 413 414
      SymX(newArrayzh_fast)			\
      SymX(newBCOzh_fast)			\
      SymX(newByteArrayzh_fast)			\
415
      SymX_redirect(newCAF, newDynCAF)		\
416 417
      SymX(newMVarzh_fast)			\
      SymX(newMutVarzh_fast)			\
418
      SymX(atomicModifyMutVarzh_fast)		\
419 420 421
      SymX(newPinnedByteArrayzh_fast)		\
      SymX(orIntegerzh_fast)			\
      SymX(performGC)				\
422
      SymX(performMajorGC)			\
423 424 425 426 427 428 429
      SymX(plusIntegerzh_fast)			\
      SymX(prog_argc)				\
      SymX(prog_argv)				\
      SymX(putMVarzh_fast)			\
      SymX(quotIntegerzh_fast)			\
      SymX(quotRemIntegerzh_fast)		\
      SymX(raisezh_fast)			\
430
      SymX(raiseIOzh_fast)			\
431 432 433 434 435 436 437 438
      SymX(remIntegerzh_fast)			\
      SymX(resetNonBlockingFd)			\
      SymX(resumeThread)			\
      SymX(rts_apply)				\
      SymX(rts_checkSchedStatus)		\
      SymX(rts_eval)				\
      SymX(rts_evalIO)				\
      SymX(rts_evalLazyIO)			\
439
      SymX(rts_evalStableIO)			\
440 441 442 443 444 445 446 447
      SymX(rts_eval_)				\
      SymX(rts_getBool)				\
      SymX(rts_getChar)				\
      SymX(rts_getDouble)			\
      SymX(rts_getFloat)			\
      SymX(rts_getInt)				\
      SymX(rts_getInt32)			\
      SymX(rts_getPtr)				\
448
      SymX(rts_getFunPtr)			\
449
      SymX(rts_getStablePtr)			\
450
      SymX(rts_getThreadId)			\
451 452
      SymX(rts_getWord)				\
      SymX(rts_getWord32)			\
453
      SymX(rts_lock)				\
454 455 456 457 458 459 460 461 462 463
      SymX(rts_mkBool)				\
      SymX(rts_mkChar)				\
      SymX(rts_mkDouble)			\
      SymX(rts_mkFloat)				\
      SymX(rts_mkInt)				\
      SymX(rts_mkInt16)				\
      SymX(rts_mkInt32)				\
      SymX(rts_mkInt64)				\
      SymX(rts_mkInt8)				\
      SymX(rts_mkPtr)				\
464
      SymX(rts_mkFunPtr)			\
465 466 467 468 469 470 471
      SymX(rts_mkStablePtr)			\
      SymX(rts_mkString)			\
      SymX(rts_mkWord)				\
      SymX(rts_mkWord16)			\
      SymX(rts_mkWord32)			\
      SymX(rts_mkWord64)			\
      SymX(rts_mkWord8)				\
472
      SymX(rts_unlock)				\
473
      SymX(rtsSupportsBoundThreads)		\
474
      SymX(run_queue_hd)			\
475 476
      SymX(__hscore_get_saved_termios)		\
      SymX(__hscore_set_saved_termios)		\
477
      SymX(setProgArgv)				\
478 479
      SymX(startupHaskell)			\
      SymX(shutdownHaskell)			\
480 481 482 483
      SymX(shutdownHaskellAndExit)		\
      SymX(stable_ptr_table)			\
      SymX(stackOverflow)			\
      SymX(stg_CAF_BLACKHOLE_info)		\
484 485
      SymX(stg_BLACKHOLE_BQ_info)		\
      SymX(awakenBlockedQueue)			\
486 487 488 489 490 491
      SymX(stg_CHARLIKE_closure)		\
      SymX(stg_EMPTY_MVAR_info)			\
      SymX(stg_IND_STATIC_info)			\
      SymX(stg_INTLIKE_closure)			\
      SymX(stg_MUT_ARR_PTRS_FROZEN_info)	\
      SymX(stg_WEAK_info)                       \
492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520
      SymX(stg_ap_v_info)			\
      SymX(stg_ap_f_info)			\
      SymX(stg_ap_d_info)			\
      SymX(stg_ap_l_info)			\
      SymX(stg_ap_n_info)			\
      SymX(stg_ap_p_info)			\
      SymX(stg_ap_pv_info)			\
      SymX(stg_ap_pp_info)			\
      SymX(stg_ap_ppv_info)			\
      SymX(stg_ap_ppp_info)			\
      SymX(stg_ap_pppp_info)			\
      SymX(stg_ap_ppppp_info)			\
      SymX(stg_ap_pppppp_info)			\
      SymX(stg_ap_ppppppp_info)			\
      SymX(stg_ap_0_ret)			\
      SymX(stg_ap_v_ret)			\
      SymX(stg_ap_f_ret)			\
      SymX(stg_ap_d_ret)			\
      SymX(stg_ap_l_ret)			\
      SymX(stg_ap_n_ret)			\
      SymX(stg_ap_p_ret)			\
      SymX(stg_ap_pv_ret)			\
      SymX(stg_ap_pp_ret)			\
      SymX(stg_ap_ppv_ret)			\
      SymX(stg_ap_ppp_ret)			\
      SymX(stg_ap_pppp_ret)			\
      SymX(stg_ap_ppppp_ret)			\
      SymX(stg_ap_pppppp_ret)			\
      SymX(stg_ap_ppppppp_ret)			\
521
      SymX(stg_ap_1_upd_info)			\
522 523 524 525 526 527 528
      SymX(stg_ap_2_upd_info)			\
      SymX(stg_ap_3_upd_info)			\
      SymX(stg_ap_4_upd_info)			\
      SymX(stg_ap_5_upd_info)			\
      SymX(stg_ap_6_upd_info)			\
      SymX(stg_ap_7_upd_info)			\
      SymX(stg_ap_8_upd_info)			\
529
      SymX(stg_exit)				\
530
      SymX(stg_sel_0_upd_info)			\
531 532 533 534 535 536
      SymX(stg_sel_10_upd_info)			\
      SymX(stg_sel_11_upd_info)			\
      SymX(stg_sel_12_upd_info)			\
      SymX(stg_sel_13_upd_info)			\
      SymX(stg_sel_14_upd_info)			\
      SymX(stg_sel_15_upd_info)			\
537 538 539 540 541 542 543 544 545
      SymX(stg_sel_1_upd_info)			\
      SymX(stg_sel_2_upd_info)			\
      SymX(stg_sel_3_upd_info)			\
      SymX(stg_sel_4_upd_info)			\
      SymX(stg_sel_5_upd_info)			\
      SymX(stg_sel_6_upd_info)			\
      SymX(stg_sel_7_upd_info)			\
      SymX(stg_sel_8_upd_info)			\
      SymX(stg_sel_9_upd_info)			\
546 547
      SymX(stg_upd_frame_info)			\
      SymX(suspendThread)			\
548
      SymX(takeMVarzh_fast)			\
549
      SymX(timesIntegerzh_fast)			\
550
      SymX(tryPutMVarzh_fast)			\
551 552 553
      SymX(tryTakeMVarzh_fast)			\
      SymX(unblockAsyncExceptionszh_fast)	\
      SymX(unsafeThawArrayzh_fast)		\
554 555
      SymX(waitReadzh_fast)			\
      SymX(waitWritezh_fast)			\
556 557
      SymX(word2Integerzh_fast)			\
      SymX(xorIntegerzh_fast)			\
558
      SymX(yieldzh_fast)
559

560
#ifdef SUPPORT_LONG_LONGS
561
#define RTS_LONG_LONG_SYMS			\
562 563
      SymX(int64ToIntegerzh_fast)		\
      SymX(word64ToIntegerzh_fast)
564 565 566 567
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif

568 569 570
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
#define RTS_LIBGCC_SYMBOLS			\
571 572 573
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
574 575 576 577 578
      Sym(__umoddi3)				\
      Sym(__ashldi3)				\
      Sym(__ashrdi3)				\
      Sym(__lshrdi3)				\
      Sym(__eprintf)
579 580 581 582 583 584 585 586
#elif defined(ia64_TARGET_ARCH)
#define RTS_LIBGCC_SYMBOLS			\
      Sym(__divdi3)				\
      Sym(__udivdi3)                            \
      Sym(__moddi3)				\
      Sym(__umoddi3)				\
      Sym(__divsf3)				\
      Sym(__divdf3)
587 588 589 590
#else
#define RTS_LIBGCC_SYMBOLS
#endif

591
#ifdef darwin_TARGET_OS
592 593 594 595 596 597
      // Symbols that don't have a leading underscore
      // on Mac OS X. They have to receive special treatment,
      // see machoInitSymbolsWithoutUnderscore()
#define RTS_MACHO_NOUNDERLINE_SYMBOLS		\
      Sym(saveFP)				\
      Sym(restFP)
598
#endif
599 600

/* entirely bogus claims about types of these symbols */
601
#define Sym(vvv)  extern void vvv(void);
602
#define SymX(vvv) /**/
603
#define SymX_redirect(vvv,xxx) /**/
604
RTS_SYMBOLS
605
RTS_LONG_LONG_SYMS
606
RTS_POSIX_ONLY_SYMBOLS
607
RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
608
RTS_CYGWIN_ONLY_SYMBOLS
609
RTS_LIBGCC_SYMBOLS
610 611
#undef Sym
#undef SymX
612
#undef SymX_redirect
613 614 615 616 617 618 619 620 621 622 623

#ifdef LEADING_UNDERSCORE
#define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
#else
#define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
#endif

#define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
                    (void*)(&(vvv)) },
#define SymX(vvv) Sym(vvv)

624 625 626 627 628 629
// SymX_redirect allows us to redirect references to one symbol to
// another symbol.  See newCAF/newDynCAF for an example.
#define SymX_redirect(vvv,xxx) \
    { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
      (void*)(&(xxx)) },

630
static RtsSymbolVal rtsSyms[] = {
631
      RTS_SYMBOLS
632
      RTS_LONG_LONG_SYMS
633
      RTS_POSIX_ONLY_SYMBOLS
634
      RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
635
      RTS_CYGWIN_ONLY_SYMBOLS
636
      RTS_LIBGCC_SYMBOLS
637 638 639
      { 0, 0 } /* sentinel */
};

640 641 642 643 644
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
 */
static void ghciInsertStrHashTable ( char* obj_name,
                                     HashTable *table,
645
                                     char* key,
646 647 648 649 650 651 652 653
                                     void *data
				   )
{
   if (lookupHashTable(table, (StgWord)key) == NULL)
   {
      insertStrHashTable(table, (StgWord)key, data);
      return;
   }
654
   fprintf(stderr,
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673
      "\n\n"
      "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
      "   %s\n"
      "whilst processing object file\n"
      "   %s\n"
      "This could be caused by:\n"
      "   * Loading two different object files which export the same symbol\n"
      "   * Specifying the same object file twice on the GHCi command line\n"
      "   * An incorrect `package.conf' entry, causing some object to be\n"
      "     loaded twice.\n"
      "GHCi cannot safely continue in this situation.  Exiting now.  Sorry.\n"
      "\n",
      (char*)key,
      obj_name
   );
   exit(1);
}


674 675 676
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
677 678 679 680


static int linker_init_done = 0 ;

681
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
682
static void *dl_prog_handle;
683
#endif
684

dons's avatar
dons committed
685 686 687 688 689
/* dlopen(NULL,..) doesn't work so we grab libc explicitly */
#if defined(openbsd_TARGET_OS)
static void *dl_libc_handle;
#endif

690 691 692
void
initLinker( void )
{
693
    RtsSymbolVal *sym;
694

695 696 697 698 699 700 701
    /* Make initLinker idempotent, so we can call it
       before evey relevant operation; that means we
       don't need to initialise the linker separately */
    if (linker_init_done == 1) { return; } else {
      linker_init_done = 1;
    }

702 703 704 705
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
706 707
	ghciInsertStrHashTable("(GHCi built-in symbols)",
                               symhash, sym->lbl, sym->addr);
708
    }
709 710 711 712
#   if defined(OBJFORMAT_MACHO)
    machoInitSymbolsWithoutUnderscore();
#   endif

713
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
714
#   if defined(RTLD_DEFAULT)
715 716
    dl_prog_handle = RTLD_DEFAULT;
#   else
717
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
dons's avatar
dons committed
718 719 720
#   if defined(openbsd_TARGET_OS)
    dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
#   endif
721
#   endif // RTLD_DEFAULT
722
#   endif
723 724
}

725
/* -----------------------------------------------------------------------------
726 727 728
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
729 730 731 732
 * Add a DLL from which symbols may be found.  In the ELF case, just
 * do RTLD_GLOBAL-style add, so no further messing around needs to
 * happen in order that symbols in the loaded .so are findable --
 * lookupSymbol() will subsequently see them by dlsym on the program's
733 734
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
735
 * In the PEi386 case, open the DLLs and put handles to them in a
736
 * linked list.  When looking for a symbol, try all handles in the
737 738 739 740 741
 * list.  This means that we need to load even DLLs that are guaranteed
 * to be in the ghc.exe image already, just so we can get a handle
 * to give to loadSymbol, so that we can find the symbols.  For such
 * libraries, the LoadLibrary call should be a no-op except for returning
 * the handle.
742
 *
743
 */
744 745 746 747 748 749

#if defined(OBJFORMAT_PEi386)
/* A record for storing handles into DLLs. */

typedef
   struct _OpenedDLL {
750
      char*              name;
751 752
      struct _OpenedDLL* next;
      HINSTANCE instance;
753
   }
754 755 756 757 758 759
   OpenedDLL;

/* A list thereof. */
static OpenedDLL* opened_dlls = NULL;
#endif

760 761
char *
addDLL( char *dll_name )
762
{
763
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
764
   /* ------------------- ELF DLL loader ------------------- */
765
   void *hdl;
766
   char *errmsg;
767

768 769
   initLinker();

770
   hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
dons's avatar
dons committed
771

772 773 774 775 776 777 778 779
   if (hdl == NULL) {
      /* dlopen failed; return a ptr to the error msg. */
      errmsg = dlerror();
      if (errmsg == NULL) errmsg = "addDLL: unknown error";
      return errmsg;
   } else {
      return NULL;
   }
780 781
   /*NOTREACHED*/

782
#  elif defined(OBJFORMAT_PEi386)
783
   /* ------------------- Win32 DLL loader ------------------- */
784

785
   char*      buf;
786
   OpenedDLL* o_dll;
787
   HINSTANCE  instance;
788

789 790 791
   initLinker();

   /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
792 793 794 795 796

   /* See if we've already got it, and ignore if so. */
   for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
      if (0 == strcmp(o_dll->name, dll_name))
         return NULL;
797 798
   }

799 800 801 802 803 804 805 806 807 808
   /* The file name has no suffix (yet) so that we can try
      both foo.dll and foo.drv

      The documentation for LoadLibrary says:
      	If no file name extension is specified in the lpFileName
      	parameter, the default library extension .dll is
      	appended. However, the file name string can include a trailing
      	point character (.) to indicate that the module name has no
      	extension. */

809
   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
810 811 812
   sprintf(buf, "%s.DLL", dll_name);
   instance = LoadLibrary(buf);
   if (instance == NULL) {
813
	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
814 815
	 instance = LoadLibrary(buf);
	 if (instance == NULL) {
sof's avatar
sof committed
816
		stgFree(buf);
817 818 819 820

	    /* LoadLibrary failed; return a ptr to the error msg. */
	    return "addDLL: unknown error";
   	 }
821
   }
sof's avatar
sof committed
822
   stgFree(buf);
823

824
   /* Add this DLL to the list of DLLs in which to search for symbols. */
825
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
826 827
   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
   strcpy(o_dll->name, dll_name);
828
   o_dll->instance = instance;
829 830
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
831 832

   return NULL;
833 834 835 836 837
#  else
   barf("addDLL: not implemented on this platform");
#  endif
}

838 839
/* -----------------------------------------------------------------------------
 * lookup a symbol in the hash table
840
 */
841 842 843
void *
lookupSymbol( char *lbl )
{
844
    void *val;
845
    initLinker() ;
846
    ASSERT(symhash != NULL);
847 848 849
    val = lookupStrHashTable(symhash, lbl);

    if (val == NULL) {
850
#       if defined(OBJFORMAT_ELF)
dons's avatar
dons committed
851 852 853 854
#	if defined(openbsd_TARGET_OS)
	val = dlsym(dl_prog_handle, lbl);
	return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
#	else /* not openbsd */
855
	return dlsym(dl_prog_handle, lbl);
dons's avatar
dons committed
856
#	endif
857 858 859 860 861 862 863
#       elif defined(OBJFORMAT_MACHO)
	if(NSIsSymbolNameDefined(lbl)) {
	    NSSymbol symbol = NSLookupAndBindSymbol(lbl);
	    return NSAddressOfSymbol(symbol);
	} else {
	    return NULL;
	}
864
#       elif defined(OBJFORMAT_PEi386)
865 866 867
        OpenedDLL* o_dll;
        void* sym;
        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
sof's avatar
sof committed
868
	  /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
869 870 871 872 873 874 875
           if (lbl[0] == '_') {
              /* HACK: if the name has an initial underscore, try stripping
                 it off & look that up first. I've yet to verify whether there's
                 a Rule that governs whether an initial '_' *should always* be
                 stripped off when mapping from import lib name to the DLL name.
              */
              sym = GetProcAddress(o_dll->instance, (lbl+1));
sof's avatar
sof committed
876 877 878
              if (sym != NULL) {
		/*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
		return sym;
879
	      }
880
           }
881
           sym = GetProcAddress(o_dll->instance, lbl);
sof's avatar
sof committed
882 883 884 885
           if (sym != NULL) {
	     /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
	     return sym;
	   }
886
        }
887
        return NULL;
ken's avatar
ken committed
888 889 890
#       else
        ASSERT(2+2 == 5);
        return NULL;
891
#       endif
892
    } else {
893
	return val;
894 895 896
    }
}

897
static
898
__attribute((unused))
899 900 901
void *
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
902
    void *val;
903
    initLinker() ;
904 905 906 907 908
    val = lookupStrHashTable(oc->lochash, lbl);

    if (val == NULL) {
        return NULL;
    } else {
909
	return val;
910 911 912 913
    }
}


914 915 916 917 918 919 920 921 922 923 924 925 926 927
/* -----------------------------------------------------------------------------
 * Debugging aid: look in GHCi's object symbol tables for symbols
 * within DELTA bytes of the specified address, and show their names.
 */
#ifdef DEBUG
void ghci_enquire ( char* addr );

void ghci_enquire ( char* addr )
{
   int   i;
   char* sym;
   char* a;
   const int DELTA = 64;
   ObjectCode* oc;
928 929 930

   initLinker();

931 932 933 934
   for (oc = objects; oc; oc = oc->next) {
      for (i = 0; i < oc->n_symbols; i++) {
         sym = oc->symbols[i];
         if (sym == NULL) continue;
935
         // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
936
         a = NULL;
937
         if (oc->lochash != NULL) {
938
            a = lookupStrHashTable(oc->lochash, sym);
939 940
	 }
         if (a == NULL) {
941
            a = lookupStrHashTable(symhash, sym);
942
	 }
943
         if (a == NULL) {
944
	     // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
945
         }
946 947 948 949 950 951 952 953
         else if (addr-DELTA <= a && a <= addr+DELTA) {
            fprintf(stderr, "%p + %3d  ==  `%s'\n", addr, a - addr, sym);
         }
      }
   }
}
#endif

954 955 956
#ifdef ia64_TARGET_ARCH
static unsigned int PLTSize(void);
#endif
957

958 959 960 961 962 963 964 965 966 967 968
/* -----------------------------------------------------------------------------
 * Load an obj (populate the global symbol table, but don't resolve yet)
 *
 * Returns: 1 if ok, 0 on error.
 */
HsInt
loadObj( char *path )
{
   ObjectCode* oc;
   struct stat st;
   int r, n;
969 970
#ifdef USE_MMAP
   int fd, pagesize;
971
   void *map_addr = NULL;
972
#else
973
   FILE *f;
974
#endif
975

976 977
   initLinker();

978
   /* fprintf(stderr, "loadObj %s\n", path ); */
979 980 981

   /* Check that we haven't already loaded this object.  Don't give up
      at this stage; ocGetNames_* will barf later. */
982
   {
983
       ObjectCode *o;
984 985 986 987 988 989
       int is_dup = 0;
       for (o = objects; o; o = o->next) {
          if (0 == strcmp(o->fileName, path))
             is_dup = 1;
       }
       if (is_dup) {
990
	 fprintf(stderr,
991 992 993 994 995 996 997 998
            "\n\n"
            "GHCi runtime linker: warning: looks like you're trying to load the\n"
            "same object file twice:\n"
            "   %s\n"
            "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
            "\n"
            , path);
       }
999 1000 1001 1002
   }

   oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");

1003
#  if defined(OBJFORMAT_ELF)
1004
   oc->formatName = "ELF";
1005
#  elif defined(OBJFORMAT_PEi386)
1006
   oc->formatName = "PEi386";
1007 1008
#  elif defined(OBJFORMAT_MACHO)
   oc->formatName = "Mach-O";
1009
#  else
sof's avatar
sof committed
1010
   stgFree(oc);
1011 1012 1013 1014 1015 1016
   barf("loadObj: not implemented on this platform");
#  endif

   r = stat(path, &st);
   if (r == -1) { return 0; }

1017
   /* sigh, strdup() isn't a POSIX function, so do it the long way */
1018 1019 1020
   oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
   strcpy(oc->fileName, path);

1021 1022 1023
   oc->fileSize          = st.st_size;
   oc->symbols           = NULL;
   oc->sections          = NULL;
1024
   oc->lochash           = allocStrHashTable();
1025
   oc->proddables        = NULL;
1026 1027 1028 1029 1030

   /* chain it onto the list of objects */
   oc->next              = objects;
   objects               = oc;

1031 1032 1033 1034 1035
#ifdef USE_MMAP
#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))

   /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */

dons's avatar
dons committed
1036 1037 1038
#if defined(openbsd_TARGET_OS)
   fd = open(path, O_RDONLY, S_IRUSR);
#else
1039
   fd = open(path, O_RDONLY);
dons's avatar
dons committed
1040
#endif
1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067
   if (fd == -1)
      barf("loadObj: can't open `%s'", path);

   pagesize = getpagesize();

#ifdef ia64_TARGET_ARCH
   /* The PLT needs to be right before the object */
   n = ROUND_UP(PLTSize(), pagesize);
   oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
   if (oc->plt == MAP_FAILED)
      barf("loadObj: can't allocate PLT");

   oc->pltIndex = 0;
   map_addr = oc->plt + n;
#endif

   n = ROUND_UP(oc->fileSize, pagesize);
   oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
   if (oc->image == MAP_FAILED)
      barf("loadObj: can't map `%s'", path);

   close(fd);

#else /* !USE_MMAP */

   oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");

1068 1069
   /* load the image into memory */
   f = fopen(path, "rb");
1070
   if (!f)
1071
       barf("loadObj: can't read `%s'", path);
1072

1073
   n = fread ( oc->image, 1, oc->fileSize, f );
1074
   if (n != oc->fileSize)
1075
      barf("loadObj: error whilst reading `%s'", path);
1076 1077 1078 1079

   fclose(f);

#endif /* USE_MMAP */
1080

1081 1082 1083 1084 1085
#  if defined(OBJFORMAT_MACHO)
   r = ocAllocateJumpIslands_MachO ( oc );
   if (!r) { return r; }
#endif

1086
   /* verify the in-memory image */
1087
#  if defined(OBJFORMAT_ELF)
1088
   r = ocVerifyImage_ELF ( oc );
1089
#  elif defined(OBJFORMAT_PEi386)
1090
   r = ocVerifyImage_PEi386 ( oc );
1091 1092
#  elif defined(OBJFORMAT_MACHO)
   r = ocVerifyImage_MachO ( oc );
1093 1094 1095 1096 1097 1098
#  else
   barf("loadObj: no verify method");
#  endif
   if (!r) { return r; }

   /* build the symbol list for this image */
1099
#  if defined(OBJFORMAT_ELF)
1100
   r = ocGetNames_ELF ( oc );
1101
#  elif defined(OBJFORMAT_PEi386)
1102
   r = ocGetNames_PEi386 ( oc );
1103 1104
#  elif defined(OBJFORMAT_MACHO)
   r = ocGetNames_MachO ( oc );
1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120
#  else
   barf("loadObj: no getNames method");
#  endif
   if (!r) { return r; }

   /* loaded, but not resolved yet */
   oc->status = OBJECT_LOADED;

   return 1;
}

/* -----------------------------------------------------------------------------
 * resolve all the currently unlinked objects in memory
 *
 * Returns: 1 if ok, 0 on error.
 */
1121
HsInt
1122 1123 1124 1125 1126
resolveObjs( void )
{
    ObjectCode *oc;
    int r;

1127 1128
    initLinker();

1129 1130
    for (oc = objects; oc; oc = oc->next) {
	if (oc->status != OBJECT_RESOLVED) {
1131
#           if defined(OBJFORMAT_ELF)
1132
	    r = ocResolve_ELF ( oc );
1133
#           elif defined(OBJFORMAT_PEi386)
1134
	    r = ocResolve_PEi386 ( oc );
1135 1136
#           elif defined(OBJFORMAT_MACHO)
	    r = ocResolve_MachO ( oc );
1137
#           else
1138
	    barf("resolveObjs: not implemented on this platform");
1139
#           endif
1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152
	    if (!r) { return r; }
	    oc->status = OBJECT_RESOLVED;
	}
    }
    return 1;
}

/* -----------------------------------------------------------------------------
 * delete an object from the pool
 */
HsInt
unloadObj( char *path )
{
1153
    ObjectCode *oc, *prev;
1154

1155 1156 1157
    ASSERT(symhash != NULL