Linker.c 107 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 * $Id: Linker.c,v 1.136 2003/10/08 09:42:34 wolfgang Exp $
3
 *
4
 * (c) The GHC Team, 2000-2003
5 6 7 8 9
 *
 * RTS Object Linker
 *
 * ---------------------------------------------------------------------------*/

sof's avatar
sof committed
10
#if 0
11
#include "PosixSource.h"
sof's avatar
sof committed
12
#endif
13 14 15 16 17
#include "Rts.h"
#include "RtsFlags.h"
#include "HsFFI.h"
#include "Hash.h"
#include "Linker.h"
18
#include "LinkerInternals.h"
19
#include "RtsUtils.h"
20
#include "StoragePriv.h"
21
#include "Schedule.h"
22

23
#ifdef HAVE_SYS_TYPES_H
24
#include <sys/types.h>
25 26
#endif

27 28 29
#include <stdlib.h>
#include <string.h>

30
#ifdef HAVE_SYS_STAT_H
31
#include <sys/stat.h>
32
#endif
33

34 35 36
#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
#include <HaskellSupport/dlfcn.h>
#elif defined(HAVE_DLFCN_H)
37
#include <dlfcn.h>
38
#endif
39

sof's avatar
sof committed
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
#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

56 57 58 59 60 61
#if defined(ia64_TARGET_ARCH)
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
#endif

dons's avatar
dons committed
62
#if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS) || defined(netbsd_TARGET_OS) || defined(openbsd_TARGET_OS)
63
#  define OBJFORMAT_ELF
64
#elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
65
#  define OBJFORMAT_PEi386
66
#  include <windows.h>
sof's avatar
sof committed
67
#  include <math.h>
68
#elif defined(darwin_TARGET_OS)
69
#  include <mach-o/ppc/reloc.h>
70 71 72 73
#  define OBJFORMAT_MACHO
#  include <mach-o/loader.h>
#  include <mach-o/nlist.h>
#  include <mach-o/reloc.h>
74
#  include <mach-o/dyld.h>
75 76
#endif

77
/* Hash table mapping symbol names to Symbol */
78
static /*Str*/HashTable *symhash;
79

80 81 82
/* List of currently loaded objects */
ObjectCode *objects = NULL;	/* initially empty */

83
#if defined(OBJFORMAT_ELF)
84 85 86
static int ocVerifyImage_ELF    ( ObjectCode* oc );
static int ocGetNames_ELF       ( ObjectCode* oc );
static int ocResolve_ELF        ( ObjectCode* oc );
87
#elif defined(OBJFORMAT_PEi386)
88 89 90
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386    ( ObjectCode* oc );
static int ocResolve_PEi386     ( ObjectCode* oc );
91
#elif defined(OBJFORMAT_MACHO)
92
static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
93 94 95
static int ocVerifyImage_MachO    ( ObjectCode* oc );
static int ocGetNames_MachO       ( ObjectCode* oc );
static int ocResolve_MachO        ( ObjectCode* oc );
96

97
static void machoInitSymbolsWithoutUnderscore( void );
98 99 100 101 102 103
#endif

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

104 105 106 107 108 109
typedef struct _RtsSymbolVal {
    char   *lbl;
    void   *addr;
} RtsSymbolVal;


110 111 112 113 114 115 116 117 118 119 120
#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
121 122

#if !defined (mingw32_TARGET_OS)
123
#define RTS_POSIX_ONLY_SYMBOLS                  \
124 125
      SymX(stg_sig_install)			\
      Sym(nocldstop)
sof's avatar
sof committed
126
#endif
127

sof's avatar
sof committed
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 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
#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
 * exports; sigh. 
 */
#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)                               \
210
      SymX(waitpid)
211

sof's avatar
sof committed
212 213 214 215 216 217
#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 /**/
218

219 220 221 222 223 224 225 226 227
/* Extra syms gen'ed by mingw-2's gcc-3.2: */
#if __GNUC__>=3
#define RTS_MINGW_EXTRA_SYMS                    \
      Sym(_imp____mb_cur_max)                   \
      Sym(_imp___pctype)            
#else
#define RTS_MINGW_EXTRA_SYMS
#endif

228 229
/* These are statically linked from the mingw libraries into the ghc
   executable, so we have to employ this hack. */
230
#define RTS_MINGW_ONLY_SYMBOLS                  \
sof's avatar
sof committed
231 232
      SymX(asyncReadzh_fast)			\
      SymX(asyncWritezh_fast)			\
233
      SymX(memset)                              \
234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
      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)                              \
266 267 268
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
269 270 271 272 273 274 275 276 277 278 279 280 281 282
      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)                              \
283
      Sym(mktime)                               \
284
      Sym(_imp___timezone)                      \
285
      Sym(_imp___tzname)                        \
286
      Sym(_imp___iob)                           \
287 288 289 290
      Sym(localtime)                            \
      Sym(gmtime)                               \
      Sym(opendir)                              \
      Sym(readdir)                              \
sof's avatar
sof committed
291
      Sym(rewinddir)                            \
292
      RTS_MINGW_EXTRA_SYMS                      \
293
      Sym(closedir)
294
#endif
295

sof's avatar
sof committed
296 297 298 299 300
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
301

302
#define RTS_SYMBOLS				\
303 304 305
      Maybe_ForeignObj				\
      Maybe_Stable_Names			\
      Sym(StgReturn)				\
306 307 308
      SymX(stg_enter_info)			\
      SymX(stg_enter_ret)			\
      SymX(stg_gc_void_info)			\
309 310
      SymX(__stg_gc_enter_1)			\
      SymX(stg_gc_noregs)			\
311
      SymX(stg_gc_unpt_r1_info)			\
312
      SymX(stg_gc_unpt_r1)			\
313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329
      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)			\
330
      SymX(stg_yield_to_interpreter)		\
331 332 333 334 335 336
      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)			\
337
      SymX(ErrorHdrHook)			\
sof's avatar
sof committed
338
      MAIN_CAP_SYM                              \
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
      SymX(MallocFailHook)			\
      SymX(OnExitHook)				\
      SymX(OutOfHeapHook)			\
      SymX(PatErrorHdrHook)			\
      SymX(PostTraceHook)			\
      SymX(PreTraceHook)			\
      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)			\
      SymX(blockAsyncExceptionszh_fast)		\
      SymX(catchzh_fast)			\
      SymX(cmp_thread)				\
      SymX(complementIntegerzh_fast)		\
sof's avatar
sof committed
361 362
      SymX(cmpIntegerzh_fast)	        	\
      SymX(cmpIntegerIntzh_fast)	      	\
363 364 365 366 367
      SymX(createAdjustor)			\
      SymX(decodeDoublezh_fast)			\
      SymX(decodeFloatzh_fast)			\
      SymX(defaultsHook)			\
      SymX(delayzh_fast)			\
sof's avatar
sof committed
368 369
      SymX(deRefWeakzh_fast)			\
      SymX(deRefStablePtrzh_fast)		\
370 371 372
      SymX(divExactIntegerzh_fast)		\
      SymX(divModIntegerzh_fast)		\
      SymX(forkzh_fast)				\
373
      SymX(forkProcess)				\
374
      SymX(forkOS_createThread)			\
375
      SymX(freeHaskellFunctionPtr)		\
sof's avatar
sof committed
376
      SymX(freeStablePtr)		        \
377
      SymX(gcdIntegerzh_fast)			\
sof's avatar
sof committed
378 379
      SymX(gcdIntegerIntzh_fast)		\
      SymX(gcdIntzh_fast)			\
380
      SymX(genSymZh)				\
381 382 383
      SymX(getProgArgv)				\
      SymX(getStablePtr)			\
      SymX(int2Integerzh_fast)			\
sof's avatar
sof committed
384 385
      SymX(integer2Intzh_fast)			\
      SymX(integer2Wordzh_fast)			\
386
      SymX(isCurrentThreadBoundzh_fast)		\
387 388 389 390
      SymX(isDoubleDenormalized)		\
      SymX(isDoubleInfinite)			\
      SymX(isDoubleNaN)				\
      SymX(isDoubleNegativeZero)		\
sof's avatar
sof committed
391
      SymX(isEmptyMVarzh_fast)			\
392 393 394 395 396
      SymX(isFloatDenormalized)			\
      SymX(isFloatInfinite)			\
      SymX(isFloatNaN)				\
      SymX(isFloatNegativeZero)			\
      SymX(killThreadzh_fast)			\
sof's avatar
sof committed
397
      SymX(makeStablePtrzh_fast)		\
398 399
      SymX(minusIntegerzh_fast)			\
      SymX(mkApUpd0zh_fast)			\
sof's avatar
sof committed
400
      SymX(myThreadIdzh_fast)			\
401
      SymX(labelThreadzh_fast)                  \
402 403 404
      SymX(newArrayzh_fast)			\
      SymX(newBCOzh_fast)			\
      SymX(newByteArrayzh_fast)			\
405
      SymX_redirect(newCAF, newDynCAF)		\
406 407
      SymX(newMVarzh_fast)			\
      SymX(newMutVarzh_fast)			\
408
      SymX(atomicModifyMutVarzh_fast)		\
409 410 411 412 413 414 415 416 417 418
      SymX(newPinnedByteArrayzh_fast)		\
      SymX(orIntegerzh_fast)			\
      SymX(performGC)				\
      SymX(plusIntegerzh_fast)			\
      SymX(prog_argc)				\
      SymX(prog_argv)				\
      SymX(putMVarzh_fast)			\
      SymX(quotIntegerzh_fast)			\
      SymX(quotRemIntegerzh_fast)		\
      SymX(raisezh_fast)			\
419
      SymX(raiseIOzh_fast)			\
420 421 422 423 424 425 426 427
      SymX(remIntegerzh_fast)			\
      SymX(resetNonBlockingFd)			\
      SymX(resumeThread)			\
      SymX(rts_apply)				\
      SymX(rts_checkSchedStatus)		\
      SymX(rts_eval)				\
      SymX(rts_evalIO)				\
      SymX(rts_evalLazyIO)			\
428
      SymX(rts_evalStableIO)			\
429 430 431 432 433 434 435 436
      SymX(rts_eval_)				\
      SymX(rts_getBool)				\
      SymX(rts_getChar)				\
      SymX(rts_getDouble)			\
      SymX(rts_getFloat)			\
      SymX(rts_getInt)				\
      SymX(rts_getInt32)			\
      SymX(rts_getPtr)				\
437
      SymX(rts_getFunPtr)			\
438
      SymX(rts_getStablePtr)			\
439
      SymX(rts_getThreadId)			\
440 441
      SymX(rts_getWord)				\
      SymX(rts_getWord32)			\
442
      SymX(rts_lock)				\
443 444 445 446 447 448 449 450 451 452
      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)				\
453
      SymX(rts_mkFunPtr)			\
454 455 456 457 458 459 460
      SymX(rts_mkStablePtr)			\
      SymX(rts_mkString)			\
      SymX(rts_mkWord)				\
      SymX(rts_mkWord16)			\
      SymX(rts_mkWord32)			\
      SymX(rts_mkWord64)			\
      SymX(rts_mkWord8)				\
461
      SymX(rts_unlock)				\
462
      SymX(rtsSupportsBoundThreads)		\
463
      SymX(run_queue_hd)			\
464 465
      SymX(__hscore_get_saved_termios)		\
      SymX(__hscore_set_saved_termios)		\
466
      SymX(setProgArgv)				\
467 468
      SymX(startupHaskell)			\
      SymX(shutdownHaskell)			\
469 470 471 472
      SymX(shutdownHaskellAndExit)		\
      SymX(stable_ptr_table)			\
      SymX(stackOverflow)			\
      SymX(stg_CAF_BLACKHOLE_info)		\
473 474
      SymX(stg_BLACKHOLE_BQ_info)		\
      SymX(awakenBlockedQueue)			\
475 476 477 478 479 480
      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)                       \
481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509
      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)			\
510
      SymX(stg_ap_1_upd_info)			\
511 512 513 514 515 516 517
      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)			\
518
      SymX(stg_exit)				\
519
      SymX(stg_sel_0_upd_info)			\
520 521 522 523 524 525
      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)			\
526 527 528 529 530 531 532 533 534
      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)			\
535 536
      SymX(stg_upd_frame_info)			\
      SymX(suspendThread)			\
537
      SymX(takeMVarzh_fast)			\
538
      SymX(timesIntegerzh_fast)			\
539
      SymX(tryPutMVarzh_fast)			\
540 541 542
      SymX(tryTakeMVarzh_fast)			\
      SymX(unblockAsyncExceptionszh_fast)	\
      SymX(unsafeThawArrayzh_fast)		\
543 544
      SymX(waitReadzh_fast)			\
      SymX(waitWritezh_fast)			\
545 546
      SymX(word2Integerzh_fast)			\
      SymX(xorIntegerzh_fast)			\
547
      SymX(yieldzh_fast)
548

549
#ifdef SUPPORT_LONG_LONGS
550
#define RTS_LONG_LONG_SYMS			\
551 552
      SymX(int64ToIntegerzh_fast)		\
      SymX(word64ToIntegerzh_fast)
553 554 555 556
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif

557 558 559
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
#define RTS_LIBGCC_SYMBOLS			\
560 561 562
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
563 564 565 566 567
      Sym(__umoddi3)				\
      Sym(__ashldi3)				\
      Sym(__ashrdi3)				\
      Sym(__lshrdi3)				\
      Sym(__eprintf)
568 569 570 571 572 573 574 575
#elif defined(ia64_TARGET_ARCH)
#define RTS_LIBGCC_SYMBOLS			\
      Sym(__divdi3)				\
      Sym(__udivdi3)                            \
      Sym(__moddi3)				\
      Sym(__umoddi3)				\
      Sym(__divsf3)				\
      Sym(__divdf3)
576 577 578 579
#else
#define RTS_LIBGCC_SYMBOLS
#endif

580
#ifdef darwin_TARGET_OS
581 582 583 584 585 586
      // 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)
587
#endif
588 589

/* entirely bogus claims about types of these symbols */
590
#define Sym(vvv)  extern void vvv(void);
591
#define SymX(vvv) /**/
592
#define SymX_redirect(vvv,xxx) /**/
593
RTS_SYMBOLS
594
RTS_LONG_LONG_SYMS
595
RTS_POSIX_ONLY_SYMBOLS
596
RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
597
RTS_CYGWIN_ONLY_SYMBOLS
598
RTS_LIBGCC_SYMBOLS
599 600
#undef Sym
#undef SymX
601
#undef SymX_redirect
602 603 604 605 606 607 608 609 610 611 612

#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)

613 614 615 616 617 618
// 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)) },

619
static RtsSymbolVal rtsSyms[] = {
620
      RTS_SYMBOLS
621
      RTS_LONG_LONG_SYMS
622
      RTS_POSIX_ONLY_SYMBOLS
623
      RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
624
      RTS_CYGWIN_ONLY_SYMBOLS
625
      RTS_LIBGCC_SYMBOLS
626 627 628
      { 0, 0 } /* sentinel */
};

629 630 631 632 633
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
 */
static void ghciInsertStrHashTable ( char* obj_name,
                                     HashTable *table,
634
                                     char* key,
635 636 637 638 639 640 641 642
                                     void *data
				   )
{
   if (lookupHashTable(table, (StgWord)key) == NULL)
   {
      insertStrHashTable(table, (StgWord)key, data);
      return;
   }
643
   fprintf(stderr,
644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662
      "\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);
}


663 664 665
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
666 667 668 669


static int linker_init_done = 0 ;

670
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
671
static void *dl_prog_handle;
672
#endif
673 674 675 676

void
initLinker( void )
{
677
    RtsSymbolVal *sym;
678

679 680 681 682 683 684 685
    /* 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;
    }

686 687 688 689
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
690 691
	ghciInsertStrHashTable("(GHCi built-in symbols)",
                               symhash, sym->lbl, sym->addr);
692
    }
693 694 695 696
#   if defined(OBJFORMAT_MACHO)
    machoInitSymbolsWithoutUnderscore();
#   endif

697
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
698
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
699
#   endif
700 701
}

702
/* -----------------------------------------------------------------------------
703 704 705
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
706 707 708 709
 * 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
710 711
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
712
 * In the PEi386 case, open the DLLs and put handles to them in a
713
 * linked list.  When looking for a symbol, try all handles in the
714 715 716 717 718 719
 * 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.
 * 
720
 */
721 722 723 724 725 726

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

typedef
   struct _OpenedDLL {
727
      char*              name;
728 729
      struct _OpenedDLL* next;
      HINSTANCE instance;
730
   }
731 732 733 734 735 736
   OpenedDLL;

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

737 738
char *
addDLL( char *dll_name )
739
{
740
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
741
   /* ------------------- ELF DLL loader ------------------- */
742
   void *hdl;
743
   char *errmsg;
744

745 746
   initLinker();

dons's avatar
dons committed
747
#if !defined(openbsd_TARGET_OS)
748
   hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
dons's avatar
dons committed
749 750 751
#else
   hdl= dlopen(dll_name, RTLD_LAZY);
#endif
752 753 754 755 756 757 758 759
   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;
   }
760 761
   /*NOTREACHED*/

762
#  elif defined(OBJFORMAT_PEi386)
763
   /* ------------------- Win32 DLL loader ------------------- */
764

765
   char*      buf;
766
   OpenedDLL* o_dll;
767
   HINSTANCE  instance;
768

769 770 771
   initLinker();

   /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
772 773 774 775 776

   /* 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;
777 778
   }

779 780 781 782 783 784 785 786 787 788
   /* 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. */

789
   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
790 791 792
   sprintf(buf, "%s.DLL", dll_name);
   instance = LoadLibrary(buf);
   if (instance == NULL) {
793
	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
794 795
	 instance = LoadLibrary(buf);
	 if (instance == NULL) {
sof's avatar
sof committed
796
		stgFree(buf);
797 798 799 800

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

804
   /* Add this DLL to the list of DLLs in which to search for symbols. */
805
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
806 807
   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
   strcpy(o_dll->name, dll_name);
808
   o_dll->instance = instance;
809 810
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
811 812

   return NULL;
813 814 815 816 817
#  else
   barf("addDLL: not implemented on this platform");
#  endif
}

818 819
/* -----------------------------------------------------------------------------
 * lookup a symbol in the hash table
820
 */
821 822 823
void *
lookupSymbol( char *lbl )
{
824
    void *val;
825
    initLinker() ;
826
    ASSERT(symhash != NULL);
827 828 829
    val = lookupStrHashTable(symhash, lbl);

    if (val == NULL) {
830
#       if defined(OBJFORMAT_ELF)
831
	return dlsym(dl_prog_handle, lbl);
832 833 834 835 836 837 838
#       elif defined(OBJFORMAT_MACHO)
	if(NSIsSymbolNameDefined(lbl)) {
	    NSSymbol symbol = NSLookupAndBindSymbol(lbl);
	    return NSAddressOfSymbol(symbol);
	} else {
	    return NULL;
	}
839
#       elif defined(OBJFORMAT_PEi386)
840 841 842
        OpenedDLL* o_dll;
        void* sym;
        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
sof's avatar
sof committed
843
	  /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
844 845 846 847 848 849 850
           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
851 852 853
              if (sym != NULL) {
		/*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
		return sym;
854
	      }
855
           }
856
           sym = GetProcAddress(o_dll->instance, lbl);
sof's avatar
sof committed
857 858 859 860
           if (sym != NULL) {
	     /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
	     return sym;
	   }
861
        }
862
        return NULL;
ken's avatar
ken committed
863 864 865
#       else
        ASSERT(2+2 == 5);
        return NULL;
866
#       endif
867
    } else {
868
	return val;
869 870 871
    }
}

872
static
873
__attribute((unused))
874 875 876
void *
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
877
    void *val;
878
    initLinker() ;
879 880 881 882 883
    val = lookupStrHashTable(oc->lochash, lbl);

    if (val == NULL) {
        return NULL;
    } else {
884
	return val;
885 886 887 888
    }
}


889 890 891 892 893 894 895 896 897 898 899 900 901 902
/* -----------------------------------------------------------------------------
 * 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;
903 904 905

   initLinker();

906 907 908 909
   for (oc = objects; oc; oc = oc->next) {
      for (i = 0; i < oc->n_symbols; i++) {
         sym = oc->symbols[i];
         if (sym == NULL) continue;
910
         // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
911
         a = NULL;
912
         if (oc->lochash != NULL) {
913
            a = lookupStrHashTable(oc->lochash, sym);
914 915
	 }
         if (a == NULL) {
916
            a = lookupStrHashTable(symhash, sym);
917
	 }
918
         if (a == NULL) {
919
	     // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
920
         }
921 922 923 924 925 926 927 928
         else if (addr-DELTA <= a && a <= addr+DELTA) {
            fprintf(stderr, "%p + %3d  ==  `%s'\n", addr, a - addr, sym);
         }
      }
   }
}
#endif

929 930 931
#ifdef ia64_TARGET_ARCH
static unsigned int PLTSize(void);
#endif
932

933 934 935 936 937 938 939 940 941 942 943
/* -----------------------------------------------------------------------------
 * 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;
944 945 946 947
#ifdef USE_MMAP
   int fd, pagesize;
   void *map_addr;
#else
948
   FILE *f;
949
#endif
950

951 952
   initLinker();

953
   /* fprintf(stderr, "loadObj %s\n", path ); */
954 955 956

   /* Check that we haven't already loaded this object.  Don't give up
      at this stage; ocGetNames_* will barf later. */
957
   {
958
       ObjectCode *o;
959 960 961 962 963 964
       int is_dup = 0;
       for (o = objects; o; o = o->next) {
          if (0 == strcmp(o->fileName, path))
             is_dup = 1;
       }
       if (is_dup) {
965
	 fprintf(stderr,
966 967 968 969 970 971 972 973
            "\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);
       }
974 975 976 977
   }

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

978
#  if defined(OBJFORMAT_ELF)
979
   oc->formatName = "ELF";
980
#  elif defined(OBJFORMAT_PEi386)
981
   oc->formatName = "PEi386";
982 983
#  elif defined(OBJFORMAT_MACHO)
   oc->formatName = "Mach-O";
984
#  else
sof's avatar
sof committed
985
   stgFree(oc);
986 987 988 989 990 991
   barf("loadObj: not implemented on this platform");
#  endif

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

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

996 997 998
   oc->fileSize          = st.st_size;
   oc->symbols           = NULL;
   oc->sections          = NULL;
999
   oc->lochash           = allocStrHashTable();
1000
   oc->proddables        = NULL;
1001 1002 1003 1004 1005

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

1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038
#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. */

   fd = open(path, O_RDONLY);
   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)");

1039 1040
   /* load the image into memory */
   f = fopen(path, "rb");
1041
   if (!f)
1042
       barf("loadObj: can't read `%s'", path);
1043

1044
   n = fread ( oc->image, 1, oc->fileSize, f );
1045
   if (n != oc->fileSize)
1046
      barf("loadObj: error whilst reading `%s'", path);
1047 1048 1049 1050

   fclose(f);

#endif /* USE_MMAP */
1051

1052 1053 1054 1055 1056
#  if defined(OBJFORMAT_MACHO)
   r = ocAllocateJumpIslands_MachO ( oc );
   if (!r) { return r; }
#endif

1057
   /* verify the in-memory image */
1058
#  if defined(OBJFORMAT_ELF)
1059
   r = ocVerifyImage_ELF ( oc );
1060
#  elif defined(OBJFORMAT_PEi386)
1061
   r = ocVerifyImage_PEi386 ( oc );
1062 1063
#  elif defined(OBJFORMAT_MACHO)
   r = ocVerifyImage_MachO ( oc );
1064 1065 1066 1067 1068 1069
#  else
   barf("loadObj: no verify method");
#  endif
   if (!r) { return r; }

   /* build the symbol list for this image */
1070
#  if defined(OBJFORMAT_ELF)
1071
   r = ocGetNames_ELF ( oc );
1072
#  elif defined(OBJFORMAT_PEi386)
1073
   r = ocGetNames_PEi386 ( oc );
1074