Linker.c 135 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
/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and 
   MREMAP_MAYMOVE from <sys/mman.h>.
 */
16
17
18
19
#ifdef __linux__
#define _GNU_SOURCE
#endif

20
21
22
23
24
#include "Rts.h"
#include "RtsFlags.h"
#include "HsFFI.h"
#include "Hash.h"
#include "Linker.h"
25
#include "LinkerInternals.h"
26
#include "RtsUtils.h"
27
#include "Schedule.h"
28
#include "Storage.h"
29
#include "Sparks.h"
30

31
#ifdef HAVE_SYS_TYPES_H
32
#include <sys/types.h>
33
34
#endif

35
36
37
#include <stdlib.h>
#include <string.h>

38
#ifdef HAVE_SYS_STAT_H
39
#include <sys/stat.h>
40
#endif
41

42
#if defined(HAVE_DLFCN_H)
43
#include <dlfcn.h>
44
#endif
45

46
#if defined(cygwin32_HOST_OS)
sof's avatar
sof committed
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
#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

62
#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
63
64
65
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
dons's avatar
dons committed
66

67
#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
dons's avatar
dons committed
68
69
70
71
72
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#endif

73
74
#endif

75
#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
76
#  define OBJFORMAT_ELF
77
#elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
78
#  define OBJFORMAT_PEi386
79
#  include <windows.h>
sof's avatar
sof committed
80
#  include <math.h>
81
#elif defined(darwin_HOST_OS)
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
89
#if defined(powerpc_HOST_ARCH)
#  include <mach-o/ppc/reloc.h>
#endif
90
91
#endif

92
/* Hash table mapping symbol names to Symbol */
93
static /*Str*/HashTable *symhash;
94

95
96
97
/* List of currently loaded objects */
ObjectCode *objects = NULL;	/* initially empty */

98
#if defined(OBJFORMAT_ELF)
99
100
101
static int ocVerifyImage_ELF    ( ObjectCode* oc );
static int ocGetNames_ELF       ( ObjectCode* oc );
static int ocResolve_ELF        ( ObjectCode* oc );
102
#if defined(powerpc_HOST_ARCH)
103
104
static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
#endif
105
#elif defined(OBJFORMAT_PEi386)
106
107
108
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386    ( ObjectCode* oc );
static int ocResolve_PEi386     ( ObjectCode* oc );
109
110
111
112
#elif defined(OBJFORMAT_MACHO)
static int ocVerifyImage_MachO    ( ObjectCode* oc );
static int ocGetNames_MachO       ( ObjectCode* oc );
static int ocResolve_MachO        ( ObjectCode* oc );
113

114
static int machoGetMisalignment( FILE * );
115
116
#ifdef powerpc_HOST_ARCH
static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
117
static void machoInitSymbolsWithoutUnderscore( void );
118
#endif
119
#endif
120

121
122
123
124
#if defined(x86_64_HOST_ARCH)
static void*x86_64_high_symbol( char *lbl, void *addr );
#endif

125
126
127
128
/* -----------------------------------------------------------------------------
 * Built-in symbols from the RTS
 */

129
130
131
132
133
134
typedef struct _RtsSymbolVal {
    char   *lbl;
    void   *addr;
} RtsSymbolVal;


135
136
137
138
139
140
141
142
#if !defined(PAR)
#define Maybe_Stable_Names      SymX(mkWeakzh_fast)			\
      				SymX(makeStableNamezh_fast)		\
      				SymX(finalizzeWeakzh_fast)
#else
/* These are not available in GUM!!! -- HWL */
#define Maybe_Stable_Names
#endif
143

144
#if !defined (mingw32_HOST_OS)
145
#define RTS_POSIX_ONLY_SYMBOLS                  \
146
      SymX(signal_handlers)			\
147
148
      SymX(stg_sig_install)			\
      Sym(nocldstop)
sof's avatar
sof committed
149
#endif
150

151
#if defined (cygwin32_HOST_OS)
sof's avatar
sof committed
152
153
154
#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
155
 * exports; sigh.
sof's avatar
sof committed
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
225
226
227
228
229
230
231
232
 */
#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)                               \
233
      SymX(waitpid)
234

235
#elif !defined(mingw32_HOST_OS)
sof's avatar
sof committed
236
237
#define RTS_MINGW_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
238
#else /* defined(mingw32_HOST_OS) */
sof's avatar
sof committed
239
240
#define RTS_POSIX_ONLY_SYMBOLS  /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
241

242
243
244
245
/* Extra syms gen'ed by mingw-2's gcc-3.2: */
#if __GNUC__>=3
#define RTS_MINGW_EXTRA_SYMS                    \
      Sym(_imp____mb_cur_max)                   \
246
      Sym(_imp___pctype)
247
248
249
250
#else
#define RTS_MINGW_EXTRA_SYMS
#endif

251
252
/* These are statically linked from the mingw libraries into the ghc
   executable, so we have to employ this hack. */
253
#define RTS_MINGW_ONLY_SYMBOLS                  \
sof's avatar
sof committed
254
255
      SymX(asyncReadzh_fast)			\
      SymX(asyncWritezh_fast)			\
sof's avatar
sof committed
256
      SymX(asyncDoProczh_fast)			\
257
      SymX(memset)                              \
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
      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)                              \
290
291
292
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
293
294
295
296
297
298
299
300
301
302
303
304
305
      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)                                \
306
307
308
309
310
311
312
313
314
315
316
317
318
      SymX(powf)                                 \
      SymX(tanhf)                                \
      SymX(coshf)                                \
      SymX(sinhf)                                \
      SymX(atanf)                                \
      SymX(acosf)                                \
      SymX(asinf)                                \
      SymX(tanf)                                 \
      SymX(cosf)                                 \
      SymX(sinf)                                 \
      SymX(expf)                                 \
      SymX(logf)                                 \
      SymX(sqrtf)                                \
319
      SymX(memcpy)                              \
sof's avatar
sof committed
320
321
      SymX(rts_InstallConsoleEvent)             \
      SymX(rts_ConsoleHandlerDone)              \
322
      Sym(mktime)                               \
323
      Sym(_imp___timezone)                      \
324
      Sym(_imp___tzname)                        \
325
      Sym(_imp___iob)                           \
sof's avatar
sof committed
326
      Sym(_imp___osver)                         \
327
328
329
330
      Sym(localtime)                            \
      Sym(gmtime)                               \
      Sym(opendir)                              \
      Sym(readdir)                              \
sof's avatar
sof committed
331
      Sym(rewinddir)                            \
332
      RTS_MINGW_EXTRA_SYMS                      \
333
      Sym(closedir)
334
#endif
335

336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
#define RTS_DARWIN_ONLY_SYMBOLS			\
     Sym(asprintf$LDBLStub)                     \
     Sym(err$LDBLStub)                          \
     Sym(errc$LDBLStub)                         \
     Sym(errx$LDBLStub)                         \
     Sym(fprintf$LDBLStub)                      \
     Sym(fscanf$LDBLStub)                       \
     Sym(fwprintf$LDBLStub)                     \
     Sym(fwscanf$LDBLStub)                      \
     Sym(printf$LDBLStub)                       \
     Sym(scanf$LDBLStub)                        \
     Sym(snprintf$LDBLStub)                     \
     Sym(sprintf$LDBLStub)                      \
     Sym(sscanf$LDBLStub)                       \
     Sym(strtold$LDBLStub)                      \
     Sym(swprintf$LDBLStub)                     \
     Sym(swscanf$LDBLStub)                      \
     Sym(syslog$LDBLStub)                       \
     Sym(vasprintf$LDBLStub)                    \
     Sym(verr$LDBLStub)                         \
     Sym(verrc$LDBLStub)                        \
     Sym(verrx$LDBLStub)                        \
     Sym(vfprintf$LDBLStub)                     \
     Sym(vfscanf$LDBLStub)                      \
     Sym(vfwprintf$LDBLStub)                    \
     Sym(vfwscanf$LDBLStub)                     \
     Sym(vprintf$LDBLStub)                      \
     Sym(vscanf$LDBLStub)                       \
     Sym(vsnprintf$LDBLStub)                    \
     Sym(vsprintf$LDBLStub)                     \
     Sym(vsscanf$LDBLStub)                      \
     Sym(vswprintf$LDBLStub)                    \
     Sym(vswscanf$LDBLStub)                     \
     Sym(vsyslog$LDBLStub)                      \
     Sym(vwarn$LDBLStub)                        \
     Sym(vwarnc$LDBLStub)                       \
     Sym(vwarnx$LDBLStub)                       \
     Sym(vwprintf$LDBLStub)                     \
     Sym(vwscanf$LDBLStub)                      \
     Sym(warn$LDBLStub)                         \
     Sym(warnc$LDBLStub)                        \
     Sym(warnx$LDBLStub)                        \
     Sym(wcstold$LDBLStub)                      \
     Sym(wprintf$LDBLStub)                      \
     Sym(wscanf$LDBLStub)
#else
#define RTS_DARWIN_ONLY_SYMBOLS
#endif

sof's avatar
sof committed
386
387
388
389
390
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
391

sof's avatar
sof committed
392
393
394
395
396
397
398
#if !defined(mingw32_HOST_OS)
#define RTS_USER_SIGNALS_SYMBOLS \
   SymX(setIOManagerPipe)
#else
#define RTS_USER_SIGNALS_SYMBOLS /* nothing */
#endif

399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
#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_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

421
#define RTS_SYMBOLS				\
422
423
      Maybe_Stable_Names			\
      Sym(StgReturn)				\
424
425
      SymX(stg_enter_info)			\
      SymX(stg_gc_void_info)			\
426
427
      SymX(__stg_gc_enter_1)			\
      SymX(stg_gc_noregs)			\
428
      SymX(stg_gc_unpt_r1_info)			\
429
      SymX(stg_gc_unpt_r1)			\
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
      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)			\
446
      SymX(stg_yield_to_interpreter)		\
447
448
449
450
451
452
      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
453
      MAIN_CAP_SYM                              \
454
455
456
457
458
459
      SymX(MallocFailHook)			\
      SymX(OnExitHook)				\
      SymX(OutOfHeapHook)			\
      SymX(StackOverflowHook)			\
      SymX(__encodeDouble)			\
      SymX(__encodeFloat)			\
dons's avatar
dons committed
460
      SymX(addDLL)               		\
461
462
463
464
465
466
467
468
469
      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)			\
470
      SymX(atomicallyzh_fast)			\
471
      SymX(barf)				\
472
473
      SymX(debugBelch)				\
      SymX(errorBelch)				\
474
475
      SymX(blockAsyncExceptionszh_fast)		\
      SymX(catchzh_fast)			\
476
477
      SymX(catchRetryzh_fast)			\
      SymX(catchSTMzh_fast)			\
sof's avatar
sof committed
478
      SymX(closure_flags)                       \
479
      SymX(cmp_thread)				\
sof's avatar
sof committed
480
481
      SymX(cmpIntegerzh_fast)	        	\
      SymX(cmpIntegerIntzh_fast)	      	\
sof's avatar
sof committed
482
      SymX(complementIntegerzh_fast)		\
483
484
485
486
487
      SymX(createAdjustor)			\
      SymX(decodeDoublezh_fast)			\
      SymX(decodeFloatzh_fast)			\
      SymX(defaultsHook)			\
      SymX(delayzh_fast)			\
sof's avatar
sof committed
488
489
      SymX(deRefWeakzh_fast)			\
      SymX(deRefStablePtrzh_fast)		\
490
      SymX(dirty_MUT_VAR)			\
491
492
493
      SymX(divExactIntegerzh_fast)		\
      SymX(divModIntegerzh_fast)		\
      SymX(forkzh_fast)				\
494
      SymX(forkProcess)				\
495
      SymX(forkOS_createThread)			\
496
      SymX(freeHaskellFunctionPtr)		\
sof's avatar
sof committed
497
      SymX(freeStablePtr)		        \
498
      SymX(gcdIntegerzh_fast)			\
sof's avatar
sof committed
499
500
      SymX(gcdIntegerIntzh_fast)		\
      SymX(gcdIntzh_fast)			\
501
      SymX(genSymZh)				\
dons's avatar
dons committed
502
      SymX(genericRaise)			\
503
504
      SymX(getProgArgv)				\
      SymX(getStablePtr)			\
505
506
507
508
509
510
511
512
      SymX(hs_init)				\
      SymX(hs_exit)				\
      SymX(hs_set_argv)				\
      SymX(hs_add_root)				\
      SymX(hs_perform_gc)			\
      SymX(hs_free_stable_ptr)			\
      SymX(hs_free_fun_ptr)			\
      SymX(initLinker)				\
513
      SymX(int2Integerzh_fast)			\
sof's avatar
sof committed
514
515
      SymX(integer2Intzh_fast)			\
      SymX(integer2Wordzh_fast)			\
516
      SymX(isCurrentThreadBoundzh_fast)		\
517
518
519
520
      SymX(isDoubleDenormalized)		\
      SymX(isDoubleInfinite)			\
      SymX(isDoubleNaN)				\
      SymX(isDoubleNegativeZero)		\
sof's avatar
sof committed
521
      SymX(isEmptyMVarzh_fast)			\
522
523
524
525
526
      SymX(isFloatDenormalized)			\
      SymX(isFloatInfinite)			\
      SymX(isFloatNaN)				\
      SymX(isFloatNegativeZero)			\
      SymX(killThreadzh_fast)			\
dons's avatar
dons committed
527
528
      SymX(loadObj)          			\
      SymX(lookupSymbol)     			\
sof's avatar
sof committed
529
      SymX(makeStablePtrzh_fast)		\
530
531
      SymX(minusIntegerzh_fast)			\
      SymX(mkApUpd0zh_fast)			\
sof's avatar
sof committed
532
      SymX(myThreadIdzh_fast)			\
533
      SymX(labelThreadzh_fast)                  \
534
535
536
      SymX(newArrayzh_fast)			\
      SymX(newBCOzh_fast)			\
      SymX(newByteArrayzh_fast)			\
537
      SymX_redirect(newCAF, newDynCAF)		\
538
539
      SymX(newMVarzh_fast)			\
      SymX(newMutVarzh_fast)			\
540
      SymX(newTVarzh_fast)			\
541
      SymX(atomicModifyMutVarzh_fast)		\
542
      SymX(newPinnedByteArrayzh_fast)		\
543
      SymX(newSpark)				\
544
545
      SymX(orIntegerzh_fast)			\
      SymX(performGC)				\
546
      SymX(performMajorGC)			\
547
548
549
550
551
552
553
      SymX(plusIntegerzh_fast)			\
      SymX(prog_argc)				\
      SymX(prog_argv)				\
      SymX(putMVarzh_fast)			\
      SymX(quotIntegerzh_fast)			\
      SymX(quotRemIntegerzh_fast)		\
      SymX(raisezh_fast)			\
554
      SymX(raiseIOzh_fast)			\
555
      SymX(readTVarzh_fast)			\
556
557
558
      SymX(remIntegerzh_fast)			\
      SymX(resetNonBlockingFd)			\
      SymX(resumeThread)			\
dons's avatar
dons committed
559
      SymX(resolveObjs)                         \
560
      SymX(retryzh_fast)                        \
561
562
563
564
565
      SymX(rts_apply)				\
      SymX(rts_checkSchedStatus)		\
      SymX(rts_eval)				\
      SymX(rts_evalIO)				\
      SymX(rts_evalLazyIO)			\
566
      SymX(rts_evalStableIO)			\
567
568
569
570
571
572
573
574
      SymX(rts_eval_)				\
      SymX(rts_getBool)				\
      SymX(rts_getChar)				\
      SymX(rts_getDouble)			\
      SymX(rts_getFloat)			\
      SymX(rts_getInt)				\
      SymX(rts_getInt32)			\
      SymX(rts_getPtr)				\
575
      SymX(rts_getFunPtr)			\
576
      SymX(rts_getStablePtr)			\
577
      SymX(rts_getThreadId)			\
578
579
      SymX(rts_getWord)				\
      SymX(rts_getWord32)			\
580
      SymX(rts_lock)				\
581
582
583
584
585
586
587
588
589
590
      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)				\
591
      SymX(rts_mkFunPtr)			\
592
593
594
595
596
597
598
      SymX(rts_mkStablePtr)			\
      SymX(rts_mkString)			\
      SymX(rts_mkWord)				\
      SymX(rts_mkWord16)			\
      SymX(rts_mkWord32)			\
      SymX(rts_mkWord64)			\
      SymX(rts_mkWord8)				\
599
      SymX(rts_unlock)				\
600
      SymX(rtsSupportsBoundThreads)		\
601
602
      SymX(__hscore_get_saved_termios)		\
      SymX(__hscore_set_saved_termios)		\
603
      SymX(setProgArgv)				\
604
605
      SymX(startupHaskell)			\
      SymX(shutdownHaskell)			\
606
607
608
609
      SymX(shutdownHaskellAndExit)		\
      SymX(stable_ptr_table)			\
      SymX(stackOverflow)			\
      SymX(stg_CAF_BLACKHOLE_info)		\
610
      SymX(awakenBlockedQueue)			\
611
612
613
614
      SymX(stg_CHARLIKE_closure)		\
      SymX(stg_EMPTY_MVAR_info)			\
      SymX(stg_IND_STATIC_info)			\
      SymX(stg_INTLIKE_closure)			\
615
      SymX(stg_MUT_ARR_PTRS_DIRTY_info)		\
616
      SymX(stg_MUT_ARR_PTRS_FROZEN_info)	\
617
      SymX(stg_MUT_ARR_PTRS_FROZEN0_info)	\
618
      SymX(stg_WEAK_info)                       \
619
620
621
622
623
624
625
626
627
628
      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)			\
629
      SymX(stg_ap_pppv_info)			\
630
631
632
      SymX(stg_ap_pppp_info)			\
      SymX(stg_ap_ppppp_info)			\
      SymX(stg_ap_pppppp_info)			\
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
      SymX(stg_ap_0_fast)			\
      SymX(stg_ap_v_fast)			\
      SymX(stg_ap_f_fast)			\
      SymX(stg_ap_d_fast)			\
      SymX(stg_ap_l_fast)			\
      SymX(stg_ap_n_fast)			\
      SymX(stg_ap_p_fast)			\
      SymX(stg_ap_pv_fast)			\
      SymX(stg_ap_pp_fast)			\
      SymX(stg_ap_ppv_fast)			\
      SymX(stg_ap_ppp_fast)			\
      SymX(stg_ap_pppv_fast)			\
      SymX(stg_ap_pppp_fast)			\
      SymX(stg_ap_ppppp_fast)			\
      SymX(stg_ap_pppppp_fast)			\
648
      SymX(stg_ap_1_upd_info)			\
649
650
651
652
653
654
      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)			\
655
      SymX(stg_exit)				\
656
      SymX(stg_sel_0_upd_info)			\
657
658
659
660
661
662
      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)			\
663
664
665
666
667
668
669
670
671
      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)			\
672
673
      SymX(stg_upd_frame_info)			\
      SymX(suspendThread)			\
674
      SymX(takeMVarzh_fast)			\
675
      SymX(timesIntegerzh_fast)			\
676
      SymX(tryPutMVarzh_fast)			\
677
678
      SymX(tryTakeMVarzh_fast)			\
      SymX(unblockAsyncExceptionszh_fast)	\
dons's avatar
dons committed
679
      SymX(unloadObj)                           \
680
      SymX(unsafeThawArrayzh_fast)		\
681
682
      SymX(waitReadzh_fast)			\
      SymX(waitWritezh_fast)			\
683
      SymX(word2Integerzh_fast)			\
684
      SymX(writeTVarzh_fast)			\
685
      SymX(xorIntegerzh_fast)			\
sof's avatar
sof committed
686
      SymX(yieldzh_fast)                        \
687
688
689
690
691
692
693
694
695
696
697
698
699
      SymX(stg_interp_constr_entry)             \
      SymX(stg_interp_constr1_entry)            \
      SymX(stg_interp_constr2_entry)            \
      SymX(stg_interp_constr3_entry)            \
      SymX(stg_interp_constr4_entry)            \
      SymX(stg_interp_constr5_entry)            \
      SymX(stg_interp_constr6_entry)            \
      SymX(stg_interp_constr7_entry)            \
      SymX(stg_interp_constr8_entry)            \
      SymX(stgMallocBytesRWX)                   \
      SymX(getAllocations)                      \
      SymX(revertCAFs)                          \
      SymX(RtsFlags)                            \
sof's avatar
sof committed
700
      RTS_USER_SIGNALS_SYMBOLS
701

702
#ifdef SUPPORT_LONG_LONGS
703
#define RTS_LONG_LONG_SYMS			\
704
705
      SymX(int64ToIntegerzh_fast)		\
      SymX(word64ToIntegerzh_fast)
706
707
708
709
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif

710
711
712
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
#define RTS_LIBGCC_SYMBOLS			\
713
714
715
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
716
      Sym(__umoddi3)				\
717
      Sym(__muldi3)				\
718
719
720
721
      Sym(__ashldi3)				\
      Sym(__ashrdi3)				\
      Sym(__lshrdi3)				\
      Sym(__eprintf)
722
#elif defined(ia64_HOST_ARCH)
723
724
725
726
727
728
729
#define RTS_LIBGCC_SYMBOLS			\
      Sym(__divdi3)				\
      Sym(__udivdi3)                            \
      Sym(__moddi3)				\
      Sym(__umoddi3)				\
      Sym(__divsf3)				\
      Sym(__divdf3)
730
731
732
733
#else
#define RTS_LIBGCC_SYMBOLS
#endif

734
#if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
735
736
737
738
739
740
      // 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)
741
#endif
742
743

/* entirely bogus claims about types of these symbols */
744
#define Sym(vvv)  extern void vvv(void);
745
#define SymX(vvv) /**/
746
#define SymX_redirect(vvv,xxx) /**/
747
RTS_SYMBOLS
748
RTS_RET_SYMBOLS
749
RTS_LONG_LONG_SYMS
750
RTS_POSIX_ONLY_SYMBOLS
751
RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
752
RTS_CYGWIN_ONLY_SYMBOLS
753
RTS_DARWIN_ONLY_SYMBOLS
754
RTS_LIBGCC_SYMBOLS
755
756
#undef Sym
#undef SymX
757
#undef SymX_redirect
758
759
760
761
762
763
764
765
766
767
768

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

769
770
771
772
773
774
// 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)) },

775
static RtsSymbolVal rtsSyms[] = {
776
      RTS_SYMBOLS
777
      RTS_RET_SYMBOLS
778
      RTS_LONG_LONG_SYMS
779
      RTS_POSIX_ONLY_SYMBOLS
780
      RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
781
      RTS_CYGWIN_ONLY_SYMBOLS
782
      RTS_LIBGCC_SYMBOLS
783
784
785
786
#if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
      // dyld stub code contains references to this,
      // but it should never be called because we treat
      // lazy pointers as nonlazy.
787
      { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
788
#endif
789
790
791
      { 0, 0 } /* sentinel */
};

792
793
794
795
796
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
 */
static void ghciInsertStrHashTable ( char* obj_name,
                                     HashTable *table,
797
                                     char* key,
798
799
800
801
802
803
804
805
                                     void *data
				   )
{
   if (lookupHashTable(table, (StgWord)key) == NULL)
   {
      insertStrHashTable(table, (StgWord)key, data);
      return;
   }
806
   debugBelch(
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
      "\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);
}


826
827
828
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
829
830
831
832


static int linker_init_done = 0 ;

833
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
834
static void *dl_prog_handle;
835
#endif
836

dons's avatar
dons committed
837
/* dlopen(NULL,..) doesn't work so we grab libc explicitly */
838
#if defined(openbsd_HOST_OS)
dons's avatar
dons committed
839
840
841
static void *dl_libc_handle;
#endif

842
843
844
void
initLinker( void )
{
845
    RtsSymbolVal *sym;
846

847
848
849
850
851
852
853
    /* 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;
    }

854
855
856
857
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
858
859
	ghciInsertStrHashTable("(GHCi built-in symbols)",
                               symhash, sym->lbl, sym->addr);
860
    }
861
#   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
862
863
864
    machoInitSymbolsWithoutUnderscore();
#   endif

865
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
866
#   if defined(RTLD_DEFAULT)
867
868
    dl_prog_handle = RTLD_DEFAULT;
#   else
869
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
870
#   if defined(openbsd_HOST_OS)
dons's avatar
dons committed
871
872
    dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
#   endif
873
#   endif /* RTLD_DEFAULT */
874
#   endif
875
876
}

877
/* -----------------------------------------------------------------------------
878
879
880
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
881
882
883
884
 * 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
885
886
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
887
 * In the PEi386 case, open the DLLs and put handles to them in a
888
 * linked list.  When looking for a symbol, try all handles in the
889
890
891
892
893
 * 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.
894
 *
895
 */
896
897
898
899
900
901

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

typedef
   struct _OpenedDLL {
902
      char*              name;
903
904
      struct _OpenedDLL* next;
      HINSTANCE instance;
905
   }
906
907
908
909
910
911
   OpenedDLL;

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

912
913
char *
addDLL( char *dll_name )
914
{
915
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
916
   /* ------------------- ELF DLL loader ------------------- */
917
   void *hdl;
918
   char *errmsg;
919

920
921
   initLinker();

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

924
925
926
927
928
929
930
931
   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;
   }
932
933
   /*NOTREACHED*/

934
#  elif defined(OBJFORMAT_PEi386)
935
   /* ------------------- Win32 DLL loader ------------------- */
936

937
   char*      buf;
938
   OpenedDLL* o_dll;
939
   HINSTANCE  instance;
940

941
942
   initLinker();

943
   /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
944
945
946
947
948

   /* 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;
949
950
   }

951
952
953
954
955
956
957
958
959
960
   /* 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. */

961
   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
962
963
964
   sprintf(buf, "%s.DLL", dll_name);
   instance = LoadLibrary(buf);
   if (instance == NULL) {
965
	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
966
967
	 instance = LoadLibrary(buf);
	 if (instance == NULL) {
sof's avatar
sof committed
968
		stgFree(buf);
969
970
971
972

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

976
   /* Add this DLL to the list of DLLs in which to search for symbols. */
977
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
978
979
   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
   strcpy(o_dll->name, dll_name);
980
   o_dll->instance = instance;
981
982
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
983
984

   return NULL;
985
986
987
988
989
#  else
   barf("addDLL: not implemented on this platform");
#  endif
}

990
991
/* -----------------------------------------------------------------------------
 * lookup a symbol in the hash table
992
 */
993
994
995
void *
lookupSymbol( char *lbl )
{
996
    void *val;
997
    initLinker() ;
998
    ASSERT(symhash != NULL);
999
1000
1001
    val = lookupStrHashTable(symhash, lbl);

    if (val == NULL) {
1002
#       if defined(OBJFORMAT_ELF)
1003
#	if defined(openbsd_HOST_OS)
dons's avatar
dons committed
1004
1005
	val = dlsym(dl_prog_handle, lbl);
	return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
#	elif defined(x86_64_HOST_ARCH)
	val = dlsym(dl_prog_handle, lbl);
	if (val >= (void *)0x80000000) {
	    void *new_val;
	    new_val = x86_64_high_symbol(lbl, val);
	    IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
	    return new_val;
	} else {
	    return val;
	}
dons's avatar
dons committed
1016
#	else /* not openbsd */
1017
	return dlsym(dl_prog_handle, lbl);
dons's avatar
dons committed
1018
#	endif
1019
1020
1021
1022
1023
1024
1025
#       elif defined(OBJFORMAT_MACHO)
	if(NSIsSymbolNameDefined(lbl)) {
	    NSSymbol symbol = NSLookupAndBindSymbol(lbl);
	    return NSAddressOfSymbol(symbol);
	} else {
	    return NULL;
	}
1026
#       elif defined(OBJFORMAT_PEi386)
1027
1028
1029
        OpenedDLL* o_dll;
        void* sym;
        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1030
	  /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1031
1032
1033
1034
1035
1036
1037
           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
1038
              if (sym != NULL) {
1039
		/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
sof's avatar
sof committed
1040
		return sym;
1041
	      }
1042
           }
1043
           sym = GetProcAddress(o_dll->instance, lbl);
sof's avatar
sof committed
1044
           if (sym != NULL) {
1045
	     /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
sof's avatar
sof committed
1046
1047
	     return sym;
	   }
1048
        }
1049
        return NULL;
ken's avatar
ken committed
1050
1051
1052
#       else
        ASSERT(2+2 == 5);
        return NULL;
1053
#       endif
1054
    } else {
1055
	return val;
1056
1057
1058
    }
}

1059
static
1060
__attribute((unused))
1061
1062
1063
void *
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
1064
    void *val;
1065
    initLinker() ;
1066
1067
1068
1069
1070
    val = lookupStrHashTable(oc->lochash, lbl);

    if (val == NULL) {
        return NULL;
    } else {
1071
	return val;
1072
1073
1074
1075
    }
}


1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
/* -----------------------------------------------------------------------------
 * 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;
1090
1091
1092

   initLinker();

1093
1094
1095
1096
   for (oc = objects; oc; oc = oc->next) {
      for (i = 0; i < oc->n_symbols; i++) {
         sym = oc->symbols[i];
         if (sym == NULL) continue;
1097
         // debugBelch("enquire %p %p\n", sym, oc->lochash);
1098
         a = NULL;
1099
         if (oc->lochash != NULL) {
1100
            a = lookupStrHashTable(oc->lochash, sym);
1101
1102
	 }
         if (a == NULL) {
1103
            a = lookupStrHashTable(symhash, sym);
1104
	 }
1105
         if (a == NULL) {
1106
	     // debugBelch("ghci_enquire: can't find %s\n", sym);
1107
         }
1108
         else if (addr-DELTA <= a && a <= addr+DELTA) {
1109
            debugBelch("%p + %3d  ==  `%s'\n", addr, (int)(a - addr), sym);
1110
1111
1112
1113
1114
1115
         }
      }
   }
}
#endif

1116
#ifdef ia64_HOST_ARCH
1117
1118
static unsigned int PLTSize(void);
#endif
1119

1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
/* -----------------------------------------------------------------------------
 * 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;
1131
1132
#ifdef USE_MMAP
   int fd, pagesize;
1133
   void *map_addr = NULL;
1134
#else
1135
   FILE *f;
1136
   int misalignment;
1137
#endif
1138
1139
   initLinker();

1140
   /* debugBelch("loadObj %s\n", path ); */
1141

dons's avatar
dons committed
1142
1143
   /* Check that we haven't already loaded this object. 
      Ignore requests to load multiple times */
1144
   {
1145
       ObjectCode *o;
1146
1147
       int is_dup = 0;
       for (o = objects; o; o = o->next) {
dons's avatar
dons committed
1148
          if (0 == strcmp(o->fileName, path)) {
1149
             is_dup = 1;
dons's avatar
dons committed
1150
1151
             break; /* don't need to search further */
          }
1152
1153
       }
       if (is_dup) {
1154
          IF_DEBUG(linker, debugBelch(
1155
1156
1157
            "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
1158
1159
1160
            "GHCi will ignore this, but be warned.\n"
            , path));
          return 1; /* success */
1161
       }
1162
1163
1164
1165
   }

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

1166
#  if defined(OBJFORMAT_ELF)
1167
   oc->formatName = "ELF";
1168
#  elif defined(OBJFORMAT_PEi386)
1169
   oc->formatName = "PEi386";
1170
1171
#  elif defined(OBJFORMAT_MACHO)
   oc->formatName = "Mach-O";
1172
#  else
sof's avatar
sof committed
1173
   stgFree(oc);
1174
1175
1176
1177
1178
1179
   barf("loadObj: not implemented on this platform");
#  endif

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

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

1184
1185
1186
   oc->fileSize          = st.st_size;
   oc->symbols           = NULL;
   oc->sections          = NULL;
1187
   oc->lochash           = allocStrHashTable();
1188
   oc->proddables        = NULL;
1189
1190
1191
1192
1193

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

1194
1195
1196
1197
1198
#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. */

1199
#if defined(openbsd_HOST_OS)
dons's avatar
dons committed
1200
1201
   fd = open(path, O_RDONLY, S_IRUSR);
#else
1202
   fd = open(path, O_RDONLY);
dons's avatar
dons committed
1203
#endif
1204
1205
1206
1207
1208
   if (fd == -1)
      barf("loadObj: can't open `%s'", path);

   pagesize = getpagesize();

1209
#ifdef ia64_HOST_ARCH
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
   /* 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);
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233

   /* Link objects into the lower 2Gb on x86_64.  GHC assumes the
    * small memory model on this architecture (see gcc docs,
    * -mcmodel=small).
    */
#ifdef x86_64_HOST_ARCH
#define EXTRA_MAP_FLAGS MAP_32BIT
#else
#define EXTRA_MAP_FLAGS 0
#endif

   oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, 
		    MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
matthewc's avatar