Linker.c 119 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 "Schedule.h"
26
#include "Storage.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
100
101
#if defined(powerpc_TARGET_ARCH)
static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
#endif
102
#elif defined(OBJFORMAT_PEi386)
103
104
105
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386    ( ObjectCode* oc );
static int ocResolve_PEi386     ( ObjectCode* oc );
106
#elif defined(OBJFORMAT_MACHO)
107
static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
108
109
110
static int ocVerifyImage_MachO    ( ObjectCode* oc );
static int ocGetNames_MachO       ( ObjectCode* oc );
static int ocResolve_MachO        ( ObjectCode* oc );
111

112
static void machoInitSymbolsWithoutUnderscore( void );
113
114
115
116
117
118
#endif

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

119
120
121
122
123
124
typedef struct _RtsSymbolVal {
    char   *lbl;
    void   *addr;
} RtsSymbolVal;


125
126
127
128
129
130
131
132
133
134
135
#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
136
137

#if !defined (mingw32_TARGET_OS)
138
#define RTS_POSIX_ONLY_SYMBOLS                  \
139
140
      SymX(stg_sig_install)			\
      Sym(nocldstop)
sof's avatar
sof committed
141
#endif
142

sof's avatar
sof committed
143
144
145
146
#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
147
 * exports; sigh.
sof's avatar
sof committed
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
222
223
224
 */
#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)                               \
225
      SymX(waitpid)
226

sof's avatar
sof committed
227
228
229
230
231
232
#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 /**/
233

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

243
244
/* These are statically linked from the mingw libraries into the ghc
   executable, so we have to employ this hack. */
245
#define RTS_MINGW_ONLY_SYMBOLS                  \
sof's avatar
sof committed
246
247
      SymX(asyncReadzh_fast)			\
      SymX(asyncWritezh_fast)			\
sof's avatar
sof committed
248
      SymX(asyncDoProczh_fast)			\
249
      SymX(memset)                              \
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
279
280
281
      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)                              \
282
283
284
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
285
286
287
288
289
290
291
292
293
294
295
296
297
298
      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)                              \
299
      SymX(stg_InstallConsoleEvent)             \
300
      Sym(mktime)                               \
301
      Sym(_imp___timezone)                      \
302
      Sym(_imp___tzname)                        \
303
      Sym(_imp___iob)                           \
304
305
306
307
      Sym(localtime)                            \
      Sym(gmtime)                               \
      Sym(opendir)                              \
      Sym(readdir)                              \
sof's avatar
sof committed
308
      Sym(rewinddir)                            \
309
      RTS_MINGW_EXTRA_SYMS                      \
310
      Sym(closedir)
311
#endif
312

sof's avatar
sof committed
313
314
315
316
317
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
318

319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
#ifdef TABLES_NEXT_TO_CODE
#define RTS_RET_SYMBOLS /* nothing */
#else
#define RTS_RET_SYMBOLS 			\
      SymX(stg_enter_ret)			\
      SymX(stg_gc_fun_ret)			\
      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_pppv_ret)			\
      SymX(stg_ap_pppp_ret)			\
      SymX(stg_ap_ppppp_ret)			\
      SymX(stg_ap_pppppp_ret)
#endif

342
#define RTS_SYMBOLS				\
343
344
345
      Maybe_ForeignObj				\
      Maybe_Stable_Names			\
      Sym(StgReturn)				\
346
347
      SymX(stg_enter_info)			\
      SymX(stg_gc_void_info)			\
348
349
      SymX(__stg_gc_enter_1)			\
      SymX(stg_gc_noregs)			\
350
      SymX(stg_gc_unpt_r1_info)			\
351
      SymX(stg_gc_unpt_r1)			\
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
      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_gen)				\
      SymX(stg_gc_gen_info)			\
      SymX(stg_gc_gen_hp)			\
      SymX(stg_gc_ut)				\
      SymX(stg_gen_yield)			\
      SymX(stg_yield_noregs)			\
368
      SymX(stg_yield_to_interpreter)		\
369
370
371
372
373
374
      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
375
      MAIN_CAP_SYM                              \
376
377
378
379
380
381
      SymX(MallocFailHook)			\
      SymX(OnExitHook)				\
      SymX(OutOfHeapHook)			\
      SymX(StackOverflowHook)			\
      SymX(__encodeDouble)			\
      SymX(__encodeFloat)			\
dons's avatar
dons committed
382
      SymX(addDLL)               		\
383
384
385
386
387
388
389
390
391
      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)			\
392
      SymX(atomicallyzh_fast)			\
393
      SymX(barf)				\
394
395
      SymX(blockAsyncExceptionszh_fast)		\
      SymX(catchzh_fast)			\
396
397
      SymX(catchRetryzh_fast)			\
      SymX(catchSTMzh_fast)			\
sof's avatar
sof committed
398
      SymX(closure_flags)                       \
399
      SymX(cmp_thread)				\
sof's avatar
sof committed
400
401
      SymX(cmpIntegerzh_fast)	        	\
      SymX(cmpIntegerIntzh_fast)	      	\
sof's avatar
sof committed
402
      SymX(complementIntegerzh_fast)		\
403
404
405
406
407
      SymX(createAdjustor)			\
      SymX(decodeDoublezh_fast)			\
      SymX(decodeFloatzh_fast)			\
      SymX(defaultsHook)			\
      SymX(delayzh_fast)			\
sof's avatar
sof committed
408
409
      SymX(deRefWeakzh_fast)			\
      SymX(deRefStablePtrzh_fast)		\
410
411
412
      SymX(divExactIntegerzh_fast)		\
      SymX(divModIntegerzh_fast)		\
      SymX(forkzh_fast)				\
413
      SymX(forkProcess)				\
414
      SymX(forkOS_createThread)			\
415
      SymX(freeHaskellFunctionPtr)		\
sof's avatar
sof committed
416
      SymX(freeStablePtr)		        \
417
      SymX(gcdIntegerzh_fast)			\
sof's avatar
sof committed
418
419
      SymX(gcdIntegerIntzh_fast)		\
      SymX(gcdIntzh_fast)			\
420
      SymX(genSymZh)				\
dons's avatar
dons committed
421
      SymX(genericRaise)			\
422
423
      SymX(getProgArgv)				\
      SymX(getStablePtr)			\
dons's avatar
dons committed
424
      SymX(initLinker)  			\
425
      SymX(int2Integerzh_fast)			\
sof's avatar
sof committed
426
427
      SymX(integer2Intzh_fast)			\
      SymX(integer2Wordzh_fast)			\
428
      SymX(isCurrentThreadBoundzh_fast)		\
429
430
431
432
      SymX(isDoubleDenormalized)		\
      SymX(isDoubleInfinite)			\
      SymX(isDoubleNaN)				\
      SymX(isDoubleNegativeZero)		\
sof's avatar
sof committed
433
      SymX(isEmptyMVarzh_fast)			\
434
435
436
437
438
      SymX(isFloatDenormalized)			\
      SymX(isFloatInfinite)			\
      SymX(isFloatNaN)				\
      SymX(isFloatNegativeZero)			\
      SymX(killThreadzh_fast)			\
dons's avatar
dons committed
439
440
      SymX(loadObj)          			\
      SymX(lookupSymbol)     			\
sof's avatar
sof committed
441
      SymX(makeStablePtrzh_fast)		\
442
443
      SymX(minusIntegerzh_fast)			\
      SymX(mkApUpd0zh_fast)			\
sof's avatar
sof committed
444
      SymX(myThreadIdzh_fast)			\
445
      SymX(labelThreadzh_fast)                  \
446
447
448
      SymX(newArrayzh_fast)			\
      SymX(newBCOzh_fast)			\
      SymX(newByteArrayzh_fast)			\
449
      SymX_redirect(newCAF, newDynCAF)		\
450
451
      SymX(newMVarzh_fast)			\
      SymX(newMutVarzh_fast)			\
452
      SymX(newTVarzh_fast)			\
453
      SymX(atomicModifyMutVarzh_fast)		\
454
455
456
      SymX(newPinnedByteArrayzh_fast)		\
      SymX(orIntegerzh_fast)			\
      SymX(performGC)				\
457
      SymX(performMajorGC)			\
458
459
460
461
462
463
464
      SymX(plusIntegerzh_fast)			\
      SymX(prog_argc)				\
      SymX(prog_argv)				\
      SymX(putMVarzh_fast)			\
      SymX(quotIntegerzh_fast)			\
      SymX(quotRemIntegerzh_fast)		\
      SymX(raisezh_fast)			\
465
      SymX(raiseIOzh_fast)			\
466
      SymX(readTVarzh_fast)			\
467
468
469
      SymX(remIntegerzh_fast)			\
      SymX(resetNonBlockingFd)			\
      SymX(resumeThread)			\
dons's avatar
dons committed
470
      SymX(resolveObjs)                         \
471
      SymX(retryzh_fast)                        \
472
473
474
475
476
      SymX(rts_apply)				\
      SymX(rts_checkSchedStatus)		\
      SymX(rts_eval)				\
      SymX(rts_evalIO)				\
      SymX(rts_evalLazyIO)			\
477
      SymX(rts_evalStableIO)			\
478
479
480
481
482
483
484
485
      SymX(rts_eval_)				\
      SymX(rts_getBool)				\
      SymX(rts_getChar)				\
      SymX(rts_getDouble)			\
      SymX(rts_getFloat)			\
      SymX(rts_getInt)				\
      SymX(rts_getInt32)			\
      SymX(rts_getPtr)				\
486
      SymX(rts_getFunPtr)			\
487
      SymX(rts_getStablePtr)			\
488
      SymX(rts_getThreadId)			\
489
490
      SymX(rts_getWord)				\
      SymX(rts_getWord32)			\
491
      SymX(rts_lock)				\
492
493
494
495
496
497
498
499
500
501
      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)				\
502
      SymX(rts_mkFunPtr)			\
503
504
505
506
507
508
509
      SymX(rts_mkStablePtr)			\
      SymX(rts_mkString)			\
      SymX(rts_mkWord)				\
      SymX(rts_mkWord16)			\
      SymX(rts_mkWord32)			\
      SymX(rts_mkWord64)			\
      SymX(rts_mkWord8)				\
510
      SymX(rts_unlock)				\
511
      SymX(rtsSupportsBoundThreads)		\
512
      SymX(run_queue_hd)			\
513
514
      SymX(__hscore_get_saved_termios)		\
      SymX(__hscore_set_saved_termios)		\
515
      SymX(setProgArgv)				\
516
517
      SymX(startupHaskell)			\
      SymX(shutdownHaskell)			\
518
519
520
521
      SymX(shutdownHaskellAndExit)		\
      SymX(stable_ptr_table)			\
      SymX(stackOverflow)			\
      SymX(stg_CAF_BLACKHOLE_info)		\
522
523
      SymX(stg_BLACKHOLE_BQ_info)		\
      SymX(awakenBlockedQueue)			\
524
525
526
527
528
529
      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)                       \
530
      SymX(stg_ap_0_info)			\
531
532
533
534
535
536
537
538
539
540
      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)			\
541
      SymX(stg_ap_pppv_info)			\
542
543
544
      SymX(stg_ap_pppp_info)			\
      SymX(stg_ap_ppppp_info)			\
      SymX(stg_ap_pppppp_info)			\
545
      SymX(stg_ap_1_upd_info)			\
546
547
548
549
550
551
      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)			\
552
      SymX(stg_exit)				\
553
      SymX(stg_sel_0_upd_info)			\
554
555
556
557
558
559
      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)			\
560
561
562
563
564
565
566
567
568
      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)			\
569
570
      SymX(stg_upd_frame_info)			\
      SymX(suspendThread)			\
571
      SymX(takeMVarzh_fast)			\
572
      SymX(timesIntegerzh_fast)			\
573
      SymX(tryPutMVarzh_fast)			\
574
575
      SymX(tryTakeMVarzh_fast)			\
      SymX(unblockAsyncExceptionszh_fast)	\
dons's avatar
dons committed
576
      SymX(unloadObj)                           \
577
      SymX(unsafeThawArrayzh_fast)		\
578
579
      SymX(waitReadzh_fast)			\
      SymX(waitWritezh_fast)			\
580
      SymX(word2Integerzh_fast)			\
581
      SymX(writeTVarzh_fast)			\
582
      SymX(xorIntegerzh_fast)			\
583
      SymX(yieldzh_fast)
584

585
#ifdef SUPPORT_LONG_LONGS
586
#define RTS_LONG_LONG_SYMS			\
587
588
      SymX(int64ToIntegerzh_fast)		\
      SymX(word64ToIntegerzh_fast)
589
590
591
592
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif

593
594
595
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
#define RTS_LIBGCC_SYMBOLS			\
596
597
598
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
599
      Sym(__umoddi3)				\
600
      Sym(__muldi3)				\
601
602
603
604
      Sym(__ashldi3)				\
      Sym(__ashrdi3)				\
      Sym(__lshrdi3)				\
      Sym(__eprintf)
605
606
607
608
609
610
611
612
#elif defined(ia64_TARGET_ARCH)
#define RTS_LIBGCC_SYMBOLS			\
      Sym(__divdi3)				\
      Sym(__udivdi3)                            \
      Sym(__moddi3)				\
      Sym(__umoddi3)				\
      Sym(__divsf3)				\
      Sym(__divdf3)
613
614
615
616
#else
#define RTS_LIBGCC_SYMBOLS
#endif

617
#ifdef darwin_TARGET_OS
618
619
620
621
622
623
      // 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)
624
#endif
625
626

/* entirely bogus claims about types of these symbols */
627
#define Sym(vvv)  extern void vvv(void);
628
#define SymX(vvv) /**/
629
#define SymX_redirect(vvv,xxx) /**/
630
RTS_SYMBOLS
631
RTS_RET_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
#undef Sym
#undef SymX
639
#undef SymX_redirect
640
641
642
643
644
645
646
647
648
649
650

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

651
652
653
654
655
656
// 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)) },

657
static RtsSymbolVal rtsSyms[] = {
658
      RTS_SYMBOLS
659
      RTS_RET_SYMBOLS
660
      RTS_LONG_LONG_SYMS
661
      RTS_POSIX_ONLY_SYMBOLS
662
      RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
663
      RTS_CYGWIN_ONLY_SYMBOLS
664
      RTS_LIBGCC_SYMBOLS
665
666
667
      { 0, 0 } /* sentinel */
};

668
669
670
671
672
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
 */
static void ghciInsertStrHashTable ( char* obj_name,
                                     HashTable *table,
673
                                     char* key,
674
675
676
677
678
679
680
681
                                     void *data
				   )
{
   if (lookupHashTable(table, (StgWord)key) == NULL)
   {
      insertStrHashTable(table, (StgWord)key, data);
      return;
   }
682
   debugBelch(
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
      "\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);
}


702
703
704
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
705
706
707
708


static int linker_init_done = 0 ;

709
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
710
static void *dl_prog_handle;
711
#endif
712

dons's avatar
dons committed
713
714
715
716
717
/* dlopen(NULL,..) doesn't work so we grab libc explicitly */
#if defined(openbsd_TARGET_OS)
static void *dl_libc_handle;
#endif

718
719
720
void
initLinker( void )
{
721
    RtsSymbolVal *sym;
722

723
724
725
726
727
728
729
    /* 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;
    }

730
731
732
733
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
734
735
	ghciInsertStrHashTable("(GHCi built-in symbols)",
                               symhash, sym->lbl, sym->addr);
736
    }
737
738
739
740
#   if defined(OBJFORMAT_MACHO)
    machoInitSymbolsWithoutUnderscore();
#   endif

741
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
742
#   if defined(RTLD_DEFAULT)
743
744
    dl_prog_handle = RTLD_DEFAULT;
#   else
745
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
dons's avatar
dons committed
746
747
748
#   if defined(openbsd_TARGET_OS)
    dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
#   endif
749
#   endif // RTLD_DEFAULT
750
#   endif
751
752
}

753
/* -----------------------------------------------------------------------------
754
755
756
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
757
758
759
760
 * 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
761
762
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
763
 * In the PEi386 case, open the DLLs and put handles to them in a
764
 * linked list.  When looking for a symbol, try all handles in the
765
766
767
768
769
 * 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.
770
 *
771
 */
772
773
774
775
776
777

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

typedef
   struct _OpenedDLL {
778
      char*              name;
779
780
      struct _OpenedDLL* next;
      HINSTANCE instance;
781
   }
782
783
784
785
786
787
   OpenedDLL;

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

788
789
char *
addDLL( char *dll_name )
790
{
791
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
792
   /* ------------------- ELF DLL loader ------------------- */
793
   void *hdl;
794
   char *errmsg;
795

796
797
   initLinker();

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

800
801
802
803
804
805
806
807
   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;
   }
808
809
   /*NOTREACHED*/

810
#  elif defined(OBJFORMAT_PEi386)
811
   /* ------------------- Win32 DLL loader ------------------- */
812

813
   char*      buf;
814
   OpenedDLL* o_dll;
815
   HINSTANCE  instance;
816

817
818
   initLinker();

819
   /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
820
821
822
823
824

   /* 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;
825
826
   }

827
828
829
830
831
832
833
834
835
836
   /* 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. */

837
   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
838
839
840
   sprintf(buf, "%s.DLL", dll_name);
   instance = LoadLibrary(buf);
   if (instance == NULL) {
841
	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
842
843
	 instance = LoadLibrary(buf);
	 if (instance == NULL) {
sof's avatar
sof committed
844
		stgFree(buf);
845
846
847
848

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

852
   /* Add this DLL to the list of DLLs in which to search for symbols. */
853
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
854
855
   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
   strcpy(o_dll->name, dll_name);
856
   o_dll->instance = instance;
857
858
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
859
860

   return NULL;
861
862
863
864
865
#  else
   barf("addDLL: not implemented on this platform");
#  endif
}

866
867
/* -----------------------------------------------------------------------------
 * lookup a symbol in the hash table
868
 */
869
870
871
void *
lookupSymbol( char *lbl )
{
872
    void *val;
873
    initLinker() ;
874
    ASSERT(symhash != NULL);
875
876
877
    val = lookupStrHashTable(symhash, lbl);

    if (val == NULL) {
878
#       if defined(OBJFORMAT_ELF)
dons's avatar
dons committed
879
880
881
882
#	if defined(openbsd_TARGET_OS)
	val = dlsym(dl_prog_handle, lbl);
	return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
#	else /* not openbsd */
883
	return dlsym(dl_prog_handle, lbl);
dons's avatar
dons committed
884
#	endif
885
886
887
888
889
890
891
#       elif defined(OBJFORMAT_MACHO)
	if(NSIsSymbolNameDefined(lbl)) {
	    NSSymbol symbol = NSLookupAndBindSymbol(lbl);
	    return NSAddressOfSymbol(symbol);
	} else {
	    return NULL;
	}
892
#       elif defined(OBJFORMAT_PEi386)
893
894
895
        OpenedDLL* o_dll;
        void* sym;
        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
896
	  /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
897
898
899
900
901
902
903
           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
904
              if (sym != NULL) {
905
		/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
sof's avatar
sof committed
906
		return sym;
907
	      }
908
           }
909
           sym = GetProcAddress(o_dll->instance, lbl);
sof's avatar
sof committed
910
           if (sym != NULL) {
911
	     /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
sof's avatar
sof committed
912
913
	     return sym;
	   }
914
        }
915
        return NULL;
ken's avatar
ken committed
916
917
918
#       else
        ASSERT(2+2 == 5);
        return NULL;
919
#       endif
920
    } else {
921
	return val;
922
923
924
    }
}

925
static
926
__attribute((unused))
927
928
929
void *
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
930
    void *val;
931
    initLinker() ;
932
933
934
935
936
    val = lookupStrHashTable(oc->lochash, lbl);

    if (val == NULL) {
        return NULL;
    } else {
937
	return val;
938
939
940
941
    }
}


942
943
944
945
946
947
948
949
950
951
952
953
954
955
/* -----------------------------------------------------------------------------
 * 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;
956
957
958

   initLinker();

959
960
961
962
   for (oc = objects; oc; oc = oc->next) {
      for (i = 0; i < oc->n_symbols; i++) {
         sym = oc->symbols[i];
         if (sym == NULL) continue;
963
         // debugBelch("enquire %p %p\n", sym, oc->lochash);
964
         a = NULL;
965
         if (oc->lochash != NULL) {
966
            a = lookupStrHashTable(oc->lochash, sym);
967
968
	 }
         if (a == NULL) {
969
            a = lookupStrHashTable(symhash, sym);
970
	 }
971
         if (a == NULL) {
972
	     // debugBelch("ghci_enquire: can't find %s\n", sym);
973
         }
974
         else if (addr-DELTA <= a && a <= addr+DELTA) {
975
            debugBelch("%p + %3d  ==  `%s'\n", addr, a - addr, sym);
976
977
978
979
980
981
         }
      }
   }
}
#endif

982
983
984
#ifdef ia64_TARGET_ARCH
static unsigned int PLTSize(void);
#endif
985

986
987
988
989
990
991
992
993
994
995
996
/* -----------------------------------------------------------------------------
 * 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;
997
998
#ifdef USE_MMAP
   int fd, pagesize;
999
   void *map_addr = NULL;
1000
#else
1001
   FILE *f;
1002
#endif
1003

1004
1005
   initLinker();

1006
   /* debugBelch("loadObj %s\n", path ); */
1007

dons's avatar
dons committed
1008
1009
   /* Check that we haven't already loaded this object. 
      Ignore requests to load multiple times */
1010
   {
1011
       ObjectCode *o;
1012
1013
       int is_dup = 0;
       for (o = objects; o; o = o->next) {
dons's avatar
dons committed
1014
          if (0 == strcmp(o->fileName, path)) {
1015
             is_dup = 1;
dons's avatar
dons committed
1016
1017
             break; /* don't need to search further */
          }
1018
1019
       }
       if (is_dup) {
1020
          IF_DEBUG(linker, debugBelch(
1021
1022
1023
            "GHCi runtime linker: warning: looks like you're trying to load the\n"
            "same object file twice:\n"
            "   %s\n"
dons's avatar
dons committed
1024
1025
1026
            "GHCi will ignore this, but be warned.\n"
            , path));
          return 1; /* success */
1027
       }
1028
1029
1030
1031
   }

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

1032
#  if defined(OBJFORMAT_ELF)
1033
   oc->formatName = "ELF";
1034
#  elif defined(OBJFORMAT_PEi386)
1035
   oc->formatName = "PEi386";
1036
1037
#  elif defined(OBJFORMAT_MACHO)
   oc->formatName = "Mach-O";
1038
#  else
sof's avatar
sof committed
1039
   stgFree(oc);
1040
1041
1042
1043
1044
1045
   barf("loadObj: not implemented on this platform");
#  endif

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

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

1050
1051
1052
   oc->fileSize          = st.st_size;
   oc->symbols           = NULL;
   oc->sections          = NULL;
1053
   oc->lochash           = allocStrHashTable();
1054
   oc->proddables        = NULL;
1055
1056
1057
1058
1059

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

1060
1061
1062
1063
1064
#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
1065
1066
1067
#if defined(openbsd_TARGET_OS)
   fd = open(path, O_RDONLY, S_IRUSR);
#else
1068
   fd = open(path, O_RDONLY);
dons's avatar
dons committed
1069
#endif
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
   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)");

1097
1098
   /* load the image into memory */
   f = fopen(path, "rb");
1099
   if (!f)
1100
       barf("loadObj: can't read `%s'", path);
1101

1102
   n = fread ( oc->image, 1, oc->fileSize, f );
1103
   if (n != oc->fileSize)
1104
      barf("loadObj: error whilst reading `%s'", path);
1105
1106
1107
1108

   fclose(f);

#endif /* USE_MMAP */
1109

1110
1111
1112
#  if defined(OBJFORMAT_MACHO)
   r = ocAllocateJumpIslands_MachO ( oc );
   if (!r) { return r; }
1113
1114
1115
#  elif defined(OBJFORMAT_ELF) && defined(powerpc_TARGET_ARCH)
   r = ocAllocateJumpIslands_ELF ( oc );
   if (!r) { return r; }
1116
1117
#endif

1118
   /* verify the in-memory image */
1119
#  if defined(OBJFORMAT_ELF)
1120
   r = ocVerifyImage_ELF ( oc );
1121
#  elif defined(OBJFORMAT_PEi386)
1122
   r = ocVerifyImage_PEi386 ( oc );
1123
1124
#  elif defined(OBJFORMAT_MACHO)
   r = ocVerifyImage_MachO ( oc );
1125
1126
1127
1128
1129
1130
#  else
   barf("loadObj: no verify method");
#  endif
   if (!r) { return r; }

   /* build the symbol list for this image */
1131
#  if defined(OBJFORMAT_ELF)
1132
   r = ocGetNames_ELF ( oc );
1133
#  elif defined(OBJFORMAT_PEi386)
1134
   r = ocGetNames_PEi386 ( oc );
1135
1136
#  elif defined(OBJFORMAT_MACHO)
   r = ocGetNames_MachO ( oc );
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
#  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.
 */
1153
HsInt
1154
1155
1156
1157
1158
resolveObjs( void )
{
    ObjectCode *oc;
    int r;

1159
1160
    initLinker();

1161
1162
    for (oc = objects; oc; oc = oc->next) {
	if (oc->status != OBJECT_RESOLVED) {
1163
#           if defined(OBJFORMAT_ELF)
1164
	    r = ocResolve_ELF ( oc );
1165
#           elif defined(OBJFORMAT_PEi386)
1166
	    r = ocResolve_PEi386 ( oc );
1167
1168
#           elif defined(OBJFORMAT_MACHO)
	    r = ocResolve_MachO ( oc );
1169
#           else
1170
	    barf("resolveObjs: not implemented on this platform");
1171
#           endif
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
	    if (!r) { return r; }
	    oc->status = OBJECT_RESOLVED;
	}
    }
    return 1;
}

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

1187
1188
1189
    ASSERT(symhash != NULL);
    ASSERT(objects != NULL);

1190
    initLinker();
1191

1192
1193
    prev = NULL;
    for (oc = objects; oc; prev = oc, oc = oc->next) {
1194
1195