Linker.c 136 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
/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14
15
   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 "Sparks.h"
ei@vuokko.info's avatar
ei@vuokko.info committed
29
#include "RtsTypeable.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
/* Hash table mapping symbol names to StgStablePtr */
static /*Str*/HashTable *stablehash;

98
99
100
/* List of currently loaded objects */
ObjectCode *objects = NULL;	/* initially empty */

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

117
static int machoGetMisalignment( FILE * );
118
119
#ifdef powerpc_HOST_ARCH
static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
120
static void machoInitSymbolsWithoutUnderscore( void );
121
#endif
122
#endif
123

124
125
126
127
#if defined(x86_64_HOST_ARCH)
static void*x86_64_high_symbol( char *lbl, void *addr );
#endif

128
129
130
131
/* -----------------------------------------------------------------------------
 * Built-in symbols from the RTS
 */

132
133
134
135
136
137
typedef struct _RtsSymbolVal {
    char   *lbl;
    void   *addr;
} RtsSymbolVal;


138
139
140
141
142
143
144
145
#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
146

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

154
#if defined (cygwin32_HOST_OS)
sof's avatar
sof committed
155
156
157
#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
158
 * exports; sigh.
sof's avatar
sof committed
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
233
234
235
 */
#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)                               \
236
      SymX(waitpid)
237

238
#elif !defined(mingw32_HOST_OS)
sof's avatar
sof committed
239
240
#define RTS_MINGW_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
241
#else /* defined(mingw32_HOST_OS) */
sof's avatar
sof committed
242
243
#define RTS_POSIX_ONLY_SYMBOLS  /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
244

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

254
255
/* These are statically linked from the mingw libraries into the ghc
   executable, so we have to employ this hack. */
256
#define RTS_MINGW_ONLY_SYMBOLS                  \
sof's avatar
sof committed
257
258
      SymX(asyncReadzh_fast)			\
      SymX(asyncWritezh_fast)			\
sof's avatar
sof committed
259
      SymX(asyncDoProczh_fast)			\
260
      SymX(memset)                              \
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
290
291
292
      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)                              \
293
294
295
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
296
297
298
299
300
301
302
303
304
305
306
307
308
      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)                                \
309
310
311
312
313
314
315
316
317
318
319
320
321
      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)                                \
322
      SymX(memcpy)                              \
sof's avatar
sof committed
323
324
      SymX(rts_InstallConsoleEvent)             \
      SymX(rts_ConsoleHandlerDone)              \
325
      Sym(mktime)                               \
326
      Sym(_imp___timezone)                      \
327
      Sym(_imp___tzname)                        \
328
      Sym(_imp__tzname)                         \
329
      Sym(_imp___iob)                           \
sof's avatar
sof committed
330
      Sym(_imp___osver)                         \
331
332
333
334
      Sym(localtime)                            \
      Sym(gmtime)                               \
      Sym(opendir)                              \
      Sym(readdir)                              \
sof's avatar
sof committed
335
      Sym(rewinddir)                            \
336
      RTS_MINGW_EXTRA_SYMS                      \
337
      Sym(closedir)
338
#endif
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
386
387
388
389
#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
390
391
392
393
394
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
395

sof's avatar
sof committed
396
397
398
399
#if !defined(mingw32_HOST_OS)
#define RTS_USER_SIGNALS_SYMBOLS \
   SymX(setIOManagerPipe)
#else
Simon Marlow's avatar
Simon Marlow committed
400
401
402
403
404
#define RTS_USER_SIGNALS_SYMBOLS \
   SymX(sendIOManagerEvent) \
   SymX(readIOManagerEvent) \
   SymX(getIOManagerEvent) \
   SymX(console_handler)
sof's avatar
sof committed
405
406
#endif

407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
#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

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

716
#ifdef SUPPORT_LONG_LONGS
717
#define RTS_LONG_LONG_SYMS			\
718
719
      SymX(int64ToIntegerzh_fast)		\
      SymX(word64ToIntegerzh_fast)
720
721
722
723
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif

724
725
726
// 64-bit support functions in libgcc.a
#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
#define RTS_LIBGCC_SYMBOLS			\
727
728
729
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
730
      Sym(__umoddi3)				\
731
      Sym(__muldi3)				\
732
733
734
735
      Sym(__ashldi3)				\
      Sym(__ashrdi3)				\
      Sym(__lshrdi3)				\
      Sym(__eprintf)
736
#elif defined(ia64_HOST_ARCH)
737
738
739
740
741
742
743
#define RTS_LIBGCC_SYMBOLS			\
      Sym(__divdi3)				\
      Sym(__udivdi3)                            \
      Sym(__moddi3)				\
      Sym(__umoddi3)				\
      Sym(__divsf3)				\
      Sym(__divdf3)
744
745
746
747
#else
#define RTS_LIBGCC_SYMBOLS
#endif

748
#if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
749
750
751
752
753
754
      // 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)
755
#endif
756
757

/* entirely bogus claims about types of these symbols */
758
#define Sym(vvv)  extern void vvv(void);
759
#define SymX(vvv) /**/
760
#define SymX_redirect(vvv,xxx) /**/
761
RTS_SYMBOLS
762
RTS_RET_SYMBOLS
763
RTS_LONG_LONG_SYMS
764
RTS_POSIX_ONLY_SYMBOLS
765
RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
766
RTS_CYGWIN_ONLY_SYMBOLS
767
RTS_DARWIN_ONLY_SYMBOLS
768
RTS_LIBGCC_SYMBOLS
769
770
#undef Sym
#undef SymX
771
#undef SymX_redirect
772
773
774
775
776
777
778
779
780
781
782

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

783
784
785
786
787
788
// 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)) },

789
static RtsSymbolVal rtsSyms[] = {
790
      RTS_SYMBOLS
791
      RTS_RET_SYMBOLS
792
      RTS_LONG_LONG_SYMS
793
      RTS_POSIX_ONLY_SYMBOLS
794
      RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
795
      RTS_CYGWIN_ONLY_SYMBOLS
796
      RTS_DARWIN_ONLY_SYMBOLS
797
      RTS_LIBGCC_SYMBOLS
798
799
800
801
#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.
802
      { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
803
#endif
804
805
806
      { 0, 0 } /* sentinel */
};

807
808
809



810
811
812
813
814
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
 */
static void ghciInsertStrHashTable ( char* obj_name,
                                     HashTable *table,
815
                                     char* key,
816
817
818
819
820
821
822
823
                                     void *data
				   )
{
   if (lookupHashTable(table, (StgWord)key) == NULL)
   {
      insertStrHashTable(table, (StgWord)key, data);
      return;
   }
824
   debugBelch(
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
      "\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);
}


844
845
846
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
847
848
849
850


static int linker_init_done = 0 ;

851
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
852
static void *dl_prog_handle;
853
#endif
854
855
856
857

void
initLinker( void )
{
858
    RtsSymbolVal *sym;
859

860
861
862
863
864
865
866
    /* 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;
    }

867
    stablehash = allocStrHashTable();
868
869
870
871
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
872
873
	ghciInsertStrHashTable("(GHCi built-in symbols)",
                               symhash, sym->lbl, sym->addr);
874
    }
875
#   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
876
877
878
    machoInitSymbolsWithoutUnderscore();
#   endif

879
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
880
#   if defined(RTLD_DEFAULT)
881
882
    dl_prog_handle = RTLD_DEFAULT;
#   else
883
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
884
#   endif /* RTLD_DEFAULT */
885
#   endif
886
887
}

888
/* -----------------------------------------------------------------------------
889
890
891
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
892
893
894
895
 * 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
896
897
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
898
 * In the PEi386 case, open the DLLs and put handles to them in a
899
 * linked list.  When looking for a symbol, try all handles in the
900
901
902
903
904
 * 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.
905
 *
906
 */
907
908
909
910
911
912

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

typedef
   struct _OpenedDLL {
913
      char*              name;
914
915
      struct _OpenedDLL* next;
      HINSTANCE instance;
916
   }
917
918
919
920
921
922
   OpenedDLL;

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

923
924
char *
addDLL( char *dll_name )
925
{
926
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
927
   /* ------------------- ELF DLL loader ------------------- */
928
   void *hdl;
929
   char *errmsg;
930

931
932
   initLinker();

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

935
936
937
938
939
940
941
942
   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;
   }
943
944
   /*NOTREACHED*/

945
#  elif defined(OBJFORMAT_PEi386)
946
   /* ------------------- Win32 DLL loader ------------------- */
947

948
   char*      buf;
949
   OpenedDLL* o_dll;
950
   HINSTANCE  instance;
951

952
953
   initLinker();

954
   /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
955
956
957
958
959

   /* 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;
960
961
   }

962
963
964
965
966
967
968
969
970
971
   /* 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. */

972
   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
973
974
975
   sprintf(buf, "%s.DLL", dll_name);
   instance = LoadLibrary(buf);
   if (instance == NULL) {
976
	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
977
978
	 instance = LoadLibrary(buf);
	 if (instance == NULL) {
sof's avatar
sof committed
979
		stgFree(buf);
980
981
982
983

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

987
   /* Add this DLL to the list of DLLs in which to search for symbols. */
988
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
989
990
   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
   strcpy(o_dll->name, dll_name);
991
   o_dll->instance = instance;
992
993
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
994
995

   return NULL;
996
997
998
999
1000
#  else
   barf("addDLL: not implemented on this platform");
#  endif
}

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
/* -----------------------------------------------------------------------------
 * insert a stable symbol in the hash table
 */

void
insertStableSymbol(char* obj_name, char* key, StgPtr p)
{
  ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
}


/* -----------------------------------------------------------------------------
 * insert a symbol in the hash table
 */
void
insertSymbol(char* obj_name, char* key, void* data)
{
  ghciInsertStrHashTable(obj_name, symhash, key, data);
}

1021
1022
/* -----------------------------------------------------------------------------
 * lookup a symbol in the hash table
1023
 */
1024
1025
1026
void *
lookupSymbol( char *lbl )
{
1027
    void *val;
1028
    initLinker() ;
1029
    ASSERT(symhash != NULL);
1030
1031
1032
    val = lookupStrHashTable(symhash, lbl);

    if (val == NULL) {
1033
#       if defined(OBJFORMAT_ELF)
1034
#	if defined(x86_64_HOST_ARCH)
1035
1036
1037
1038
1039
1040
1041
1042
1043
	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;
	}
1044
#	else
1045
	return dlsym(dl_prog_handle, lbl);
dons's avatar
dons committed
1046
#	endif
1047
1048
1049
1050
1051
1052
1053
#       elif defined(OBJFORMAT_MACHO)
	if(NSIsSymbolNameDefined(lbl)) {
	    NSSymbol symbol = NSLookupAndBindSymbol(lbl);
	    return NSAddressOfSymbol(symbol);
	} else {
	    return NULL;
	}
1054
#       elif defined(OBJFORMAT_PEi386)
1055
1056
1057
        OpenedDLL* o_dll;
        void* sym;
        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
1058
	  /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
1059
1060
1061
1062
1063
1064
1065
           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
1066
              if (sym != NULL) {
1067
		/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
sof's avatar
sof committed
1068
		return sym;
1069
	      }
1070
           }
1071
           sym = GetProcAddress(o_dll->instance, lbl);
sof's avatar
sof committed
1072
           if (sym != NULL) {
1073
	     /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
sof's avatar
sof committed
1074
1075
	     return sym;
	   }
1076
        }
1077
        return NULL;
ken's avatar
ken committed
1078
1079
1080
#       else
        ASSERT(2+2 == 5);
        return NULL;
1081
#       endif
1082
    } else {
1083
	return val;
1084
1085
1086
    }
}

1087
static
1088
__attribute((unused))
1089
1090
1091
void *
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
1092
    void *val;
1093
    initLinker() ;
1094
1095
1096
1097
1098
    val = lookupStrHashTable(oc->lochash, lbl);

    if (val == NULL) {
        return NULL;
    } else {
1099
	return val;
1100
1101
1102
1103
    }
}


1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
/* -----------------------------------------------------------------------------
 * 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;
1118
1119
1120

   initLinker();

1121
1122
1123
1124
   for (oc = objects; oc; oc = oc->next) {
      for (i = 0; i < oc->n_symbols; i++) {
         sym = oc->symbols[i];
         if (sym == NULL) continue;
1125
         // debugBelch("enquire %p %p\n", sym, oc->lochash);
1126
         a = NULL;
1127
         if (oc->lochash != NULL) {
1128
            a = lookupStrHashTable(oc->lochash, sym);
1129
1130
	 }
         if (a == NULL) {
1131
            a = lookupStrHashTable(symhash, sym);
1132
	 }
1133
         if (a == NULL) {
1134
	     // debugBelch("ghci_enquire: can't find %s\n", sym);
1135
         }
1136
         else if (addr-DELTA <= a && a <= addr+DELTA) {
1137
            debugBelch("%p + %3d  ==  `%s'\n", addr, (int)(a - addr), sym);
1138
1139
1140
1141
1142
1143
         }
      }
   }
}
#endif

1144
#ifdef ia64_HOST_ARCH
1145
1146
static unsigned int PLTSize(void);
#endif
1147

1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
/* -----------------------------------------------------------------------------
 * 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;
1159
1160
#ifdef USE_MMAP
   int fd, pagesize;
1161
   void *map_addr = NULL;
1162
#else
1163
   FILE *f;
1164
#endif
1165
1166
   initLinker();

1167
   /* debugBelch("loadObj %s\n", path ); */
1168

1169
   /* Check that we haven't already loaded this object.
dons's avatar
dons committed
1170
      Ignore requests to load multiple times */
1171
   {
1172
       ObjectCode *o;
1173
1174
       int is_dup = 0;
       for (o = objects; o; o = o->next) {
dons's avatar
dons committed
1175
          if (0 == strcmp(o->fileName, path)) {
1176
             is_dup = 1;
dons's avatar
dons committed
1177
1178
             break; /* don't need to search further */
          }
1179
1180
       }
       if (is_dup) {
1181
          IF_DEBUG(linker, debugBelch(
1182
1183
1184
            "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
1185
1186
1187
            "GHCi will ignore this, but be warned.\n"
            , path));
          return 1; /* success */
1188
       }
1189
1190
1191
1192
   }

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

1193
#  if defined(OBJFORMAT_ELF)
1194
   oc->formatName = "ELF";
1195
#  elif defined(OBJFORMAT_PEi386)
1196
   oc->formatName = "PEi386";
1197
1198
#  elif defined(OBJFORMAT_MACHO)
   oc->formatName = "Mach-O";
1199
#  else
sof's avatar
sof committed
1200
   stgFree(oc);
1201
1202
1203
1204
1205
1206
   barf("loadObj: not implemented on this platform");
#  endif

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

1207
   /* sigh, strdup() isn't a POSIX function, so do it the long way */