Linker.c 99.6 KB
Newer Older
1
/* -----------------------------------------------------------------------------
2
 * $Id: Linker.c,v 1.112 2003/01/29 09:54:32 simonmar Exp $
3
 *
4
 * (c) The GHC Team, 2000, 2001
5
6
7
8
9
 *
 * RTS Object Linker
 *
 * ---------------------------------------------------------------------------*/

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

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

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

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

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

sof's avatar
sof committed
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
#if defined(cygwin32_TARGET_OS)
#ifdef HAVE_DIRENT_H
#include <dirent.h>
#endif

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

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

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

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

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

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

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

100
101
102
103
104
105
typedef struct _RtsSymbolVal {
    char   *lbl;
    void   *addr;
} RtsSymbolVal;


106
107
108
109
110
111
112
113
114
115
116
#if !defined(PAR)
#define Maybe_ForeignObj        SymX(mkForeignObjzh_fast)

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

#if !defined (mingw32_TARGET_OS)
119
#define RTS_POSIX_ONLY_SYMBOLS                  \
120
121
      SymX(stg_sig_install)			\
      Sym(nocldstop)
sof's avatar
sof committed
122
#endif
123

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

sof's avatar
sof committed
212
213
214
215
216
217
#elif !defined(mingw32_TARGET_OS)
#define RTS_MINGW_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
#else /* defined(mingw32_TARGET_OS) */
#define RTS_POSIX_ONLY_SYMBOLS  /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
218
219
220

/* These are statically linked from the mingw libraries into the ghc
   executable, so we have to employ this hack. */
221
#define RTS_MINGW_ONLY_SYMBOLS                  \
222
      SymX(memset)                              \
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
      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)                              \
255
256
257
      SymX(memmove)                             \
      SymX(realloc)                             \
      SymX(malloc)                              \
258
259
260
261
262
263
264
265
266
267
268
269
270
271
      SymX(pow)                                 \
      SymX(tanh)                                \
      SymX(cosh)                                \
      SymX(sinh)                                \
      SymX(atan)                                \
      SymX(acos)                                \
      SymX(asin)                                \
      SymX(tan)                                 \
      SymX(cos)                                 \
      SymX(sin)                                 \
      SymX(exp)                                 \
      SymX(log)                                 \
      SymX(sqrt)                                \
      SymX(memcpy)                              \
272
      Sym(mktime)                               \
273
      Sym(_imp___timezone)                      \
274
      Sym(_imp___tzname)                        \
275
      Sym(_imp___iob)                           \
276
277
278
279
      Sym(localtime)                            \
      Sym(gmtime)                               \
      Sym(opendir)                              \
      Sym(readdir)                              \
sof's avatar
sof committed
280
      Sym(rewinddir)                            \
281
      Sym(closedir)                             \
sof's avatar
sof committed
282
283
284
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
sof's avatar
sof committed
285
      Sym(__umoddi3)
286
#endif
287

sof's avatar
sof committed
288
289
290
291
292
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
# define MAIN_CAP_SYM
#endif
293

294
#define RTS_SYMBOLS				\
295
296
297
      Maybe_ForeignObj				\
      Maybe_Stable_Names			\
      Sym(StgReturn)				\
298
299
300
      SymX(stg_enter_info)			\
      SymX(stg_enter_ret)			\
      SymX(stg_gc_void_info)			\
301
302
      SymX(__stg_gc_enter_1)			\
      SymX(stg_gc_noregs)			\
303
      SymX(stg_gc_unpt_r1_info)			\
304
      SymX(stg_gc_unpt_r1)			\
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
      SymX(stg_gc_unbx_r1_info)			\
      SymX(stg_gc_unbx_r1)			\
      SymX(stg_gc_f1_info)			\
      SymX(stg_gc_f1)				\
      SymX(stg_gc_d1_info)			\
      SymX(stg_gc_d1)				\
      SymX(stg_gc_l1_info)			\
      SymX(stg_gc_l1)				\
      SymX(__stg_gc_fun)			\
      SymX(stg_gc_fun_info)			\
      SymX(stg_gc_fun_ret)			\
      SymX(stg_gc_gen)				\
      SymX(stg_gc_gen_info)			\
      SymX(stg_gc_gen_hp)			\
      SymX(stg_gc_ut)				\
      SymX(stg_gen_yield)			\
      SymX(stg_yield_noregs)			\
322
      SymX(stg_yield_to_interpreter)		\
323
324
325
326
327
328
      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)			\
329
      SymX(ErrorHdrHook)			\
sof's avatar
sof committed
330
      MAIN_CAP_SYM                              \
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
      SymX(MallocFailHook)			\
      SymX(OnExitHook)				\
      SymX(OutOfHeapHook)			\
      SymX(PatErrorHdrHook)			\
      SymX(PostTraceHook)			\
      SymX(PreTraceHook)			\
      SymX(StackOverflowHook)			\
      SymX(__encodeDouble)			\
      SymX(__encodeFloat)			\
      SymX(__gmpn_gcd_1)			\
      SymX(__gmpz_cmp)				\
      SymX(__gmpz_cmp_si)			\
      SymX(__gmpz_cmp_ui)			\
      SymX(__gmpz_get_si)			\
      SymX(__gmpz_get_ui)			\
      SymX(__int_encodeDouble)			\
      SymX(__int_encodeFloat)			\
      SymX(andIntegerzh_fast)			\
      SymX(blockAsyncExceptionszh_fast)		\
      SymX(catchzh_fast)			\
      SymX(cmp_thread)				\
      SymX(complementIntegerzh_fast)		\
sof's avatar
sof committed
353
354
      SymX(cmpIntegerzh_fast)	        	\
      SymX(cmpIntegerIntzh_fast)	      	\
355
356
357
358
359
      SymX(createAdjustor)			\
      SymX(decodeDoublezh_fast)			\
      SymX(decodeFloatzh_fast)			\
      SymX(defaultsHook)			\
      SymX(delayzh_fast)			\
sof's avatar
sof committed
360
361
      SymX(deRefWeakzh_fast)			\
      SymX(deRefStablePtrzh_fast)		\
362
363
364
      SymX(divExactIntegerzh_fast)		\
      SymX(divModIntegerzh_fast)		\
      SymX(forkzh_fast)				\
365
      SymX(forkProcesszh_fast)                  \
366
      SymX(freeHaskellFunctionPtr)		\
sof's avatar
sof committed
367
      SymX(freeStablePtr)		        \
368
      SymX(gcdIntegerzh_fast)			\
sof's avatar
sof committed
369
370
      SymX(gcdIntegerIntzh_fast)		\
      SymX(gcdIntzh_fast)			\
371
372
373
      SymX(getProgArgv)				\
      SymX(getStablePtr)			\
      SymX(int2Integerzh_fast)			\
sof's avatar
sof committed
374
375
      SymX(integer2Intzh_fast)			\
      SymX(integer2Wordzh_fast)			\
376
377
378
379
      SymX(isDoubleDenormalized)		\
      SymX(isDoubleInfinite)			\
      SymX(isDoubleNaN)				\
      SymX(isDoubleNegativeZero)		\
sof's avatar
sof committed
380
      SymX(isEmptyMVarzh_fast)			\
381
382
383
384
385
      SymX(isFloatDenormalized)			\
      SymX(isFloatInfinite)			\
      SymX(isFloatNaN)				\
      SymX(isFloatNegativeZero)			\
      SymX(killThreadzh_fast)			\
sof's avatar
sof committed
386
      SymX(makeStablePtrzh_fast)		\
387
388
      SymX(minusIntegerzh_fast)			\
      SymX(mkApUpd0zh_fast)			\
sof's avatar
sof committed
389
      SymX(myThreadIdzh_fast)			\
390
      SymX(labelThreadzh_fast)                  \
391
392
393
      SymX(newArrayzh_fast)			\
      SymX(newBCOzh_fast)			\
      SymX(newByteArrayzh_fast)			\
394
      SymX_redirect(newCAF, newDynCAF)		\
395
396
      SymX(newMVarzh_fast)			\
      SymX(newMutVarzh_fast)			\
397
      SymX(atomicModifyMutVarzh_fast)		\
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
      SymX(newPinnedByteArrayzh_fast)		\
      SymX(orIntegerzh_fast)			\
      SymX(performGC)				\
      SymX(plusIntegerzh_fast)			\
      SymX(prog_argc)				\
      SymX(prog_argv)				\
      SymX(putMVarzh_fast)			\
      SymX(quotIntegerzh_fast)			\
      SymX(quotRemIntegerzh_fast)		\
      SymX(raisezh_fast)			\
      SymX(remIntegerzh_fast)			\
      SymX(resetNonBlockingFd)			\
      SymX(resumeThread)			\
      SymX(rts_apply)				\
      SymX(rts_checkSchedStatus)		\
      SymX(rts_eval)				\
      SymX(rts_evalIO)				\
      SymX(rts_evalLazyIO)			\
      SymX(rts_eval_)				\
      SymX(rts_getBool)				\
      SymX(rts_getChar)				\
      SymX(rts_getDouble)			\
      SymX(rts_getFloat)			\
      SymX(rts_getInt)				\
      SymX(rts_getInt32)			\
      SymX(rts_getPtr)				\
      SymX(rts_getStablePtr)			\
425
      SymX(rts_getThreadId)			\
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
      SymX(rts_getWord)				\
      SymX(rts_getWord32)			\
      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)				\
      SymX(rts_mkStablePtr)			\
      SymX(rts_mkString)			\
      SymX(rts_mkWord)				\
      SymX(rts_mkWord16)			\
      SymX(rts_mkWord32)			\
      SymX(rts_mkWord64)			\
      SymX(rts_mkWord8)				\
      SymX(run_queue_hd)			\
446
      SymX(setProgArgv)				\
447
448
      SymX(startupHaskell)			\
      SymX(shutdownHaskell)			\
449
450
451
452
453
454
455
456
457
458
      SymX(shutdownHaskellAndExit)		\
      SymX(stable_ptr_table)			\
      SymX(stackOverflow)			\
      SymX(stg_CAF_BLACKHOLE_info)		\
      SymX(stg_CHARLIKE_closure)		\
      SymX(stg_EMPTY_MVAR_info)			\
      SymX(stg_IND_STATIC_info)			\
      SymX(stg_INTLIKE_closure)			\
      SymX(stg_MUT_ARR_PTRS_FROZEN_info)	\
      SymX(stg_WEAK_info)                       \
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
      SymX(stg_ap_v_info)			\
      SymX(stg_ap_f_info)			\
      SymX(stg_ap_d_info)			\
      SymX(stg_ap_l_info)			\
      SymX(stg_ap_n_info)			\
      SymX(stg_ap_p_info)			\
      SymX(stg_ap_pv_info)			\
      SymX(stg_ap_pp_info)			\
      SymX(stg_ap_ppv_info)			\
      SymX(stg_ap_ppp_info)			\
      SymX(stg_ap_pppp_info)			\
      SymX(stg_ap_ppppp_info)			\
      SymX(stg_ap_pppppp_info)			\
      SymX(stg_ap_ppppppp_info)			\
      SymX(stg_ap_0_ret)			\
      SymX(stg_ap_v_ret)			\
      SymX(stg_ap_f_ret)			\
      SymX(stg_ap_d_ret)			\
      SymX(stg_ap_l_ret)			\
      SymX(stg_ap_n_ret)			\
      SymX(stg_ap_p_ret)			\
      SymX(stg_ap_pv_ret)			\
      SymX(stg_ap_pp_ret)			\
      SymX(stg_ap_ppv_ret)			\
      SymX(stg_ap_ppp_ret)			\
      SymX(stg_ap_pppp_ret)			\
      SymX(stg_ap_ppppp_ret)			\
      SymX(stg_ap_pppppp_ret)			\
      SymX(stg_ap_ppppppp_ret)			\
488
      SymX(stg_ap_1_upd_info)			\
489
490
491
492
493
494
495
      SymX(stg_ap_2_upd_info)			\
      SymX(stg_ap_3_upd_info)			\
      SymX(stg_ap_4_upd_info)			\
      SymX(stg_ap_5_upd_info)			\
      SymX(stg_ap_6_upd_info)			\
      SymX(stg_ap_7_upd_info)			\
      SymX(stg_ap_8_upd_info)			\
496
      SymX(stg_exit)				\
497
      SymX(stg_sel_0_upd_info)			\
498
499
500
501
502
503
      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)			\
504
505
506
507
508
509
510
511
512
      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)			\
513
514
      SymX(stg_upd_frame_info)			\
      SymX(suspendThread)			\
515
      SymX(takeMVarzh_fast)			\
516
      SymX(timesIntegerzh_fast)			\
517
      SymX(tryPutMVarzh_fast)			\
518
519
520
      SymX(tryTakeMVarzh_fast)			\
      SymX(unblockAsyncExceptionszh_fast)	\
      SymX(unsafeThawArrayzh_fast)		\
521
522
      SymX(waitReadzh_fast)			\
      SymX(waitWritezh_fast)			\
523
524
      SymX(word2Integerzh_fast)			\
      SymX(xorIntegerzh_fast)			\
525
      SymX(yieldzh_fast)
526

527
#ifdef SUPPORT_LONG_LONGS
528
#define RTS_LONG_LONG_SYMS			\
529
530
      SymX(int64ToIntegerzh_fast)		\
      SymX(word64ToIntegerzh_fast)
531
532
533
534
535
536
537
538
#else
#define RTS_LONG_LONG_SYMS /* nothing */
#endif

#ifdef ia64_TARGET_ARCH
/* force these symbols to be present */
#define RTS_EXTRA_SYMBOLS			\
      Sym(__divsf3)
539
#elif defined(powerpc_TARGET_ARCH)
540
#define RTS_EXTRA_SYMBOLS                	\
541
542
543
      Sym(__divdi3)                             \
      Sym(__udivdi3)                            \
      Sym(__moddi3)                             \
544
545
546
547
548
      Sym(__umoddi3)				\
      Sym(__ashldi3)				\
      Sym(__ashrdi3)				\
      Sym(__lshrdi3)				\
      Sym(__eprintf)
549
550
551
#else
#define RTS_EXTRA_SYMBOLS /* nothing */
#endif
552
553
554
555

/* entirely bogus claims about types of these symbols */
#define Sym(vvv)  extern void (vvv);
#define SymX(vvv) /**/
556
#define SymX_redirect(vvv,xxx) /**/
557
RTS_SYMBOLS
558
RTS_LONG_LONG_SYMS
559
RTS_EXTRA_SYMBOLS
560
RTS_POSIX_ONLY_SYMBOLS
561
RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
562
RTS_CYGWIN_ONLY_SYMBOLS
563
564
#undef Sym
#undef SymX
565
#undef SymX_redirect
566
567
568
569
570
571
572
573
574
575
576

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

577
578
579
580
581
582
// 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)) },

583
static RtsSymbolVal rtsSyms[] = {
584
      RTS_SYMBOLS
585
      RTS_LONG_LONG_SYMS
586
      RTS_EXTRA_SYMBOLS
587
      RTS_POSIX_ONLY_SYMBOLS
588
      RTS_MINGW_ONLY_SYMBOLS
sof's avatar
sof committed
589
      RTS_CYGWIN_ONLY_SYMBOLS
590
591
592
      { 0, 0 } /* sentinel */
};

593
594
595
596
597
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
 */
static void ghciInsertStrHashTable ( char* obj_name,
                                     HashTable *table,
598
                                     char* key,
599
600
601
602
603
604
605
606
                                     void *data
				   )
{
   if (lookupHashTable(table, (StgWord)key) == NULL)
   {
      insertStrHashTable(table, (StgWord)key, data);
      return;
   }
607
   fprintf(stderr,
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
      "\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);
}


627
628
629
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
630
631
632
633


static int linker_init_done = 0 ;

634
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
635
static void *dl_prog_handle;
636
#endif
637
638
639
640

void
initLinker( void )
{
641
    RtsSymbolVal *sym;
642

643
644
645
646
647
648
649
    /* 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;
    }

650
651
652
653
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
654
655
	ghciInsertStrHashTable("(GHCi built-in symbols)",
                               symhash, sym->lbl, sym->addr);
656
    }
657
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
658
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
659
#   endif
660
661
}

662
/* -----------------------------------------------------------------------------
663
664
665
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
666
667
668
669
 * 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
670
671
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
672
 * In the PEi386 case, open the DLLs and put handles to them in a
673
 * linked list.  When looking for a symbol, try all handles in the
674
675
676
677
678
679
 * 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.
 * 
680
 */
681
682
683
684
685
686

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

typedef
   struct _OpenedDLL {
687
      char*              name;
688
689
      struct _OpenedDLL* next;
      HINSTANCE instance;
690
   }
691
692
693
694
695
696
   OpenedDLL;

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

697
698
char *
addDLL( char *dll_name )
699
{
700
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
701
   /* ------------------- ELF DLL loader ------------------- */
702
   void *hdl;
703
   char *errmsg;
704

705
706
   initLinker();

707
   hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
708
709
710
711
712
713
714
715
   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;
   }
716
717
   /*NOTREACHED*/

718
#  elif defined(OBJFORMAT_PEi386)
719
   /* ------------------- Win32 DLL loader ------------------- */
720

721
   char*      buf;
722
   OpenedDLL* o_dll;
723
   HINSTANCE  instance;
724

725
726
727
   initLinker();

   /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
728
729
730
731
732

   /* 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;
733
734
   }

735
736
737
738
739
740
741
742
743
744
   /* 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. */

745
   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
746
747
748
   sprintf(buf, "%s.DLL", dll_name);
   instance = LoadLibrary(buf);
   if (instance == NULL) {
749
	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
750
751
752
753
754
755
756
	 instance = LoadLibrary(buf);
	 if (instance == NULL) {
		free(buf);

	    /* LoadLibrary failed; return a ptr to the error msg. */
	    return "addDLL: unknown error";
   	 }
757
   }
758
   free(buf);
759

760
   /* Add this DLL to the list of DLLs in which to search for symbols. */
761
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
762
763
   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
   strcpy(o_dll->name, dll_name);
764
   o_dll->instance = instance;
765
766
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
767
768

   return NULL;
769
770
771
772
773
#  else
   barf("addDLL: not implemented on this platform");
#  endif
}

774
775
/* -----------------------------------------------------------------------------
 * lookup a symbol in the hash table
776
 */
777
778
779
void *
lookupSymbol( char *lbl )
{
780
    void *val;
781
    initLinker() ;
782
    ASSERT(symhash != NULL);
783
784
785
    val = lookupStrHashTable(symhash, lbl);

    if (val == NULL) {
786
#       if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
787
	return dlsym(dl_prog_handle, lbl);
788
#       elif defined(OBJFORMAT_PEi386)
789
790
791
        OpenedDLL* o_dll;
        void* sym;
        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
sof's avatar
sof committed
792
	  /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
793
794
795
796
797
798
799
           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
800
801
802
              if (sym != NULL) {
		/*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
		return sym;
803
	      }
804
           }
805
           sym = GetProcAddress(o_dll->instance, lbl);
sof's avatar
sof committed
806
807
808
809
           if (sym != NULL) {
	     /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
	     return sym;
	   }
810
        }
811
        return NULL;
ken's avatar
ken committed
812
813
814
#       else
        ASSERT(2+2 == 5);
        return NULL;
815
#       endif
816
    } else {
817
	return val;
818
819
820
    }
}

821
static
822
__attribute((unused))
823
824
825
void *
lookupLocalSymbol( ObjectCode* oc, char *lbl )
{
826
    void *val;
827
    initLinker() ;
828
829
830
831
832
    val = lookupStrHashTable(oc->lochash, lbl);

    if (val == NULL) {
        return NULL;
    } else {
833
	return val;
834
835
836
837
    }
}


838
839
840
841
842
843
844
845
846
847
848
849
850
851
/* -----------------------------------------------------------------------------
 * 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;
852
853
854

   initLinker();

855
856
857
858
   for (oc = objects; oc; oc = oc->next) {
      for (i = 0; i < oc->n_symbols; i++) {
         sym = oc->symbols[i];
         if (sym == NULL) continue;
859
         // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
860
         a = NULL;
861
         if (oc->lochash != NULL) {
862
            a = lookupStrHashTable(oc->lochash, sym);
863
864
	 }
         if (a == NULL) {
865
            a = lookupStrHashTable(symhash, sym);
866
	 }
867
         if (a == NULL) {
868
	     // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
869
         }
870
871
872
873
874
875
876
877
         else if (addr-DELTA <= a && a <= addr+DELTA) {
            fprintf(stderr, "%p + %3d  ==  `%s'\n", addr, a - addr, sym);
         }
      }
   }
}
#endif

878
879
880
#ifdef ia64_TARGET_ARCH
static unsigned int PLTSize(void);
#endif
881

882
883
884
885
886
887
888
889
890
891
892
/* -----------------------------------------------------------------------------
 * 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;
893
894
895
896
#ifdef USE_MMAP
   int fd, pagesize;
   void *map_addr;
#else
897
   FILE *f;
898
#endif
899

900
901
   initLinker();

902
   /* fprintf(stderr, "loadObj %s\n", path ); */
903
904
905

   /* Check that we haven't already loaded this object.  Don't give up
      at this stage; ocGetNames_* will barf later. */
906
   {
907
       ObjectCode *o;
908
909
910
911
912
913
       int is_dup = 0;
       for (o = objects; o; o = o->next) {
          if (0 == strcmp(o->fileName, path))
             is_dup = 1;
       }
       if (is_dup) {
914
	 fprintf(stderr,
915
916
917
918
919
920
921
922
            "\n\n"
            "GHCi runtime linker: warning: looks like you're trying to load the\n"
            "same object file twice:\n"
            "   %s\n"
            "GHCi will continue, but a duplicate-symbol error may shortly follow.\n"
            "\n"
            , path);
       }
923
924
925
926
   }

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

927
#  if defined(OBJFORMAT_ELF)
928
   oc->formatName = "ELF";
929
#  elif defined(OBJFORMAT_PEi386)
930
   oc->formatName = "PEi386";
931
932
#  elif defined(OBJFORMAT_MACHO)
   oc->formatName = "Mach-O";
933
934
935
936
937
938
939
940
#  else
   free(oc);
   barf("loadObj: not implemented on this platform");
#  endif

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

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

945
946
947
   oc->fileSize          = st.st_size;
   oc->symbols           = NULL;
   oc->sections          = NULL;
948
   oc->lochash           = allocStrHashTable();
949
   oc->proddables        = NULL;
950
951
952
953
954

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

955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
#ifdef USE_MMAP
#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))

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

   fd = open(path, O_RDONLY);
   if (fd == -1)
      barf("loadObj: can't open `%s'", path);

   pagesize = getpagesize();

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

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

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

   close(fd);

#else /* !USE_MMAP */

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

988
989
   /* load the image into memory */
   f = fopen(path, "rb");
990
   if (!f)
991
       barf("loadObj: can't read `%s'", path);
992

993
   n = fread ( oc->image, 1, oc->fileSize, f );
994
   if (n != oc->fileSize)
995
      barf("loadObj: error whilst reading `%s'", path);
996
997
998
999

   fclose(f);

#endif /* USE_MMAP */
1000