[project @ 2005-07-15 02:00:15 by wolfgang]
[ghc.git] / ghc / rts / Linker.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 2000-2004
4 *
5 * RTS Object Linker
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #if 0
10 #include "PosixSource.h"
11 #endif
12
13 /* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
14 MREMAP_MAYMOVE from <sys/mman.h>.
15 */
16 #ifdef __linux__
17 #define _GNU_SOURCE
18 #endif
19
20 #include "Rts.h"
21 #include "RtsFlags.h"
22 #include "HsFFI.h"
23 #include "Hash.h"
24 #include "Linker.h"
25 #include "LinkerInternals.h"
26 #include "RtsUtils.h"
27 #include "Schedule.h"
28 #include "Storage.h"
29
30 #ifdef HAVE_SYS_TYPES_H
31 #include <sys/types.h>
32 #endif
33
34 #include <stdlib.h>
35 #include <string.h>
36
37 #ifdef HAVE_SYS_STAT_H
38 #include <sys/stat.h>
39 #endif
40
41 #if defined(HAVE_DLFCN_H)
42 #include <dlfcn.h>
43 #endif
44
45 #if defined(cygwin32_HOST_OS)
46 #ifdef HAVE_DIRENT_H
47 #include <dirent.h>
48 #endif
49
50 #ifdef HAVE_SYS_TIME_H
51 #include <sys/time.h>
52 #endif
53 #include <regex.h>
54 #include <sys/fcntl.h>
55 #include <sys/termios.h>
56 #include <sys/utime.h>
57 #include <sys/utsname.h>
58 #include <sys/wait.h>
59 #endif
60
61 #if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
62 #define USE_MMAP
63 #include <fcntl.h>
64 #include <sys/mman.h>
65
66 #if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
67 #ifdef HAVE_UNISTD_H
68 #include <unistd.h>
69 #endif
70 #endif
71
72 #endif
73
74 #if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
75 # define OBJFORMAT_ELF
76 #elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
77 # define OBJFORMAT_PEi386
78 # include <windows.h>
79 # include <math.h>
80 #elif defined(darwin_HOST_OS)
81 # define OBJFORMAT_MACHO
82 # include <mach-o/loader.h>
83 # include <mach-o/nlist.h>
84 # include <mach-o/reloc.h>
85 # include <mach-o/dyld.h>
86 #if defined(powerpc_HOST_ARCH)
87 # include <mach-o/ppc/reloc.h>
88 #endif
89 #endif
90
91 /* Hash table mapping symbol names to Symbol */
92 static /*Str*/HashTable *symhash;
93
94 /* List of currently loaded objects */
95 ObjectCode *objects = NULL; /* initially empty */
96
97 #if defined(OBJFORMAT_ELF)
98 static int ocVerifyImage_ELF ( ObjectCode* oc );
99 static int ocGetNames_ELF ( ObjectCode* oc );
100 static int ocResolve_ELF ( ObjectCode* oc );
101 #if defined(powerpc_HOST_ARCH)
102 static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
103 #endif
104 #elif defined(OBJFORMAT_PEi386)
105 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
106 static int ocGetNames_PEi386 ( ObjectCode* oc );
107 static int ocResolve_PEi386 ( ObjectCode* oc );
108 #elif defined(OBJFORMAT_MACHO)
109 static int ocVerifyImage_MachO ( ObjectCode* oc );
110 static int ocGetNames_MachO ( ObjectCode* oc );
111 static int ocResolve_MachO ( ObjectCode* oc );
112
113 static int machoGetMisalignment( FILE * );
114 #ifdef powerpc_HOST_ARCH
115 static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
116 static void machoInitSymbolsWithoutUnderscore( void );
117 #endif
118 #endif
119
120 #if defined(x86_64_HOST_ARCH)
121 static void*x86_64_high_symbol( char *lbl, void *addr );
122 #endif
123
124 /* -----------------------------------------------------------------------------
125 * Built-in symbols from the RTS
126 */
127
128 typedef struct _RtsSymbolVal {
129 char *lbl;
130 void *addr;
131 } RtsSymbolVal;
132
133
134 #if !defined(PAR)
135 #define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
136
137 #define Maybe_Stable_Names SymX(mkWeakzh_fast) \
138 SymX(makeStableNamezh_fast) \
139 SymX(finalizzeWeakzh_fast)
140 #else
141 /* These are not available in GUM!!! -- HWL */
142 #define Maybe_ForeignObj
143 #define Maybe_Stable_Names
144 #endif
145
146 #if !defined (mingw32_HOST_OS)
147 #define RTS_POSIX_ONLY_SYMBOLS \
148 SymX(stg_sig_install) \
149 Sym(nocldstop)
150 #endif
151
152 #if defined (cygwin32_HOST_OS)
153 #define RTS_MINGW_ONLY_SYMBOLS /**/
154 /* Don't have the ability to read import libs / archives, so
155 * we have to stupidly list a lot of what libcygwin.a
156 * exports; sigh.
157 */
158 #define RTS_CYGWIN_ONLY_SYMBOLS \
159 SymX(regfree) \
160 SymX(regexec) \
161 SymX(regerror) \
162 SymX(regcomp) \
163 SymX(__errno) \
164 SymX(access) \
165 SymX(chmod) \
166 SymX(chdir) \
167 SymX(close) \
168 SymX(creat) \
169 SymX(dup) \
170 SymX(dup2) \
171 SymX(fstat) \
172 SymX(fcntl) \
173 SymX(getcwd) \
174 SymX(getenv) \
175 SymX(lseek) \
176 SymX(open) \
177 SymX(fpathconf) \
178 SymX(pathconf) \
179 SymX(stat) \
180 SymX(pow) \
181 SymX(tanh) \
182 SymX(cosh) \
183 SymX(sinh) \
184 SymX(atan) \
185 SymX(acos) \
186 SymX(asin) \
187 SymX(tan) \
188 SymX(cos) \
189 SymX(sin) \
190 SymX(exp) \
191 SymX(log) \
192 SymX(sqrt) \
193 SymX(localtime_r) \
194 SymX(gmtime_r) \
195 SymX(mktime) \
196 Sym(_imp___tzname) \
197 SymX(gettimeofday) \
198 SymX(timezone) \
199 SymX(tcgetattr) \
200 SymX(tcsetattr) \
201 SymX(memcpy) \
202 SymX(memmove) \
203 SymX(realloc) \
204 SymX(malloc) \
205 SymX(free) \
206 SymX(fork) \
207 SymX(lstat) \
208 SymX(isatty) \
209 SymX(mkdir) \
210 SymX(opendir) \
211 SymX(readdir) \
212 SymX(rewinddir) \
213 SymX(closedir) \
214 SymX(link) \
215 SymX(mkfifo) \
216 SymX(pipe) \
217 SymX(read) \
218 SymX(rename) \
219 SymX(rmdir) \
220 SymX(select) \
221 SymX(system) \
222 SymX(write) \
223 SymX(strcmp) \
224 SymX(strcpy) \
225 SymX(strncpy) \
226 SymX(strerror) \
227 SymX(sigaddset) \
228 SymX(sigemptyset) \
229 SymX(sigprocmask) \
230 SymX(umask) \
231 SymX(uname) \
232 SymX(unlink) \
233 SymX(utime) \
234 SymX(waitpid)
235
236 #elif !defined(mingw32_HOST_OS)
237 #define RTS_MINGW_ONLY_SYMBOLS /**/
238 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
239 #else /* defined(mingw32_HOST_OS) */
240 #define RTS_POSIX_ONLY_SYMBOLS /**/
241 #define RTS_CYGWIN_ONLY_SYMBOLS /**/
242
243 /* Extra syms gen'ed by mingw-2's gcc-3.2: */
244 #if __GNUC__>=3
245 #define RTS_MINGW_EXTRA_SYMS \
246 Sym(_imp____mb_cur_max) \
247 Sym(_imp___pctype)
248 #else
249 #define RTS_MINGW_EXTRA_SYMS
250 #endif
251
252 /* These are statically linked from the mingw libraries into the ghc
253 executable, so we have to employ this hack. */
254 #define RTS_MINGW_ONLY_SYMBOLS \
255 SymX(asyncReadzh_fast) \
256 SymX(asyncWritezh_fast) \
257 SymX(asyncDoProczh_fast) \
258 SymX(memset) \
259 SymX(inet_ntoa) \
260 SymX(inet_addr) \
261 SymX(htonl) \
262 SymX(recvfrom) \
263 SymX(listen) \
264 SymX(bind) \
265 SymX(shutdown) \
266 SymX(connect) \
267 SymX(htons) \
268 SymX(ntohs) \
269 SymX(getservbyname) \
270 SymX(getservbyport) \
271 SymX(getprotobynumber) \
272 SymX(getprotobyname) \
273 SymX(gethostbyname) \
274 SymX(gethostbyaddr) \
275 SymX(gethostname) \
276 SymX(strcpy) \
277 SymX(strncpy) \
278 SymX(abort) \
279 Sym(_alloca) \
280 Sym(isxdigit) \
281 Sym(isupper) \
282 Sym(ispunct) \
283 Sym(islower) \
284 Sym(isspace) \
285 Sym(isprint) \
286 Sym(isdigit) \
287 Sym(iscntrl) \
288 Sym(isalpha) \
289 Sym(isalnum) \
290 SymX(strcmp) \
291 SymX(memmove) \
292 SymX(realloc) \
293 SymX(malloc) \
294 SymX(pow) \
295 SymX(tanh) \
296 SymX(cosh) \
297 SymX(sinh) \
298 SymX(atan) \
299 SymX(acos) \
300 SymX(asin) \
301 SymX(tan) \
302 SymX(cos) \
303 SymX(sin) \
304 SymX(exp) \
305 SymX(log) \
306 SymX(sqrt) \
307 SymX(memcpy) \
308 SymX(rts_InstallConsoleEvent) \
309 SymX(rts_ConsoleHandlerDone) \
310 Sym(mktime) \
311 Sym(_imp___timezone) \
312 Sym(_imp___tzname) \
313 Sym(_imp___iob) \
314 Sym(_imp___osver) \
315 Sym(localtime) \
316 Sym(gmtime) \
317 Sym(opendir) \
318 Sym(readdir) \
319 Sym(rewinddir) \
320 RTS_MINGW_EXTRA_SYMS \
321 Sym(closedir)
322 #endif
323
324 #if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
325 #define RTS_DARWIN_ONLY_SYMBOLS \
326 Sym(asprintf$LDBLStub) \
327 Sym(err$LDBLStub) \
328 Sym(errc$LDBLStub) \
329 Sym(errx$LDBLStub) \
330 Sym(fprintf$LDBLStub) \
331 Sym(fscanf$LDBLStub) \
332 Sym(fwprintf$LDBLStub) \
333 Sym(fwscanf$LDBLStub) \
334 Sym(printf$LDBLStub) \
335 Sym(scanf$LDBLStub) \
336 Sym(snprintf$LDBLStub) \
337 Sym(sprintf$LDBLStub) \
338 Sym(sscanf$LDBLStub) \
339 Sym(strtold$LDBLStub) \
340 Sym(swprintf$LDBLStub) \
341 Sym(swscanf$LDBLStub) \
342 Sym(syslog$LDBLStub) \
343 Sym(vasprintf$LDBLStub) \
344 Sym(verr$LDBLStub) \
345 Sym(verrc$LDBLStub) \
346 Sym(verrx$LDBLStub) \
347 Sym(vfprintf$LDBLStub) \
348 Sym(vfscanf$LDBLStub) \
349 Sym(vfwprintf$LDBLStub) \
350 Sym(vfwscanf$LDBLStub) \
351 Sym(vprintf$LDBLStub) \
352 Sym(vscanf$LDBLStub) \
353 Sym(vsnprintf$LDBLStub) \
354 Sym(vsprintf$LDBLStub) \
355 Sym(vsscanf$LDBLStub) \
356 Sym(vswprintf$LDBLStub) \
357 Sym(vswscanf$LDBLStub) \
358 Sym(vsyslog$LDBLStub) \
359 Sym(vwarn$LDBLStub) \
360 Sym(vwarnc$LDBLStub) \
361 Sym(vwarnx$LDBLStub) \
362 Sym(vwprintf$LDBLStub) \
363 Sym(vwscanf$LDBLStub) \
364 Sym(warn$LDBLStub) \
365 Sym(warnc$LDBLStub) \
366 Sym(warnx$LDBLStub) \
367 Sym(wcstold$LDBLStub) \
368 Sym(wprintf$LDBLStub) \
369 Sym(wscanf$LDBLStub)
370 #else
371 #define RTS_DARWIN_ONLY_SYMBOLS
372 #endif
373
374 #ifndef SMP
375 # define MAIN_CAP_SYM SymX(MainCapability)
376 #else
377 # define MAIN_CAP_SYM
378 #endif
379
380 #if !defined(mingw32_HOST_OS)
381 #define RTS_USER_SIGNALS_SYMBOLS \
382 SymX(startSignalHandler) \
383 SymX(setIOManagerPipe)
384 #else
385 #define RTS_USER_SIGNALS_SYMBOLS /* nothing */
386 #endif
387
388 #ifdef TABLES_NEXT_TO_CODE
389 #define RTS_RET_SYMBOLS /* nothing */
390 #else
391 #define RTS_RET_SYMBOLS \
392 SymX(stg_enter_ret) \
393 SymX(stg_gc_fun_ret) \
394 SymX(stg_ap_0_ret) \
395 SymX(stg_ap_v_ret) \
396 SymX(stg_ap_f_ret) \
397 SymX(stg_ap_d_ret) \
398 SymX(stg_ap_l_ret) \
399 SymX(stg_ap_n_ret) \
400 SymX(stg_ap_p_ret) \
401 SymX(stg_ap_pv_ret) \
402 SymX(stg_ap_pp_ret) \
403 SymX(stg_ap_ppv_ret) \
404 SymX(stg_ap_ppp_ret) \
405 SymX(stg_ap_pppv_ret) \
406 SymX(stg_ap_pppp_ret) \
407 SymX(stg_ap_ppppp_ret) \
408 SymX(stg_ap_pppppp_ret)
409 #endif
410
411 #define RTS_SYMBOLS \
412 Maybe_ForeignObj \
413 Maybe_Stable_Names \
414 Sym(StgReturn) \
415 SymX(stg_enter_info) \
416 SymX(stg_gc_void_info) \
417 SymX(__stg_gc_enter_1) \
418 SymX(stg_gc_noregs) \
419 SymX(stg_gc_unpt_r1_info) \
420 SymX(stg_gc_unpt_r1) \
421 SymX(stg_gc_unbx_r1_info) \
422 SymX(stg_gc_unbx_r1) \
423 SymX(stg_gc_f1_info) \
424 SymX(stg_gc_f1) \
425 SymX(stg_gc_d1_info) \
426 SymX(stg_gc_d1) \
427 SymX(stg_gc_l1_info) \
428 SymX(stg_gc_l1) \
429 SymX(__stg_gc_fun) \
430 SymX(stg_gc_fun_info) \
431 SymX(stg_gc_gen) \
432 SymX(stg_gc_gen_info) \
433 SymX(stg_gc_gen_hp) \
434 SymX(stg_gc_ut) \
435 SymX(stg_gen_yield) \
436 SymX(stg_yield_noregs) \
437 SymX(stg_yield_to_interpreter) \
438 SymX(stg_gen_block) \
439 SymX(stg_block_noregs) \
440 SymX(stg_block_1) \
441 SymX(stg_block_takemvar) \
442 SymX(stg_block_putmvar) \
443 SymX(stg_seq_frame_info) \
444 MAIN_CAP_SYM \
445 SymX(MallocFailHook) \
446 SymX(OnExitHook) \
447 SymX(OutOfHeapHook) \
448 SymX(StackOverflowHook) \
449 SymX(__encodeDouble) \
450 SymX(__encodeFloat) \
451 SymX(addDLL) \
452 SymX(__gmpn_gcd_1) \
453 SymX(__gmpz_cmp) \
454 SymX(__gmpz_cmp_si) \
455 SymX(__gmpz_cmp_ui) \
456 SymX(__gmpz_get_si) \
457 SymX(__gmpz_get_ui) \
458 SymX(__int_encodeDouble) \
459 SymX(__int_encodeFloat) \
460 SymX(andIntegerzh_fast) \
461 SymX(atomicallyzh_fast) \
462 SymX(barf) \
463 SymX(debugBelch) \
464 SymX(errorBelch) \
465 SymX(blockAsyncExceptionszh_fast) \
466 SymX(catchzh_fast) \
467 SymX(catchRetryzh_fast) \
468 SymX(catchSTMzh_fast) \
469 SymX(closure_flags) \
470 SymX(cmp_thread) \
471 SymX(cmpIntegerzh_fast) \
472 SymX(cmpIntegerIntzh_fast) \
473 SymX(complementIntegerzh_fast) \
474 SymX(createAdjustor) \
475 SymX(decodeDoublezh_fast) \
476 SymX(decodeFloatzh_fast) \
477 SymX(defaultsHook) \
478 SymX(delayzh_fast) \
479 SymX(deRefWeakzh_fast) \
480 SymX(deRefStablePtrzh_fast) \
481 SymX(divExactIntegerzh_fast) \
482 SymX(divModIntegerzh_fast) \
483 SymX(forkzh_fast) \
484 SymX(forkProcess) \
485 SymX(forkOS_createThread) \
486 SymX(freeHaskellFunctionPtr) \
487 SymX(freeStablePtr) \
488 SymX(gcdIntegerzh_fast) \
489 SymX(gcdIntegerIntzh_fast) \
490 SymX(gcdIntzh_fast) \
491 SymX(genSymZh) \
492 SymX(genericRaise) \
493 SymX(getProgArgv) \
494 SymX(getStablePtr) \
495 SymX(hs_init) \
496 SymX(hs_exit) \
497 SymX(hs_set_argv) \
498 SymX(hs_add_root) \
499 SymX(hs_perform_gc) \
500 SymX(hs_free_stable_ptr) \
501 SymX(hs_free_fun_ptr) \
502 SymX(initLinker) \
503 SymX(int2Integerzh_fast) \
504 SymX(integer2Intzh_fast) \
505 SymX(integer2Wordzh_fast) \
506 SymX(isCurrentThreadBoundzh_fast) \
507 SymX(isDoubleDenormalized) \
508 SymX(isDoubleInfinite) \
509 SymX(isDoubleNaN) \
510 SymX(isDoubleNegativeZero) \
511 SymX(isEmptyMVarzh_fast) \
512 SymX(isFloatDenormalized) \
513 SymX(isFloatInfinite) \
514 SymX(isFloatNaN) \
515 SymX(isFloatNegativeZero) \
516 SymX(killThreadzh_fast) \
517 SymX(loadObj) \
518 SymX(lookupSymbol) \
519 SymX(makeStablePtrzh_fast) \
520 SymX(minusIntegerzh_fast) \
521 SymX(mkApUpd0zh_fast) \
522 SymX(myThreadIdzh_fast) \
523 SymX(labelThreadzh_fast) \
524 SymX(newArrayzh_fast) \
525 SymX(newBCOzh_fast) \
526 SymX(newByteArrayzh_fast) \
527 SymX_redirect(newCAF, newDynCAF) \
528 SymX(newMVarzh_fast) \
529 SymX(newMutVarzh_fast) \
530 SymX(newTVarzh_fast) \
531 SymX(atomicModifyMutVarzh_fast) \
532 SymX(newPinnedByteArrayzh_fast) \
533 SymX(orIntegerzh_fast) \
534 SymX(performGC) \
535 SymX(performMajorGC) \
536 SymX(plusIntegerzh_fast) \
537 SymX(prog_argc) \
538 SymX(prog_argv) \
539 SymX(putMVarzh_fast) \
540 SymX(quotIntegerzh_fast) \
541 SymX(quotRemIntegerzh_fast) \
542 SymX(raisezh_fast) \
543 SymX(raiseIOzh_fast) \
544 SymX(readTVarzh_fast) \
545 SymX(remIntegerzh_fast) \
546 SymX(resetNonBlockingFd) \
547 SymX(resumeThread) \
548 SymX(resolveObjs) \
549 SymX(retryzh_fast) \
550 SymX(rts_apply) \
551 SymX(rts_checkSchedStatus) \
552 SymX(rts_eval) \
553 SymX(rts_evalIO) \
554 SymX(rts_evalLazyIO) \
555 SymX(rts_evalStableIO) \
556 SymX(rts_eval_) \
557 SymX(rts_getBool) \
558 SymX(rts_getChar) \
559 SymX(rts_getDouble) \
560 SymX(rts_getFloat) \
561 SymX(rts_getInt) \
562 SymX(rts_getInt32) \
563 SymX(rts_getPtr) \
564 SymX(rts_getFunPtr) \
565 SymX(rts_getStablePtr) \
566 SymX(rts_getThreadId) \
567 SymX(rts_getWord) \
568 SymX(rts_getWord32) \
569 SymX(rts_lock) \
570 SymX(rts_mkBool) \
571 SymX(rts_mkChar) \
572 SymX(rts_mkDouble) \
573 SymX(rts_mkFloat) \
574 SymX(rts_mkInt) \
575 SymX(rts_mkInt16) \
576 SymX(rts_mkInt32) \
577 SymX(rts_mkInt64) \
578 SymX(rts_mkInt8) \
579 SymX(rts_mkPtr) \
580 SymX(rts_mkFunPtr) \
581 SymX(rts_mkStablePtr) \
582 SymX(rts_mkString) \
583 SymX(rts_mkWord) \
584 SymX(rts_mkWord16) \
585 SymX(rts_mkWord32) \
586 SymX(rts_mkWord64) \
587 SymX(rts_mkWord8) \
588 SymX(rts_unlock) \
589 SymX(rtsSupportsBoundThreads) \
590 SymX(run_queue_hd) \
591 SymX(__hscore_get_saved_termios) \
592 SymX(__hscore_set_saved_termios) \
593 SymX(setProgArgv) \
594 SymX(startupHaskell) \
595 SymX(shutdownHaskell) \
596 SymX(shutdownHaskellAndExit) \
597 SymX(stable_ptr_table) \
598 SymX(stackOverflow) \
599 SymX(stg_CAF_BLACKHOLE_info) \
600 SymX(awakenBlockedQueue) \
601 SymX(stg_CHARLIKE_closure) \
602 SymX(stg_EMPTY_MVAR_info) \
603 SymX(stg_IND_STATIC_info) \
604 SymX(stg_INTLIKE_closure) \
605 SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
606 SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
607 SymX(stg_WEAK_info) \
608 SymX(stg_ap_0_info) \
609 SymX(stg_ap_v_info) \
610 SymX(stg_ap_f_info) \
611 SymX(stg_ap_d_info) \
612 SymX(stg_ap_l_info) \
613 SymX(stg_ap_n_info) \
614 SymX(stg_ap_p_info) \
615 SymX(stg_ap_pv_info) \
616 SymX(stg_ap_pp_info) \
617 SymX(stg_ap_ppv_info) \
618 SymX(stg_ap_ppp_info) \
619 SymX(stg_ap_pppv_info) \
620 SymX(stg_ap_pppp_info) \
621 SymX(stg_ap_ppppp_info) \
622 SymX(stg_ap_pppppp_info) \
623 SymX(stg_ap_1_upd_info) \
624 SymX(stg_ap_2_upd_info) \
625 SymX(stg_ap_3_upd_info) \
626 SymX(stg_ap_4_upd_info) \
627 SymX(stg_ap_5_upd_info) \
628 SymX(stg_ap_6_upd_info) \
629 SymX(stg_ap_7_upd_info) \
630 SymX(stg_exit) \
631 SymX(stg_sel_0_upd_info) \
632 SymX(stg_sel_10_upd_info) \
633 SymX(stg_sel_11_upd_info) \
634 SymX(stg_sel_12_upd_info) \
635 SymX(stg_sel_13_upd_info) \
636 SymX(stg_sel_14_upd_info) \
637 SymX(stg_sel_15_upd_info) \
638 SymX(stg_sel_1_upd_info) \
639 SymX(stg_sel_2_upd_info) \
640 SymX(stg_sel_3_upd_info) \
641 SymX(stg_sel_4_upd_info) \
642 SymX(stg_sel_5_upd_info) \
643 SymX(stg_sel_6_upd_info) \
644 SymX(stg_sel_7_upd_info) \
645 SymX(stg_sel_8_upd_info) \
646 SymX(stg_sel_9_upd_info) \
647 SymX(stg_upd_frame_info) \
648 SymX(suspendThread) \
649 SymX(takeMVarzh_fast) \
650 SymX(timesIntegerzh_fast) \
651 SymX(tryPutMVarzh_fast) \
652 SymX(tryTakeMVarzh_fast) \
653 SymX(unblockAsyncExceptionszh_fast) \
654 SymX(unloadObj) \
655 SymX(unsafeThawArrayzh_fast) \
656 SymX(waitReadzh_fast) \
657 SymX(waitWritezh_fast) \
658 SymX(word2Integerzh_fast) \
659 SymX(writeTVarzh_fast) \
660 SymX(xorIntegerzh_fast) \
661 SymX(yieldzh_fast) \
662 RTS_USER_SIGNALS_SYMBOLS
663
664 #ifdef SUPPORT_LONG_LONGS
665 #define RTS_LONG_LONG_SYMS \
666 SymX(int64ToIntegerzh_fast) \
667 SymX(word64ToIntegerzh_fast)
668 #else
669 #define RTS_LONG_LONG_SYMS /* nothing */
670 #endif
671
672 // 64-bit support functions in libgcc.a
673 #if defined(__GNUC__) && SIZEOF_VOID_P <= 4
674 #define RTS_LIBGCC_SYMBOLS \
675 Sym(__divdi3) \
676 Sym(__udivdi3) \
677 Sym(__moddi3) \
678 Sym(__umoddi3) \
679 Sym(__muldi3) \
680 Sym(__ashldi3) \
681 Sym(__ashrdi3) \
682 Sym(__lshrdi3) \
683 Sym(__eprintf)
684 #elif defined(ia64_HOST_ARCH)
685 #define RTS_LIBGCC_SYMBOLS \
686 Sym(__divdi3) \
687 Sym(__udivdi3) \
688 Sym(__moddi3) \
689 Sym(__umoddi3) \
690 Sym(__divsf3) \
691 Sym(__divdf3)
692 #else
693 #define RTS_LIBGCC_SYMBOLS
694 #endif
695
696 #if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
697 // Symbols that don't have a leading underscore
698 // on Mac OS X. They have to receive special treatment,
699 // see machoInitSymbolsWithoutUnderscore()
700 #define RTS_MACHO_NOUNDERLINE_SYMBOLS \
701 Sym(saveFP) \
702 Sym(restFP)
703 #endif
704
705 /* entirely bogus claims about types of these symbols */
706 #define Sym(vvv) extern void vvv(void);
707 #define SymX(vvv) /**/
708 #define SymX_redirect(vvv,xxx) /**/
709 RTS_SYMBOLS
710 RTS_RET_SYMBOLS
711 RTS_LONG_LONG_SYMS
712 RTS_POSIX_ONLY_SYMBOLS
713 RTS_MINGW_ONLY_SYMBOLS
714 RTS_CYGWIN_ONLY_SYMBOLS
715 RTS_DARWIN_ONLY_SYMBOLS
716 RTS_LIBGCC_SYMBOLS
717 #undef Sym
718 #undef SymX
719 #undef SymX_redirect
720
721 #ifdef LEADING_UNDERSCORE
722 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
723 #else
724 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
725 #endif
726
727 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
728 (void*)(&(vvv)) },
729 #define SymX(vvv) Sym(vvv)
730
731 // SymX_redirect allows us to redirect references to one symbol to
732 // another symbol. See newCAF/newDynCAF for an example.
733 #define SymX_redirect(vvv,xxx) \
734 { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
735 (void*)(&(xxx)) },
736
737 static RtsSymbolVal rtsSyms[] = {
738 RTS_SYMBOLS
739 RTS_RET_SYMBOLS
740 RTS_LONG_LONG_SYMS
741 RTS_POSIX_ONLY_SYMBOLS
742 RTS_MINGW_ONLY_SYMBOLS
743 RTS_CYGWIN_ONLY_SYMBOLS
744 RTS_LIBGCC_SYMBOLS
745 #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
746 // dyld stub code contains references to this,
747 // but it should never be called because we treat
748 // lazy pointers as nonlazy.
749 { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
750 #endif
751 { 0, 0 } /* sentinel */
752 };
753
754 /* -----------------------------------------------------------------------------
755 * Insert symbols into hash tables, checking for duplicates.
756 */
757 static void ghciInsertStrHashTable ( char* obj_name,
758 HashTable *table,
759 char* key,
760 void *data
761 )
762 {
763 if (lookupHashTable(table, (StgWord)key) == NULL)
764 {
765 insertStrHashTable(table, (StgWord)key, data);
766 return;
767 }
768 debugBelch(
769 "\n\n"
770 "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
771 " %s\n"
772 "whilst processing object file\n"
773 " %s\n"
774 "This could be caused by:\n"
775 " * Loading two different object files which export the same symbol\n"
776 " * Specifying the same object file twice on the GHCi command line\n"
777 " * An incorrect `package.conf' entry, causing some object to be\n"
778 " loaded twice.\n"
779 "GHCi cannot safely continue in this situation. Exiting now. Sorry.\n"
780 "\n",
781 (char*)key,
782 obj_name
783 );
784 exit(1);
785 }
786
787
788 /* -----------------------------------------------------------------------------
789 * initialize the object linker
790 */
791
792
793 static int linker_init_done = 0 ;
794
795 #if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
796 static void *dl_prog_handle;
797 #endif
798
799 /* dlopen(NULL,..) doesn't work so we grab libc explicitly */
800 #if defined(openbsd_HOST_OS)
801 static void *dl_libc_handle;
802 #endif
803
804 void
805 initLinker( void )
806 {
807 RtsSymbolVal *sym;
808
809 /* Make initLinker idempotent, so we can call it
810 before evey relevant operation; that means we
811 don't need to initialise the linker separately */
812 if (linker_init_done == 1) { return; } else {
813 linker_init_done = 1;
814 }
815
816 symhash = allocStrHashTable();
817
818 /* populate the symbol table with stuff from the RTS */
819 for (sym = rtsSyms; sym->lbl != NULL; sym++) {
820 ghciInsertStrHashTable("(GHCi built-in symbols)",
821 symhash, sym->lbl, sym->addr);
822 }
823 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
824 machoInitSymbolsWithoutUnderscore();
825 # endif
826
827 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
828 # if defined(RTLD_DEFAULT)
829 dl_prog_handle = RTLD_DEFAULT;
830 # else
831 dl_prog_handle = dlopen(NULL, RTLD_LAZY);
832 # if defined(openbsd_HOST_OS)
833 dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
834 # endif
835 # endif /* RTLD_DEFAULT */
836 # endif
837 }
838
839 /* -----------------------------------------------------------------------------
840 * Loading DLL or .so dynamic libraries
841 * -----------------------------------------------------------------------------
842 *
843 * Add a DLL from which symbols may be found. In the ELF case, just
844 * do RTLD_GLOBAL-style add, so no further messing around needs to
845 * happen in order that symbols in the loaded .so are findable --
846 * lookupSymbol() will subsequently see them by dlsym on the program's
847 * dl-handle. Returns NULL if success, otherwise ptr to an err msg.
848 *
849 * In the PEi386 case, open the DLLs and put handles to them in a
850 * linked list. When looking for a symbol, try all handles in the
851 * list. This means that we need to load even DLLs that are guaranteed
852 * to be in the ghc.exe image already, just so we can get a handle
853 * to give to loadSymbol, so that we can find the symbols. For such
854 * libraries, the LoadLibrary call should be a no-op except for returning
855 * the handle.
856 *
857 */
858
859 #if defined(OBJFORMAT_PEi386)
860 /* A record for storing handles into DLLs. */
861
862 typedef
863 struct _OpenedDLL {
864 char* name;
865 struct _OpenedDLL* next;
866 HINSTANCE instance;
867 }
868 OpenedDLL;
869
870 /* A list thereof. */
871 static OpenedDLL* opened_dlls = NULL;
872 #endif
873
874 char *
875 addDLL( char *dll_name )
876 {
877 # if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
878 /* ------------------- ELF DLL loader ------------------- */
879 void *hdl;
880 char *errmsg;
881
882 initLinker();
883
884 hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
885
886 if (hdl == NULL) {
887 /* dlopen failed; return a ptr to the error msg. */
888 errmsg = dlerror();
889 if (errmsg == NULL) errmsg = "addDLL: unknown error";
890 return errmsg;
891 } else {
892 return NULL;
893 }
894 /*NOTREACHED*/
895
896 # elif defined(OBJFORMAT_PEi386)
897 /* ------------------- Win32 DLL loader ------------------- */
898
899 char* buf;
900 OpenedDLL* o_dll;
901 HINSTANCE instance;
902
903 initLinker();
904
905 /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
906
907 /* See if we've already got it, and ignore if so. */
908 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
909 if (0 == strcmp(o_dll->name, dll_name))
910 return NULL;
911 }
912
913 /* The file name has no suffix (yet) so that we can try
914 both foo.dll and foo.drv
915
916 The documentation for LoadLibrary says:
917 If no file name extension is specified in the lpFileName
918 parameter, the default library extension .dll is
919 appended. However, the file name string can include a trailing
920 point character (.) to indicate that the module name has no
921 extension. */
922
923 buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
924 sprintf(buf, "%s.DLL", dll_name);
925 instance = LoadLibrary(buf);
926 if (instance == NULL) {
927 sprintf(buf, "%s.DRV", dll_name); // KAA: allow loading of drivers (like winspool.drv)
928 instance = LoadLibrary(buf);
929 if (instance == NULL) {
930 stgFree(buf);
931
932 /* LoadLibrary failed; return a ptr to the error msg. */
933 return "addDLL: unknown error";
934 }
935 }
936 stgFree(buf);
937
938 /* Add this DLL to the list of DLLs in which to search for symbols. */
939 o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
940 o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
941 strcpy(o_dll->name, dll_name);
942 o_dll->instance = instance;
943 o_dll->next = opened_dlls;
944 opened_dlls = o_dll;
945
946 return NULL;
947 # else
948 barf("addDLL: not implemented on this platform");
949 # endif
950 }
951
952 /* -----------------------------------------------------------------------------
953 * lookup a symbol in the hash table
954 */
955 void *
956 lookupSymbol( char *lbl )
957 {
958 void *val;
959 initLinker() ;
960 ASSERT(symhash != NULL);
961 val = lookupStrHashTable(symhash, lbl);
962
963 if (val == NULL) {
964 # if defined(OBJFORMAT_ELF)
965 # if defined(openbsd_HOST_OS)
966 val = dlsym(dl_prog_handle, lbl);
967 return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
968 # elif defined(x86_64_HOST_ARCH)
969 val = dlsym(dl_prog_handle, lbl);
970 if (val >= (void *)0x80000000) {
971 void *new_val;
972 new_val = x86_64_high_symbol(lbl, val);
973 IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
974 return new_val;
975 } else {
976 return val;
977 }
978 # else /* not openbsd */
979 return dlsym(dl_prog_handle, lbl);
980 # endif
981 # elif defined(OBJFORMAT_MACHO)
982 if(NSIsSymbolNameDefined(lbl)) {
983 NSSymbol symbol = NSLookupAndBindSymbol(lbl);
984 return NSAddressOfSymbol(symbol);
985 } else {
986 return NULL;
987 }
988 # elif defined(OBJFORMAT_PEi386)
989 OpenedDLL* o_dll;
990 void* sym;
991 for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
992 /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
993 if (lbl[0] == '_') {
994 /* HACK: if the name has an initial underscore, try stripping
995 it off & look that up first. I've yet to verify whether there's
996 a Rule that governs whether an initial '_' *should always* be
997 stripped off when mapping from import lib name to the DLL name.
998 */
999 sym = GetProcAddress(o_dll->instance, (lbl+1));
1000 if (sym != NULL) {
1001 /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
1002 return sym;
1003 }
1004 }
1005 sym = GetProcAddress(o_dll->instance, lbl);
1006 if (sym != NULL) {
1007 /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
1008 return sym;
1009 }
1010 }
1011 return NULL;
1012 # else
1013 ASSERT(2+2 == 5);
1014 return NULL;
1015 # endif
1016 } else {
1017 return val;
1018 }
1019 }
1020
1021 static
1022 __attribute((unused))
1023 void *
1024 lookupLocalSymbol( ObjectCode* oc, char *lbl )
1025 {
1026 void *val;
1027 initLinker() ;
1028 val = lookupStrHashTable(oc->lochash, lbl);
1029
1030 if (val == NULL) {
1031 return NULL;
1032 } else {
1033 return val;
1034 }
1035 }
1036
1037
1038 /* -----------------------------------------------------------------------------
1039 * Debugging aid: look in GHCi's object symbol tables for symbols
1040 * within DELTA bytes of the specified address, and show their names.
1041 */
1042 #ifdef DEBUG
1043 void ghci_enquire ( char* addr );
1044
1045 void ghci_enquire ( char* addr )
1046 {
1047 int i;
1048 char* sym;
1049 char* a;
1050 const int DELTA = 64;
1051 ObjectCode* oc;
1052
1053 initLinker();
1054
1055 for (oc = objects; oc; oc = oc->next) {
1056 for (i = 0; i < oc->n_symbols; i++) {
1057 sym = oc->symbols[i];
1058 if (sym == NULL) continue;
1059 // debugBelch("enquire %p %p\n", sym, oc->lochash);
1060 a = NULL;
1061 if (oc->lochash != NULL) {
1062 a = lookupStrHashTable(oc->lochash, sym);
1063 }
1064 if (a == NULL) {
1065 a = lookupStrHashTable(symhash, sym);
1066 }
1067 if (a == NULL) {
1068 // debugBelch("ghci_enquire: can't find %s\n", sym);
1069 }
1070 else if (addr-DELTA <= a && a <= addr+DELTA) {
1071 debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
1072 }
1073 }
1074 }
1075 }
1076 #endif
1077
1078 #ifdef ia64_HOST_ARCH
1079 static unsigned int PLTSize(void);
1080 #endif
1081
1082 /* -----------------------------------------------------------------------------
1083 * Load an obj (populate the global symbol table, but don't resolve yet)
1084 *
1085 * Returns: 1 if ok, 0 on error.
1086 */
1087 HsInt
1088 loadObj( char *path )
1089 {
1090 ObjectCode* oc;
1091 struct stat st;
1092 int r, n;
1093 #ifdef USE_MMAP
1094 int fd, pagesize;
1095 void *map_addr = NULL;
1096 #else
1097 FILE *f;
1098 int misalignment;
1099 #endif
1100 initLinker();
1101
1102 /* debugBelch("loadObj %s\n", path ); */
1103
1104 /* Check that we haven't already loaded this object.
1105 Ignore requests to load multiple times */
1106 {
1107 ObjectCode *o;
1108 int is_dup = 0;
1109 for (o = objects; o; o = o->next) {
1110 if (0 == strcmp(o->fileName, path)) {
1111 is_dup = 1;
1112 break; /* don't need to search further */
1113 }
1114 }
1115 if (is_dup) {
1116 IF_DEBUG(linker, debugBelch(
1117 "GHCi runtime linker: warning: looks like you're trying to load the\n"
1118 "same object file twice:\n"
1119 " %s\n"
1120 "GHCi will ignore this, but be warned.\n"
1121 , path));
1122 return 1; /* success */
1123 }
1124 }
1125
1126 oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
1127
1128 # if defined(OBJFORMAT_ELF)
1129 oc->formatName = "ELF";
1130 # elif defined(OBJFORMAT_PEi386)
1131 oc->formatName = "PEi386";
1132 # elif defined(OBJFORMAT_MACHO)
1133 oc->formatName = "Mach-O";
1134 # else
1135 stgFree(oc);
1136 barf("loadObj: not implemented on this platform");
1137 # endif
1138
1139 r = stat(path, &st);
1140 if (r == -1) { return 0; }
1141
1142 /* sigh, strdup() isn't a POSIX function, so do it the long way */
1143 oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
1144 strcpy(oc->fileName, path);
1145
1146 oc->fileSize = st.st_size;
1147 oc->symbols = NULL;
1148 oc->sections = NULL;
1149 oc->lochash = allocStrHashTable();
1150 oc->proddables = NULL;
1151
1152 /* chain it onto the list of objects */
1153 oc->next = objects;
1154 objects = oc;
1155
1156 #ifdef USE_MMAP
1157 #define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
1158
1159 /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
1160
1161 #if defined(openbsd_HOST_OS)
1162 fd = open(path, O_RDONLY, S_IRUSR);
1163 #else
1164 fd = open(path, O_RDONLY);
1165 #endif
1166 if (fd == -1)
1167 barf("loadObj: can't open `%s'", path);
1168
1169 pagesize = getpagesize();
1170
1171 #ifdef ia64_HOST_ARCH
1172 /* The PLT needs to be right before the object */
1173 n = ROUND_UP(PLTSize(), pagesize);
1174 oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
1175 if (oc->plt == MAP_FAILED)
1176 barf("loadObj: can't allocate PLT");
1177
1178 oc->pltIndex = 0;
1179 map_addr = oc->plt + n;
1180 #endif
1181
1182 n = ROUND_UP(oc->fileSize, pagesize);
1183
1184 /* Link objects into the lower 2Gb on x86_64. GHC assumes the
1185 * small memory model on this architecture (see gcc docs,
1186 * -mcmodel=small).
1187 */
1188 #ifdef x86_64_HOST_ARCH
1189 #define EXTRA_MAP_FLAGS MAP_32BIT
1190 #else
1191 #define EXTRA_MAP_FLAGS 0
1192 #endif
1193
1194 oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
1195 MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
1196 if (oc->image == MAP_FAILED)
1197 barf("loadObj: can't map `%s'", path);
1198
1199 close(fd);
1200
1201 #else /* !USE_MMAP */
1202
1203 /* load the image into memory */
1204 f = fopen(path, "rb");
1205 if (!f)
1206 barf("loadObj: can't read `%s'", path);
1207
1208 #ifdef darwin_HOST_OS
1209 // In a Mach-O .o file, all sections can and will be misaligned
1210 // if the total size of the headers is not a multiple of the
1211 // desired alignment. This is fine for .o files that only serve
1212 // as input for the static linker, but it's not fine for us,
1213 // as SSE (used by gcc for floating point) and Altivec require
1214 // 16-byte alignment.
1215 // We calculate the correct alignment from the header before
1216 // reading the file, and then we misalign oc->image on purpose so
1217 // that the actual sections end up aligned again.
1218 misalignment = machoGetMisalignment(f);
1219 #else
1220 misalignment = 0;
1221 #endif
1222
1223 oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
1224 oc->image += misalignment;
1225
1226 n = fread ( oc->image, 1, oc->fileSize, f );
1227 if (n != oc->fileSize)
1228 barf("loadObj: error whilst reading `%s'", path);
1229
1230 fclose(f);
1231
1232 #endif /* USE_MMAP */
1233
1234 # if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
1235 r = ocAllocateJumpIslands_MachO ( oc );
1236 if (!r) { return r; }
1237 # elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
1238 r = ocAllocateJumpIslands_ELF ( oc );
1239 if (!r) { return r; }
1240 #endif
1241
1242 /* verify the in-memory image */
1243 # if defined(OBJFORMAT_ELF)
1244 r = ocVerifyImage_ELF ( oc );
1245 # elif defined(OBJFORMAT_PEi386)
1246 r = ocVerifyImage_PEi386 ( oc );
1247 # elif defined(OBJFORMAT_MACHO)
1248 r = ocVerifyImage_MachO ( oc );
1249 # else
1250 barf("loadObj: no verify method");
1251 # endif
1252 if (!r) { return r; }
1253
1254 /* build the symbol list for this image */
1255 # if defined(OBJFORMAT_ELF)
1256 r = ocGetNames_ELF ( oc );
1257 # elif defined(OBJFORMAT_PEi386)
1258 r = ocGetNames_PEi386 ( oc );
1259 # elif defined(OBJFORMAT_MACHO)
1260 r = ocGetNames_MachO ( oc );
1261 # else
1262 barf("loadObj: no getNames method");
1263 # endif
1264 if (!r) { return r; }
1265
1266 /* loaded, but not resolved yet */
1267 oc->status = OBJECT_LOADED;
1268
1269 return 1;
1270 }
1271
1272 /* -----------------------------------------------------------------------------
1273 * resolve all the currently unlinked objects in memory
1274 *
1275 * Returns: 1 if ok, 0 on error.
1276 */
1277 HsInt
1278 resolveObjs( void )
1279 {
1280 ObjectCode *oc;
1281 int r;
1282
1283 initLinker();
1284
1285 for (oc = objects; oc; oc = oc->next) {
1286 if (oc->status != OBJECT_RESOLVED) {
1287 # if defined(OBJFORMAT_ELF)
1288 r = ocResolve_ELF ( oc );
1289 # elif defined(OBJFORMAT_PEi386)
1290 r = ocResolve_PEi386 ( oc );
1291 # elif defined(OBJFORMAT_MACHO)
1292 r = ocResolve_MachO ( oc );
1293 # else
1294 barf("resolveObjs: not implemented on this platform");
1295 # endif
1296 if (!r) { return r; }
1297 oc->status = OBJECT_RESOLVED;
1298 }
1299 }
1300 return 1;
1301 }
1302
1303 /* -----------------------------------------------------------------------------
1304 * delete an object from the pool
1305 */
1306 HsInt
1307 unloadObj( char *path )
1308 {
1309 ObjectCode *oc, *prev;
1310
1311 ASSERT(symhash != NULL);
1312 ASSERT(objects != NULL);
1313
1314 initLinker();
1315
1316 prev = NULL;
1317 for (oc = objects; oc; prev = oc, oc = oc->next) {
1318 if (!strcmp(oc->fileName,path)) {
1319
1320 /* Remove all the mappings for the symbols within this
1321 * object..
1322 */
1323 {
1324 int i;
1325 for (i = 0; i < oc->n_symbols; i++) {
1326 if (oc->symbols[i] != NULL) {
1327 removeStrHashTable(symhash, oc->symbols[i], NULL);
1328 }
1329 }
1330 }
1331
1332 if (prev == NULL) {
1333 objects = oc->next;
1334 } else {
1335 prev->next = oc->next;
1336 }
1337
1338 /* We're going to leave this in place, in case there are
1339 any pointers from the heap into it: */
1340 /* stgFree(oc->image); */
1341 stgFree(oc->fileName);
1342 stgFree(oc->symbols);
1343 stgFree(oc->sections);
1344 /* The local hash table should have been freed at the end
1345 of the ocResolve_ call on it. */
1346 ASSERT(oc->lochash == NULL);
1347 stgFree(oc);
1348 return 1;
1349 }
1350 }
1351
1352 errorBelch("unloadObj: can't find `%s' to unload", path);
1353 return 0;
1354 }
1355
1356 /* -----------------------------------------------------------------------------
1357 * Sanity checking. For each ObjectCode, maintain a list of address ranges
1358 * which may be prodded during relocation, and abort if we try and write
1359 * outside any of these.
1360 */
1361 static void addProddableBlock ( ObjectCode* oc, void* start, int size )
1362 {
1363 ProddableBlock* pb
1364 = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
1365 /* debugBelch("aPB %p %p %d\n", oc, start, size); */
1366 ASSERT(size > 0);
1367 pb->start = start;
1368 pb->size = size;
1369 pb->next = oc->proddables;
1370 oc->proddables = pb;
1371 }
1372
1373 static void checkProddableBlock ( ObjectCode* oc, void* addr )
1374 {
1375 ProddableBlock* pb;
1376 for (pb = oc->proddables; pb != NULL; pb = pb->next) {
1377 char* s = (char*)(pb->start);
1378 char* e = s + pb->size - 1;
1379 char* a = (char*)addr;
1380 /* Assumes that the biggest fixup involves a 4-byte write. This
1381 probably needs to be changed to 8 (ie, +7) on 64-bit
1382 plats. */
1383 if (a >= s && (a+3) <= e) return;
1384 }
1385 barf("checkProddableBlock: invalid fixup in runtime linker");
1386 }
1387
1388 /* -----------------------------------------------------------------------------
1389 * Section management.
1390 */
1391 static void addSection ( ObjectCode* oc, SectionKind kind,
1392 void* start, void* end )
1393 {
1394 Section* s = stgMallocBytes(sizeof(Section), "addSection");
1395 s->start = start;
1396 s->end = end;
1397 s->kind = kind;
1398 s->next = oc->sections;
1399 oc->sections = s;
1400 /*
1401 debugBelch("addSection: %p-%p (size %d), kind %d\n",
1402 start, ((char*)end)-1, end - start + 1, kind );
1403 */
1404 }
1405
1406
1407 /* --------------------------------------------------------------------------
1408 * PowerPC specifics (jump islands)
1409 * ------------------------------------------------------------------------*/
1410
1411 #if defined(powerpc_HOST_ARCH)
1412
1413 /*
1414 ocAllocateJumpIslands
1415
1416 Allocate additional space at the end of the object file image to make room
1417 for jump islands.
1418
1419 PowerPC relative branch instructions have a 24 bit displacement field.
1420 As PPC code is always 4-byte-aligned, this yields a +-32MB range.
1421 If a particular imported symbol is outside this range, we have to redirect
1422 the jump to a short piece of new code that just loads the 32bit absolute
1423 address and jumps there.
1424 This function just allocates space for one 16 byte ppcJumpIsland for every
1425 undefined symbol in the object file. The code for the islands is filled in by
1426 makeJumpIsland below.
1427 */
1428
1429 static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
1430 {
1431 #ifdef USE_MMAP
1432 int pagesize, n, m;
1433 #endif
1434 int aligned;
1435
1436 if( count > 0 )
1437 {
1438 // round up to the nearest 4
1439 aligned = (oc->fileSize + 3) & ~3;
1440
1441 #ifdef USE_MMAP
1442 #ifndef linux_HOST_OS /* mremap is a linux extension */
1443 #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
1444 #endif
1445
1446 pagesize = getpagesize();
1447 n = ROUND_UP( oc->fileSize, pagesize );
1448 m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
1449
1450 /* The effect of this mremap() call is only the ensure that we have
1451 * a sufficient number of virtually contiguous pages. As returned from
1452 * mremap, the pages past the end of the file are not backed. We give
1453 * them a backing by using MAP_FIXED to map in anonymous pages.
1454 */
1455 if( (oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE )) == MAP_FAILED )
1456 {
1457 errorBelch( "Unable to mremap for Jump Islands\n" );
1458 return 0;
1459 }
1460
1461 if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
1462 MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
1463 {
1464 errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
1465 return 0;
1466 }
1467
1468 #else
1469 oc->image = stgReallocBytes( oc->image,
1470 aligned + sizeof (ppcJumpIsland) * count,
1471 "ocAllocateJumpIslands" );
1472 #endif /* USE_MMAP */
1473
1474 oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
1475 memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
1476 }
1477 else
1478 oc->jump_islands = NULL;
1479
1480 oc->island_start_symbol = first;
1481 oc->n_islands = count;
1482
1483 return 1;
1484 }
1485
1486 static unsigned long makeJumpIsland( ObjectCode* oc,
1487 unsigned long symbolNumber,
1488 unsigned long target )
1489 {
1490 ppcJumpIsland *island;
1491
1492 if( symbolNumber < oc->island_start_symbol ||
1493 symbolNumber - oc->island_start_symbol > oc->n_islands)
1494 return 0;
1495
1496 island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
1497
1498 // lis r12, hi16(target)
1499 island->lis_r12 = 0x3d80;
1500 island->hi_addr = target >> 16;
1501
1502 // ori r12, r12, lo16(target)
1503 island->ori_r12_r12 = 0x618c;
1504 island->lo_addr = target & 0xffff;
1505
1506 // mtctr r12
1507 island->mtctr_r12 = 0x7d8903a6;
1508
1509 // bctr
1510 island->bctr = 0x4e800420;
1511
1512 return (unsigned long) island;
1513 }
1514
1515 /*
1516 ocFlushInstructionCache
1517
1518 Flush the data & instruction caches.
1519 Because the PPC has split data/instruction caches, we have to
1520 do that whenever we modify code at runtime.
1521 */
1522
1523 static void ocFlushInstructionCache( ObjectCode *oc )
1524 {
1525 int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
1526 unsigned long *p = (unsigned long *) oc->image;
1527
1528 while( n-- )
1529 {
1530 __asm__ volatile ( "dcbf 0,%0\n\t"
1531 "sync\n\t"
1532 "icbi 0,%0"
1533 :
1534 : "r" (p)
1535 );
1536 p++;
1537 }
1538 __asm__ volatile ( "sync\n\t"
1539 "isync"
1540 );
1541 }
1542 #endif
1543
1544 /* --------------------------------------------------------------------------
1545 * PEi386 specifics (Win32 targets)
1546 * ------------------------------------------------------------------------*/
1547
1548 /* The information for this linker comes from
1549 Microsoft Portable Executable
1550 and Common Object File Format Specification
1551 revision 5.1 January 1998
1552 which SimonM says comes from the MS Developer Network CDs.
1553
1554 It can be found there (on older CDs), but can also be found
1555 online at:
1556
1557 http://www.microsoft.com/hwdev/hardware/PECOFF.asp
1558
1559 (this is Rev 6.0 from February 1999).
1560
1561 Things move, so if that fails, try searching for it via
1562
1563 http://www.google.com/search?q=PE+COFF+specification
1564
1565 The ultimate reference for the PE format is the Winnt.h
1566 header file that comes with the Platform SDKs; as always,
1567 implementations will drift wrt their documentation.
1568
1569 A good background article on the PE format is Matt Pietrek's
1570 March 1994 article in Microsoft System Journal (MSJ)
1571 (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
1572 Win32 Portable Executable File Format." The info in there
1573 has recently been updated in a two part article in
1574 MSDN magazine, issues Feb and March 2002,
1575 "Inside Windows: An In-Depth Look into the Win32 Portable
1576 Executable File Format"
1577
1578 John Levine's book "Linkers and Loaders" contains useful
1579 info on PE too.
1580 */
1581
1582
1583 #if defined(OBJFORMAT_PEi386)
1584
1585
1586
1587 typedef unsigned char UChar;
1588 typedef unsigned short UInt16;
1589 typedef unsigned int UInt32;
1590 typedef int Int32;
1591
1592
1593 typedef
1594 struct {
1595 UInt16 Machine;
1596 UInt16 NumberOfSections;
1597 UInt32 TimeDateStamp;
1598 UInt32 PointerToSymbolTable;
1599 UInt32 NumberOfSymbols;
1600 UInt16 SizeOfOptionalHeader;
1601 UInt16 Characteristics;
1602 }
1603 COFF_header;
1604
1605 #define sizeof_COFF_header 20
1606
1607
1608 typedef
1609 struct {
1610 UChar Name[8];
1611 UInt32 VirtualSize;
1612 UInt32 VirtualAddress;
1613 UInt32 SizeOfRawData;
1614 UInt32 PointerToRawData;
1615 UInt32 PointerToRelocations;
1616 UInt32 PointerToLinenumbers;
1617 UInt16 NumberOfRelocations;
1618 UInt16 NumberOfLineNumbers;
1619 UInt32 Characteristics;
1620 }
1621 COFF_section;
1622
1623 #define sizeof_COFF_section 40
1624
1625
1626 typedef
1627 struct {
1628 UChar Name[8];
1629 UInt32 Value;
1630 UInt16 SectionNumber;
1631 UInt16 Type;
1632 UChar StorageClass;
1633 UChar NumberOfAuxSymbols;
1634 }
1635 COFF_symbol;
1636
1637 #define sizeof_COFF_symbol 18
1638
1639
1640 typedef
1641 struct {
1642 UInt32 VirtualAddress;
1643 UInt32 SymbolTableIndex;
1644 UInt16 Type;
1645 }
1646 COFF_reloc;
1647
1648 #define sizeof_COFF_reloc 10
1649
1650
1651 /* From PE spec doc, section 3.3.2 */
1652 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
1653 windows.h -- for the same purpose, but I want to know what I'm
1654 getting, here. */
1655 #define MYIMAGE_FILE_RELOCS_STRIPPED 0x0001
1656 #define MYIMAGE_FILE_EXECUTABLE_IMAGE 0x0002
1657 #define MYIMAGE_FILE_DLL 0x2000
1658 #define MYIMAGE_FILE_SYSTEM 0x1000
1659 #define MYIMAGE_FILE_BYTES_REVERSED_HI 0x8000
1660 #define MYIMAGE_FILE_BYTES_REVERSED_LO 0x0080
1661 #define MYIMAGE_FILE_32BIT_MACHINE 0x0100
1662
1663 /* From PE spec doc, section 5.4.2 and 5.4.4 */
1664 #define MYIMAGE_SYM_CLASS_EXTERNAL 2
1665 #define MYIMAGE_SYM_CLASS_STATIC 3
1666 #define MYIMAGE_SYM_UNDEFINED 0
1667
1668 /* From PE spec doc, section 4.1 */
1669 #define MYIMAGE_SCN_CNT_CODE 0x00000020
1670 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
1671 #define MYIMAGE_SCN_LNK_NRELOC_OVFL 0x01000000
1672
1673 /* From PE spec doc, section 5.2.1 */
1674 #define MYIMAGE_REL_I386_DIR32 0x0006
1675 #define MYIMAGE_REL_I386_REL32 0x0014
1676
1677
1678 /* We use myindex to calculate array addresses, rather than
1679 simply doing the normal subscript thing. That's because
1680 some of the above structs have sizes which are not
1681 a whole number of words. GCC rounds their sizes up to a
1682 whole number of words, which means that the address calcs
1683 arising from using normal C indexing or pointer arithmetic
1684 are just plain wrong. Sigh.
1685 */
1686 static UChar *
1687 myindex ( int scale, void* base, int index )
1688 {
1689 return
1690 ((UChar*)base) + scale * index;
1691 }
1692
1693
1694 static void
1695 printName ( UChar* name, UChar* strtab )
1696 {
1697 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1698 UInt32 strtab_offset = * (UInt32*)(name+4);
1699 debugBelch("%s", strtab + strtab_offset );
1700 } else {
1701 int i;
1702 for (i = 0; i < 8; i++) {
1703 if (name[i] == 0) break;
1704 debugBelch("%c", name[i] );
1705 }
1706 }
1707 }
1708
1709
1710 static void
1711 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
1712 {
1713 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1714 UInt32 strtab_offset = * (UInt32*)(name+4);
1715 strncpy ( dst, strtab+strtab_offset, dstSize );
1716 dst[dstSize-1] = 0;
1717 } else {
1718 int i = 0;
1719 while (1) {
1720 if (i >= 8) break;
1721 if (name[i] == 0) break;
1722 dst[i] = name[i];
1723 i++;
1724 }
1725 dst[i] = 0;
1726 }
1727 }
1728
1729
1730 static UChar *
1731 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
1732 {
1733 UChar* newstr;
1734 /* If the string is longer than 8 bytes, look in the
1735 string table for it -- this will be correctly zero terminated.
1736 */
1737 if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
1738 UInt32 strtab_offset = * (UInt32*)(name+4);
1739 return ((UChar*)strtab) + strtab_offset;
1740 }
1741 /* Otherwise, if shorter than 8 bytes, return the original,
1742 which by defn is correctly terminated.
1743 */
1744 if (name[7]==0) return name;
1745 /* The annoying case: 8 bytes. Copy into a temporary
1746 (which is never freed ...)
1747 */
1748 newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
1749 ASSERT(newstr);
1750 strncpy(newstr,name,8);
1751 newstr[8] = 0;
1752 return newstr;
1753 }
1754
1755
1756 /* Just compares the short names (first 8 chars) */
1757 static COFF_section *
1758 findPEi386SectionCalled ( ObjectCode* oc, char* name )
1759 {
1760 int i;
1761 COFF_header* hdr
1762 = (COFF_header*)(oc->image);
1763 COFF_section* sectab
1764 = (COFF_section*) (
1765 ((UChar*)(oc->image))
1766 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1767 );
1768 for (i = 0; i < hdr->NumberOfSections; i++) {
1769 UChar* n1;
1770 UChar* n2;
1771 COFF_section* section_i
1772 = (COFF_section*)
1773 myindex ( sizeof_COFF_section, sectab, i );
1774 n1 = (UChar*) &(section_i->Name);
1775 n2 = name;
1776 if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
1777 n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
1778 n1[6]==n2[6] && n1[7]==n2[7])
1779 return section_i;
1780 }
1781
1782 return NULL;
1783 }
1784
1785
1786 static void
1787 zapTrailingAtSign ( UChar* sym )
1788 {
1789 # define my_isdigit(c) ((c) >= '0' && (c) <= '9')
1790 int i, j;
1791 if (sym[0] == 0) return;
1792 i = 0;
1793 while (sym[i] != 0) i++;
1794 i--;
1795 j = i;
1796 while (j > 0 && my_isdigit(sym[j])) j--;
1797 if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
1798 # undef my_isdigit
1799 }
1800
1801
1802 static int
1803 ocVerifyImage_PEi386 ( ObjectCode* oc )
1804 {
1805 int i;
1806 UInt32 j, noRelocs;
1807 COFF_header* hdr;
1808 COFF_section* sectab;
1809 COFF_symbol* symtab;
1810 UChar* strtab;
1811 /* debugBelch("\nLOADING %s\n", oc->fileName); */
1812 hdr = (COFF_header*)(oc->image);
1813 sectab = (COFF_section*) (
1814 ((UChar*)(oc->image))
1815 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1816 );
1817 symtab = (COFF_symbol*) (
1818 ((UChar*)(oc->image))
1819 + hdr->PointerToSymbolTable
1820 );
1821 strtab = ((UChar*)symtab)
1822 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1823
1824 if (hdr->Machine != 0x14c) {
1825 errorBelch("%s: Not x86 PEi386", oc->fileName);
1826 return 0;
1827 }
1828 if (hdr->SizeOfOptionalHeader != 0) {
1829 errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
1830 return 0;
1831 }
1832 if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1833 (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1834 (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1835 (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1836 errorBelch("%s: Not a PEi386 object file", oc->fileName);
1837 return 0;
1838 }
1839 if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1840 /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1841 errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
1842 oc->fileName,
1843 (int)(hdr->Characteristics));
1844 return 0;
1845 }
1846 /* If the string table size is way crazy, this might indicate that
1847 there are more than 64k relocations, despite claims to the
1848 contrary. Hence this test. */
1849 /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
1850 #if 0
1851 if ( (*(UInt32*)strtab) > 600000 ) {
1852 /* Note that 600k has no special significance other than being
1853 big enough to handle the almost-2MB-sized lumps that
1854 constitute HSwin32*.o. */
1855 debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
1856 return 0;
1857 }
1858 #endif
1859
1860 /* No further verification after this point; only debug printing. */
1861 i = 0;
1862 IF_DEBUG(linker, i=1);
1863 if (i == 0) return 1;
1864
1865 debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1866 debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1867 debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1868
1869 debugBelch("\n" );
1870 debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
1871 debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
1872 debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1873 debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
1874 debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
1875 debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
1876 debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
1877
1878 /* Print the section table. */
1879 debugBelch("\n" );
1880 for (i = 0; i < hdr->NumberOfSections; i++) {
1881 COFF_reloc* reltab;
1882 COFF_section* sectab_i
1883 = (COFF_section*)
1884 myindex ( sizeof_COFF_section, sectab, i );
1885 debugBelch(
1886 "\n"
1887 "section %d\n"
1888 " name `",
1889 i
1890 );
1891 printName ( sectab_i->Name, strtab );
1892 debugBelch(
1893 "'\n"
1894 " vsize %d\n"
1895 " vaddr %d\n"
1896 " data sz %d\n"
1897 " data off %d\n"
1898 " num rel %d\n"
1899 " off rel %d\n"
1900 " ptr raw 0x%x\n",
1901 sectab_i->VirtualSize,
1902 sectab_i->VirtualAddress,
1903 sectab_i->SizeOfRawData,
1904 sectab_i->PointerToRawData,
1905 sectab_i->NumberOfRelocations,
1906 sectab_i->PointerToRelocations,
1907 sectab_i->PointerToRawData
1908 );
1909 reltab = (COFF_reloc*) (
1910 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1911 );
1912
1913 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
1914 /* If the relocation field (a short) has overflowed, the
1915 * real count can be found in the first reloc entry.
1916 *
1917 * See Section 4.1 (last para) of the PE spec (rev6.0).
1918 */
1919 COFF_reloc* rel = (COFF_reloc*)
1920 myindex ( sizeof_COFF_reloc, reltab, 0 );
1921 noRelocs = rel->VirtualAddress;
1922 j = 1;
1923 } else {
1924 noRelocs = sectab_i->NumberOfRelocations;
1925 j = 0;
1926 }
1927
1928 for (; j < noRelocs; j++) {
1929 COFF_symbol* sym;
1930 COFF_reloc* rel = (COFF_reloc*)
1931 myindex ( sizeof_COFF_reloc, reltab, j );
1932 debugBelch(
1933 " type 0x%-4x vaddr 0x%-8x name `",
1934 (UInt32)rel->Type,
1935 rel->VirtualAddress );
1936 sym = (COFF_symbol*)
1937 myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1938 /* Hmm..mysterious looking offset - what's it for? SOF */
1939 printName ( sym->Name, strtab -10 );
1940 debugBelch("'\n" );
1941 }
1942
1943 debugBelch("\n" );
1944 }
1945 debugBelch("\n" );
1946 debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
1947 debugBelch("---START of string table---\n");
1948 for (i = 4; i < *(Int32*)strtab; i++) {
1949 if (strtab[i] == 0)
1950 debugBelch("\n"); else
1951 debugBelch("%c", strtab[i] );
1952 }
1953 debugBelch("--- END of string table---\n");
1954
1955 debugBelch("\n" );
1956 i = 0;
1957 while (1) {
1958 COFF_symbol* symtab_i;
1959 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1960 symtab_i = (COFF_symbol*)
1961 myindex ( sizeof_COFF_symbol, symtab, i );
1962 debugBelch(
1963 "symbol %d\n"
1964 " name `",
1965 i
1966 );
1967 printName ( symtab_i->Name, strtab );
1968 debugBelch(
1969 "'\n"
1970 " value 0x%x\n"
1971 " 1+sec# %d\n"
1972 " type 0x%x\n"
1973 " sclass 0x%x\n"
1974 " nAux %d\n",
1975 symtab_i->Value,
1976 (Int32)(symtab_i->SectionNumber),
1977 (UInt32)symtab_i->Type,
1978 (UInt32)symtab_i->StorageClass,
1979 (UInt32)symtab_i->NumberOfAuxSymbols
1980 );
1981 i += symtab_i->NumberOfAuxSymbols;
1982 i++;
1983 }
1984
1985 debugBelch("\n" );
1986 return 1;
1987 }
1988
1989
1990 static int
1991 ocGetNames_PEi386 ( ObjectCode* oc )
1992 {
1993 COFF_header* hdr;
1994 COFF_section* sectab;
1995 COFF_symbol* symtab;
1996 UChar* strtab;
1997
1998 UChar* sname;
1999 void* addr;
2000 int i;
2001
2002 hdr = (COFF_header*)(oc->image);
2003 sectab = (COFF_section*) (
2004 ((UChar*)(oc->image))
2005 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2006 );
2007 symtab = (COFF_symbol*) (
2008 ((UChar*)(oc->image))
2009 + hdr->PointerToSymbolTable
2010 );
2011 strtab = ((UChar*)(oc->image))
2012 + hdr->PointerToSymbolTable
2013 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2014
2015 /* Allocate space for any (local, anonymous) .bss sections. */
2016
2017 for (i = 0; i < hdr->NumberOfSections; i++) {
2018 UChar* zspace;
2019 COFF_section* sectab_i
2020 = (COFF_section*)
2021 myindex ( sizeof_COFF_section, sectab, i );
2022 if (0 != strcmp(sectab_i->Name, ".bss")) continue;
2023 if (sectab_i->VirtualSize == 0) continue;
2024 /* This is a non-empty .bss section. Allocate zeroed space for
2025 it, and set its PointerToRawData field such that oc->image +
2026 PointerToRawData == addr_of_zeroed_space. */
2027 zspace = stgCallocBytes(1, sectab_i->VirtualSize,
2028 "ocGetNames_PEi386(anonymous bss)");
2029 sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
2030 addProddableBlock(oc, zspace, sectab_i->VirtualSize);
2031 /* debugBelch("BSS anon section at 0x%x\n", zspace); */
2032 }
2033
2034 /* Copy section information into the ObjectCode. */
2035
2036 for (i = 0; i < hdr->NumberOfSections; i++) {
2037 UChar* start;
2038 UChar* end;
2039 UInt32 sz;
2040
2041 SectionKind kind
2042 = SECTIONKIND_OTHER;
2043 COFF_section* sectab_i
2044 = (COFF_section*)
2045 myindex ( sizeof_COFF_section, sectab, i );
2046 IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
2047
2048 # if 0
2049 /* I'm sure this is the Right Way to do it. However, the
2050 alternative of testing the sectab_i->Name field seems to
2051 work ok with Cygwin.
2052 */
2053 if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
2054 sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
2055 kind = SECTIONKIND_CODE_OR_RODATA;
2056 # endif
2057
2058 if (0==strcmp(".text",sectab_i->Name) ||
2059 0==strcmp(".rdata",sectab_i->Name)||
2060 0==strcmp(".rodata",sectab_i->Name))
2061 kind = SECTIONKIND_CODE_OR_RODATA;
2062 if (0==strcmp(".data",sectab_i->Name) ||
2063 0==strcmp(".bss",sectab_i->Name))
2064 kind = SECTIONKIND_RWDATA;
2065
2066 ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
2067 sz = sectab_i->SizeOfRawData;
2068 if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
2069
2070 start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
2071 end = start + sz - 1;
2072
2073 if (kind == SECTIONKIND_OTHER
2074 /* Ignore sections called which contain stabs debugging
2075 information. */
2076 && 0 != strcmp(".stab", sectab_i->Name)
2077 && 0 != strcmp(".stabstr", sectab_i->Name)
2078 /* ignore constructor section for now */
2079 && 0 != strcmp(".ctors", sectab_i->Name)
2080 ) {
2081 errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
2082 return 0;
2083 }
2084
2085 if (kind != SECTIONKIND_OTHER && end >= start) {
2086 addSection(oc, kind, start, end);
2087 addProddableBlock(oc, start, end - start + 1);
2088 }
2089 }
2090
2091 /* Copy exported symbols into the ObjectCode. */
2092
2093 oc->n_symbols = hdr->NumberOfSymbols;
2094 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2095 "ocGetNames_PEi386(oc->symbols)");
2096 /* Call me paranoid; I don't care. */
2097 for (i = 0; i < oc->n_symbols; i++)
2098 oc->symbols[i] = NULL;
2099
2100 i = 0;
2101 while (1) {
2102 COFF_symbol* symtab_i;
2103 if (i >= (Int32)(hdr->NumberOfSymbols)) break;
2104 symtab_i = (COFF_symbol*)
2105 myindex ( sizeof_COFF_symbol, symtab, i );
2106
2107 addr = NULL;
2108
2109 if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
2110 && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
2111 /* This symbol is global and defined, viz, exported */
2112 /* for MYIMAGE_SYMCLASS_EXTERNAL
2113 && !MYIMAGE_SYM_UNDEFINED,
2114 the address of the symbol is:
2115 address of relevant section + offset in section
2116 */
2117 COFF_section* sectabent
2118 = (COFF_section*) myindex ( sizeof_COFF_section,
2119 sectab,
2120 symtab_i->SectionNumber-1 );
2121 addr = ((UChar*)(oc->image))
2122 + (sectabent->PointerToRawData
2123 + symtab_i->Value);
2124 }
2125 else
2126 if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
2127 && symtab_i->Value > 0) {
2128 /* This symbol isn't in any section at all, ie, global bss.
2129 Allocate zeroed space for it. */
2130 addr = stgCallocBytes(1, symtab_i->Value,
2131 "ocGetNames_PEi386(non-anonymous bss)");
2132 addSection(oc, SECTIONKIND_RWDATA, addr,
2133 ((UChar*)addr) + symtab_i->Value - 1);
2134 addProddableBlock(oc, addr, symtab_i->Value);
2135 /* debugBelch("BSS section at 0x%x\n", addr); */
2136 }
2137
2138 if (addr != NULL ) {
2139 sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
2140 /* debugBelch("addSymbol %p `%s \n", addr,sname); */
2141 IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
2142 ASSERT(i >= 0 && i < oc->n_symbols);
2143 /* cstring_from_COFF_symbol_name always succeeds. */
2144 oc->symbols[i] = sname;
2145 ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
2146 } else {
2147 # if 0
2148 debugBelch(
2149 "IGNORING symbol %d\n"
2150 " name `",
2151 i
2152 );
2153 printName ( symtab_i->Name, strtab );
2154 debugBelch(
2155 "'\n"
2156 " value 0x%x\n"
2157 " 1+sec# %d\n"
2158 " type 0x%x\n"
2159 " sclass 0x%x\n"
2160 " nAux %d\n",
2161 symtab_i->Value,
2162 (Int32)(symtab_i->SectionNumber),
2163 (UInt32)symtab_i->Type,
2164 (UInt32)symtab_i->StorageClass,
2165 (UInt32)symtab_i->NumberOfAuxSymbols
2166 );
2167 # endif
2168 }
2169
2170 i += symtab_i->NumberOfAuxSymbols;
2171 i++;
2172 }
2173
2174 return 1;
2175 }
2176
2177
2178 static int
2179 ocResolve_PEi386 ( ObjectCode* oc )
2180 {
2181 COFF_header* hdr;
2182 COFF_section* sectab;
2183 COFF_symbol* symtab;
2184 UChar* strtab;
2185
2186 UInt32 A;
2187 UInt32 S;
2188 UInt32* pP;
2189
2190 int i;
2191 UInt32 j, noRelocs;
2192
2193 /* ToDo: should be variable-sized? But is at least safe in the
2194 sense of buffer-overrun-proof. */
2195 char symbol[1000];
2196 /* debugBelch("resolving for %s\n", oc->fileName); */
2197
2198 hdr = (COFF_header*)(oc->image);
2199 sectab = (COFF_section*) (
2200 ((UChar*)(oc->image))
2201 + sizeof_COFF_header + hdr->SizeOfOptionalHeader
2202 );
2203 symtab = (COFF_symbol*) (
2204 ((UChar*)(oc->image))
2205 + hdr->PointerToSymbolTable
2206 );
2207 strtab = ((UChar*)(oc->image))
2208 + hdr->PointerToSymbolTable
2209 + hdr->NumberOfSymbols * sizeof_COFF_symbol;
2210
2211 for (i = 0; i < hdr->NumberOfSections; i++) {
2212 COFF_section* sectab_i
2213 = (COFF_section*)
2214 myindex ( sizeof_COFF_section, sectab, i );
2215 COFF_reloc* reltab
2216 = (COFF_reloc*) (
2217 ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
2218 );
2219
2220 /* Ignore sections called which contain stabs debugging
2221 information. */
2222 if (0 == strcmp(".stab", sectab_i->Name)
2223 || 0 == strcmp(".stabstr", sectab_i->Name)
2224 || 0 == strcmp(".ctors", sectab_i->Name))
2225 continue;
2226
2227 if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
2228 /* If the relocation field (a short) has overflowed, the
2229 * real count can be found in the first reloc entry.
2230 *
2231 * See Section 4.1 (last para) of the PE spec (rev6.0).
2232 *
2233 * Nov2003 update: the GNU linker still doesn't correctly
2234 * handle the generation of relocatable object files with
2235 * overflown relocations. Hence the output to warn of potential
2236 * troubles.
2237 */
2238 COFF_reloc* rel = (COFF_reloc*)
2239 myindex ( sizeof_COFF_reloc, reltab, 0 );
2240 noRelocs = rel->VirtualAddress;
2241 debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
2242 noRelocs);
2243 j = 1;
2244 } else {
2245 noRelocs = sectab_i->NumberOfRelocations;
2246 j = 0;
2247 }
2248
2249
2250 for (; j < noRelocs; j++) {
2251 COFF_symbol* sym;
2252 COFF_reloc* reltab_j
2253 = (COFF_reloc*)
2254 myindex ( sizeof_COFF_reloc, reltab, j );
2255
2256 /* the location to patch */
2257 pP = (UInt32*)(
2258 ((UChar*)(oc->image))
2259 + (sectab_i->PointerToRawData
2260 + reltab_j->VirtualAddress
2261 - sectab_i->VirtualAddress )
2262 );
2263 /* the existing contents of pP */
2264 A = *pP;
2265 /* the symbol to connect to */
2266 sym = (COFF_symbol*)
2267 myindex ( sizeof_COFF_symbol,
2268 symtab, reltab_j->SymbolTableIndex );
2269 IF_DEBUG(linker,
2270 debugBelch(
2271 "reloc sec %2d num %3d: type 0x%-4x "
2272 "vaddr 0x%-8x name `",
2273 i, j,
2274 (UInt32)reltab_j->Type,
2275 reltab_j->VirtualAddress );
2276 printName ( sym->Name, strtab );
2277 debugBelch("'\n" ));
2278
2279 if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
2280 COFF_section* section_sym
2281 = findPEi386SectionCalled ( oc, sym->Name );
2282 if (!section_sym) {
2283 errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
2284 return 0;
2285 }
2286 S = ((UInt32)(oc->image))
2287 + (section_sym->PointerToRawData
2288 + sym->Value);
2289 } else {
2290 copyName ( sym->Name, strtab, symbol, 1000-1 );
2291 (void*)S = lookupLocalSymbol( oc, symbol );
2292 if ((void*)S != NULL) goto foundit;
2293 (void*)S = lookupSymbol( symbol );
2294 if ((void*)S != NULL) goto foundit;
2295 zapTrailingAtSign ( symbol );
2296 (void*)S = lookupLocalSymbol( oc, symbol );
2297 if ((void*)S != NULL) goto foundit;
2298 (void*)S = lookupSymbol( symbol );
2299 if ((void*)S != NULL) goto foundit;
2300 /* Newline first because the interactive linker has printed "linking..." */
2301 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
2302 return 0;
2303 foundit:;
2304 }
2305 checkProddableBlock(oc, pP);
2306 switch (reltab_j->Type) {
2307 case MYIMAGE_REL_I386_DIR32:
2308 *pP = A + S;
2309 break;
2310 case MYIMAGE_REL_I386_REL32:
2311 /* Tricky. We have to insert a displacement at
2312 pP which, when added to the PC for the _next_
2313 insn, gives the address of the target (S).
2314 Problem is to know the address of the next insn
2315 when we only know pP. We assume that this
2316 literal field is always the last in the insn,
2317 so that the address of the next insn is pP+4
2318 -- hence the constant 4.
2319 Also I don't know if A should be added, but so
2320 far it has always been zero.
2321
2322 SOF 05/2005: 'A' (old contents of *pP) have been observed
2323 to contain values other than zero (the 'wx' object file
2324 that came with wxhaskell-0.9.4; dunno how it was compiled..).
2325 So, add displacement to old value instead of asserting
2326 A to be zero. Fixes wxhaskell-related crashes, and no other
2327 ill effects have been observed.
2328
2329 Update: the reason why we're seeing these more elaborate
2330 relocations is due to a switch in how the NCG compiles SRTs
2331 and offsets to them from info tables. SRTs live in .(ro)data,
2332 while info tables live in .text, causing GAS to emit REL32/DISP32
2333 relocations with non-zero values. Adding the displacement is
2334 the right thing to do.
2335 */
2336 *pP = S - ((UInt32)pP) - 4 + A;
2337 break;
2338 default:
2339 debugBelch("%s: unhandled PEi386 relocation type %d",
2340 oc->fileName, reltab_j->Type);
2341 return 0;
2342 }
2343
2344 }
2345 }
2346
2347 IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
2348 return 1;
2349 }
2350
2351 #endif /* defined(OBJFORMAT_PEi386) */
2352
2353
2354 /* --------------------------------------------------------------------------
2355 * ELF specifics
2356 * ------------------------------------------------------------------------*/
2357
2358 #if defined(OBJFORMAT_ELF)
2359
2360 #define FALSE 0
2361 #define TRUE 1
2362
2363 #if defined(sparc_HOST_ARCH)
2364 # define ELF_TARGET_SPARC /* Used inside <elf.h> */
2365 #elif defined(i386_HOST_ARCH)
2366 # define ELF_TARGET_386 /* Used inside <elf.h> */
2367 #elif defined(x86_64_HOST_ARCH)
2368 # define ELF_TARGET_X64_64
2369 # define ELF_64BIT
2370 #elif defined (ia64_HOST_ARCH)
2371 # define ELF_TARGET_IA64 /* Used inside <elf.h> */
2372 # define ELF_64BIT
2373 # define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
2374 # define ELF_NEED_GOT /* needs Global Offset Table */
2375 # define ELF_NEED_PLT /* needs Procedure Linkage Tables */
2376 #endif
2377
2378 #if !defined(openbsd_HOST_OS)
2379 #include <elf.h>
2380 #else
2381 /* openbsd elf has things in different places, with diff names */
2382 #include <elf_abi.h>
2383 #include <machine/reloc.h>
2384 #define R_386_32 RELOC_32
2385 #define R_386_PC32 RELOC_PC32
2386 #endif
2387
2388 /*
2389 * Define a set of types which can be used for both ELF32 and ELF64
2390 */
2391
2392 #ifdef ELF_64BIT
2393 #define ELFCLASS ELFCLASS64
2394 #define Elf_Addr Elf64_Addr
2395 #define Elf_Word Elf64_Word
2396 #define Elf_Sword Elf64_Sword
2397 #define Elf_Ehdr Elf64_Ehdr
2398 #define Elf_Phdr Elf64_Phdr
2399 #define Elf_Shdr Elf64_Shdr
2400 #define Elf_Sym Elf64_Sym
2401 #define Elf_Rel Elf64_Rel
2402 #define Elf_Rela Elf64_Rela
2403 #define ELF_ST_TYPE ELF64_ST_TYPE
2404 #define ELF_ST_BIND ELF64_ST_BIND
2405 #define ELF_R_TYPE ELF64_R_TYPE
2406 #define ELF_R_SYM ELF64_R_SYM
2407 #else
2408 #define ELFCLASS ELFCLASS32
2409 #define Elf_Addr Elf32_Addr
2410 #define Elf_Word Elf32_Word
2411 #define Elf_Sword Elf32_Sword
2412 #define Elf_Ehdr Elf32_Ehdr
2413 #define Elf_Phdr Elf32_Phdr
2414 #define Elf_Shdr Elf32_Shdr
2415 #define Elf_Sym Elf32_Sym
2416 #define Elf_Rel Elf32_Rel
2417 #define Elf_Rela Elf32_Rela
2418 #ifndef ELF_ST_TYPE
2419 #define ELF_ST_TYPE ELF32_ST_TYPE
2420 #endif
2421 #ifndef ELF_ST_BIND
2422 #define ELF_ST_BIND ELF32_ST_BIND
2423 #endif
2424 #ifndef ELF_R_TYPE
2425 #define ELF_R_TYPE ELF32_R_TYPE
2426 #endif
2427 #ifndef ELF_R_SYM
2428 #define ELF_R_SYM ELF32_R_SYM
2429 #endif
2430 #endif
2431
2432
2433 /*
2434 * Functions to allocate entries in dynamic sections. Currently we simply
2435 * preallocate a large number, and we don't check if a entry for the given
2436 * target already exists (a linear search is too slow). Ideally these
2437 * entries would be associated with symbols.
2438 */
2439
2440 /* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
2441 #define GOT_SIZE 0x20000
2442 #define FUNCTION_TABLE_SIZE 0x10000
2443 #define PLT_SIZE 0x08000
2444
2445 #ifdef ELF_NEED_GOT
2446 static Elf_Addr got[GOT_SIZE];
2447 static unsigned int gotIndex;
2448 static Elf_Addr gp_val = (Elf_Addr)got;
2449
2450 static Elf_Addr
2451 allocateGOTEntry(Elf_Addr target)
2452 {
2453 Elf_Addr *entry;
2454
2455 if (gotIndex >= GOT_SIZE)
2456 barf("Global offset table overflow");
2457
2458 entry = &got[gotIndex++];
2459 *entry = target;
2460 return (Elf_Addr)entry;
2461 }
2462 #endif
2463
2464 #ifdef ELF_FUNCTION_DESC
2465 typedef struct {
2466 Elf_Addr ip;
2467 Elf_Addr gp;
2468 } FunctionDesc;
2469
2470 static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
2471 static unsigned int functionTableIndex;
2472
2473 static Elf_Addr
2474 allocateFunctionDesc(Elf_Addr target)
2475 {
2476 FunctionDesc *entry;
2477
2478 if (functionTableIndex >= FUNCTION_TABLE_SIZE)
2479 barf("Function table overflow");
2480
2481 entry = &functionTable[functionTableIndex++];
2482 entry->ip = target;
2483 entry->gp = (Elf_Addr)gp_val;
2484 return (Elf_Addr)entry;
2485 }
2486
2487 static Elf_Addr
2488 copyFunctionDesc(Elf_Addr target)
2489 {
2490 FunctionDesc *olddesc = (FunctionDesc *)target;
2491 FunctionDesc *newdesc;
2492
2493 newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
2494 newdesc->gp = olddesc->gp;
2495 return (Elf_Addr)newdesc;
2496 }
2497 #endif
2498
2499 #ifdef ELF_NEED_PLT
2500 #ifdef ia64_HOST_ARCH
2501 static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
2502 static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
2503
2504 static unsigned char plt_code[] =
2505 {
2506 /* taken from binutils bfd/elfxx-ia64.c */
2507 0x0b, 0x78, 0x00, 0x02, 0x00, 0x24, /* [MMI] addl r15=0,r1;; */
2508 0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0, /* ld8 r16=[r15],8 */
2509 0x01, 0x08, 0x00, 0x84, /* mov r14=r1;; */
2510 0x11, 0x08, 0x00, 0x1e, 0x18, 0x10, /* [MIB] ld8 r1=[r15] */
2511 0x60, 0x80, 0x04, 0x80, 0x03, 0x00, /* mov b6=r16 */
2512 0x60, 0x00, 0x80, 0x00 /* br.few b6;; */
2513 };
2514
2515 /* If we can't get to the function descriptor via gp, take a local copy of it */
2516 #define PLT_RELOC(code, target) { \
2517 Elf64_Sxword rel_value = target - gp_val; \
2518 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
2519 ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
2520 else \
2521 ia64_reloc_gprel22((Elf_Addr)code, target); \
2522 }
2523 #endif
2524
2525 typedef struct {
2526 unsigned char code[sizeof(plt_code)];
2527 } PLTEntry;
2528
2529 static Elf_Addr
2530 allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
2531 {
2532 PLTEntry *plt = (PLTEntry *)oc->plt;
2533 PLTEntry *entry;
2534
2535 if (oc->pltIndex >= PLT_SIZE)
2536 barf("Procedure table overflow");
2537
2538 entry = &plt[oc->pltIndex++];
2539 memcpy(entry->code, plt_code, sizeof(entry->code));
2540 PLT_RELOC(entry->code, target);
2541 return (Elf_Addr)entry;
2542 }
2543
2544 static unsigned int
2545 PLTSize(void)
2546 {
2547 return (PLT_SIZE * sizeof(PLTEntry));
2548 }
2549 #endif
2550
2551
2552 #if x86_64_HOST_ARCH
2553 // On x86_64, 32-bit relocations are often used, which requires that
2554 // we can resolve a symbol to a 32-bit offset. However, shared
2555 // libraries are placed outside the 2Gb area, which leaves us with a
2556 // problem when we need to give a 32-bit offset to a symbol in a
2557 // shared library.
2558 //
2559 // For a function symbol, we can allocate a bounce sequence inside the
2560 // 2Gb area and resolve the symbol to this. The bounce sequence is
2561 // simply a long jump instruction to the real location of the symbol.
2562 //
2563 // For data references, we're screwed.
2564 //
2565 typedef struct {
2566 unsigned char jmp[8]; /* 6 byte instruction: jmpq *0x00000002(%rip) */
2567 void *addr;
2568 } x86_64_bounce;
2569
2570 #define X86_64_BB_SIZE 1024
2571
2572 static x86_64_bounce *x86_64_bounce_buffer = NULL;
2573 static nat x86_64_bb_next_off;
2574
2575 static void*
2576 x86_64_high_symbol( char *lbl, void *addr )
2577 {
2578 x86_64_bounce *bounce;
2579
2580 if ( x86_64_bounce_buffer == NULL ||
2581 x86_64_bb_next_off >= X86_64_BB_SIZE ) {
2582 x86_64_bounce_buffer =
2583 mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce),
2584 PROT_EXEC|PROT_READ|PROT_WRITE,
2585 MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
2586 if (x86_64_bounce_buffer == MAP_FAILED) {
2587 barf("x86_64_high_symbol: mmap failed");
2588 }
2589 x86_64_bb_next_off = 0;
2590 }
2591 bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
2592 bounce->jmp[0] = 0xff;
2593 bounce->jmp[1] = 0x25;
2594 bounce->jmp[2] = 0x02;
2595 bounce->jmp[3] = 0x00;
2596 bounce->jmp[4] = 0x00;
2597 bounce->jmp[5] = 0x00;
2598 bounce->addr = addr;
2599 x86_64_bb_next_off++;
2600
2601 IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
2602 lbl, addr, bounce));
2603
2604 insertStrHashTable(symhash, lbl, bounce);
2605 return bounce;
2606 }
2607 #endif
2608
2609
2610 /*
2611 * Generic ELF functions
2612 */
2613
2614 static char *
2615 findElfSection ( void* objImage, Elf_Word sh_type )
2616 {
2617 char* ehdrC = (char*)objImage;
2618 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2619 Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
2620 char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2621 char* ptr = NULL;
2622 int i;
2623
2624 for (i = 0; i < ehdr->e_shnum; i++) {
2625 if (shdr[i].sh_type == sh_type
2626 /* Ignore the section header's string table. */
2627 && i != ehdr->e_shstrndx
2628 /* Ignore string tables named .stabstr, as they contain
2629 debugging info. */
2630 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2631 ) {
2632 ptr = ehdrC + shdr[i].sh_offset;
2633 break;
2634 }
2635 }
2636 return ptr;
2637 }
2638
2639 #if defined(ia64_HOST_ARCH)
2640 static Elf_Addr
2641 findElfSegment ( void* objImage, Elf_Addr vaddr )
2642 {
2643 char* ehdrC = (char*)objImage;
2644 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2645 Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
2646 Elf_Addr segaddr = 0;
2647 int i;
2648
2649 for (i = 0; i < ehdr->e_phnum; i++) {
2650 segaddr = phdr[i].p_vaddr;
2651 if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
2652 break;
2653 }
2654 return segaddr;
2655 }
2656 #endif
2657
2658 static int
2659 ocVerifyImage_ELF ( ObjectCode* oc )
2660 {
2661 Elf_Shdr* shdr;
2662 Elf_Sym* stab;
2663 int i, j, nent, nstrtab, nsymtabs;
2664 char* sh_strtab;
2665 char* strtab;
2666
2667 char* ehdrC = (char*)(oc->image);
2668 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2669
2670 if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
2671 ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
2672 ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
2673 ehdr->e_ident[EI_MAG3] != ELFMAG3) {
2674 errorBelch("%s: not an ELF object", oc->fileName);
2675 return 0;
2676 }
2677
2678 if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
2679 errorBelch("%s: unsupported ELF format", oc->fileName);
2680 return 0;
2681 }
2682
2683 if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
2684 IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
2685 } else
2686 if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
2687 IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
2688 } else {
2689 errorBelch("%s: unknown endiannness", oc->fileName);
2690 return 0;
2691 }
2692
2693 if (ehdr->e_type != ET_REL) {
2694 errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
2695 return 0;
2696 }
2697 IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
2698
2699 IF_DEBUG(linker,debugBelch( "Architecture is " ));
2700 switch (ehdr->e_machine) {
2701 case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
2702 case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
2703 #ifdef EM_IA_64
2704 case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
2705 #endif
2706 case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
2707 #ifdef EM_X86_64
2708 case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
2709 #endif
2710 default: IF_DEBUG(linker,debugBelch( "unknown" ));
2711 errorBelch("%s: unknown architecture", oc->fileName);
2712 return 0;
2713 }
2714
2715 IF_DEBUG(linker,debugBelch(
2716 "\nSection header table: start %d, n_entries %d, ent_size %d\n",
2717 ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
2718
2719 ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
2720
2721 shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2722
2723 if (ehdr->e_shstrndx == SHN_UNDEF) {
2724 errorBelch("%s: no section header string table", oc->fileName);
2725 return 0;
2726 } else {
2727 IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
2728 ehdr->e_shstrndx));
2729 sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
2730 }
2731
2732 for (i = 0; i < ehdr->e_shnum; i++) {
2733 IF_DEBUG(linker,debugBelch("%2d: ", i ));
2734 IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
2735 IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
2736 IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
2737 IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
2738 ehdrC + shdr[i].sh_offset,
2739 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
2740
2741 if (shdr[i].sh_type == SHT_REL) {
2742 IF_DEBUG(linker,debugBelch("Rel " ));
2743 } else if (shdr[i].sh_type == SHT_RELA) {
2744 IF_DEBUG(linker,debugBelch("RelA " ));
2745 } else {
2746 IF_DEBUG(linker,debugBelch(" "));
2747 }
2748 if (sh_strtab) {
2749 IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
2750 }
2751 }
2752
2753 IF_DEBUG(linker,debugBelch( "\nString tables" ));
2754 strtab = NULL;
2755 nstrtab = 0;
2756 for (i = 0; i < ehdr->e_shnum; i++) {
2757 if (shdr[i].sh_type == SHT_STRTAB
2758 /* Ignore the section header's string table. */
2759 && i != ehdr->e_shstrndx
2760 /* Ignore string tables named .stabstr, as they contain
2761 debugging info. */
2762 && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
2763 ) {
2764 IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
2765 strtab = ehdrC + shdr[i].sh_offset;
2766 nstrtab++;
2767 }
2768 }
2769 if (nstrtab != 1) {
2770 errorBelch("%s: no string tables, or too many", oc->fileName);
2771 return 0;
2772 }
2773
2774 nsymtabs = 0;
2775 IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
2776 for (i = 0; i < ehdr->e_shnum; i++) {
2777 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2778 IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
2779 nsymtabs++;
2780 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2781 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2782 IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)\n",
2783 nent,
2784 shdr[i].sh_size % sizeof(Elf_Sym)
2785 ));
2786 if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
2787 errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
2788 return 0;
2789 }
2790 for (j = 0; j < nent; j++) {
2791 IF_DEBUG(linker,debugBelch(" %2d ", j ));
2792 IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
2793 (int)stab[j].st_shndx,
2794 (int)stab[j].st_size,
2795 (char*)stab[j].st_value ));
2796
2797 IF_DEBUG(linker,debugBelch("type=" ));
2798 switch (ELF_ST_TYPE(stab[j].st_info)) {
2799 case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
2800 case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
2801 case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
2802 case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
2803 case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
2804 default: IF_DEBUG(linker,debugBelch("? " )); break;
2805 }
2806 IF_DEBUG(linker,debugBelch(" " ));
2807
2808 IF_DEBUG(linker,debugBelch("bind=" ));
2809 switch (ELF_ST_BIND(stab[j].st_info)) {
2810 case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
2811 case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
2812 case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
2813 default: IF_DEBUG(linker,debugBelch("? " )); break;
2814 }
2815 IF_DEBUG(linker,debugBelch(" " ));
2816
2817 IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
2818 }
2819 }
2820
2821 if (nsymtabs == 0) {
2822 errorBelch("%s: didn't find any symbol tables", oc->fileName);
2823 return 0;
2824 }
2825
2826 return 1;
2827 }
2828
2829 static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
2830 {
2831 *is_bss = FALSE;
2832
2833 if (hdr->sh_type == SHT_PROGBITS
2834 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
2835 /* .text-style section */
2836 return SECTIONKIND_CODE_OR_RODATA;
2837 }
2838
2839 if (hdr->sh_type == SHT_PROGBITS
2840 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2841 /* .data-style section */
2842 return SECTIONKIND_RWDATA;
2843 }
2844
2845 if (hdr->sh_type == SHT_PROGBITS
2846 && (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
2847 /* .rodata-style section */
2848 return SECTIONKIND_CODE_OR_RODATA;
2849 }
2850
2851 if (hdr->sh_type == SHT_NOBITS
2852 && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
2853 /* .bss-style section */
2854 *is_bss = TRUE;
2855 return SECTIONKIND_RWDATA;
2856 }
2857
2858 return SECTIONKIND_OTHER;
2859 }
2860
2861
2862 static int
2863 ocGetNames_ELF ( ObjectCode* oc )
2864 {
2865 int i, j, k, nent;
2866 Elf_Sym* stab;
2867
2868 char* ehdrC = (char*)(oc->image);
2869 Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
2870 char* strtab = findElfSection ( ehdrC, SHT_STRTAB );
2871 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
2872
2873 ASSERT(symhash != NULL);
2874
2875 if (!strtab) {
2876 errorBelch("%s: no strtab", oc->fileName);
2877 return 0;
2878 }
2879
2880 k = 0;
2881 for (i = 0; i < ehdr->e_shnum; i++) {
2882 /* Figure out what kind of section it is. Logic derived from
2883 Figure 1.14 ("Special Sections") of the ELF document
2884 ("Portable Formats Specification, Version 1.1"). */
2885 int is_bss = FALSE;
2886 SectionKind kind = getSectionKind_ELF(&shdr[i], &is_bss);
2887
2888 if (is_bss && shdr[i].sh_size > 0) {
2889 /* This is a non-empty .bss section. Allocate zeroed space for
2890 it, and set its .sh_offset field such that
2891 ehdrC + .sh_offset == addr_of_zeroed_space. */
2892 char* zspace = stgCallocBytes(1, shdr[i].sh_size,
2893 "ocGetNames_ELF(BSS)");
2894 shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
2895 /*
2896 debugBelch("BSS section at 0x%x, size %d\n",
2897 zspace, shdr[i].sh_size);
2898 */
2899 }
2900
2901 /* fill in the section info */
2902 if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
2903 addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
2904 addSection(oc, kind, ehdrC + shdr[i].sh_offset,
2905 ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
2906 }
2907
2908 if (shdr[i].sh_type != SHT_SYMTAB) continue;
2909
2910 /* copy stuff into this module's object symbol table */
2911 stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
2912 nent = shdr[i].sh_size / sizeof(Elf_Sym);
2913
2914 oc->n_symbols = nent;
2915 oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
2916 "ocGetNames_ELF(oc->symbols)");
2917
2918 for (j = 0; j < nent; j++) {
2919
2920 char isLocal = FALSE; /* avoids uninit-var warning */
2921 char* ad = NULL;
2922 char* nm = strtab + stab[j].st_name;
2923 int secno = stab[j].st_shndx;
2924
2925 /* Figure out if we want to add it; if so, set ad to its
2926 address. Otherwise leave ad == NULL. */
2927
2928 if (secno == SHN_COMMON) {
2929 isLocal = FALSE;
2930 ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
2931 /*
2932 debugBelch("COMMON symbol, size %d name %s\n",
2933 stab[j].st_size, nm);
2934 */
2935 /* Pointless to do addProddableBlock() for this area,
2936 since the linker should never poke around in it. */
2937 }
2938 else
2939 if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
2940 || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
2941 )
2942 /* and not an undefined symbol */
2943 && stab[j].st_shndx != SHN_UNDEF
2944 /* and not in a "special section" */
2945 && stab[j].st_shndx < SHN_LORESERVE
2946 &&
2947 /* and it's a not a section or string table or anything silly */
2948 ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
2949 ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
2950 ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
2951 )
2952 ) {
2953 /* Section 0 is the undefined section, hence > and not >=. */
2954 ASSERT(secno > 0 && secno < ehdr->e_shnum);
2955 /*
2956 if (shdr[secno].sh_type == SHT_NOBITS) {
2957 debugBelch(" BSS symbol, size %d off %d name %s\n",
2958 stab[j].st_size, stab[j].st_value, nm);
2959 }
2960 */
2961 ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
2962 if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
2963 isLocal = TRUE;
2964 } else {
2965 #ifdef ELF_FUNCTION_DESC
2966 /* dlsym() and the initialisation table both give us function
2967 * descriptors, so to be consistent we store function descriptors
2968 * in the symbol table */
2969 if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
2970 ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
2971 #endif
2972 IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
2973 ad, oc->fileName, nm ));
2974 isLocal = FALSE;
2975 }
2976 }
2977
2978 /* And the decision is ... */
2979
2980 if (ad != NULL) {
2981 ASSERT(nm != NULL);
2982 oc->symbols[j] = nm;
2983 /* Acquire! */
2984 if (isLocal) {
2985 /* Ignore entirely. */
2986 } else {
2987 ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
2988 }
2989 } else {
2990 /* Skip. */
2991 IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
2992 strtab + stab[j].st_name ));
2993 /*
2994 debugBelch(
2995 "skipping bind = %d, type = %d, shndx = %d `%s'\n",
2996 (int)ELF_ST_BIND(stab[j].st_info),
2997 (int)ELF_ST_TYPE(stab[j].st_info),
2998 (int)stab[j].st_shndx,
2999 strtab + stab[j].st_name
3000 );
3001 */
3002 oc->symbols[j] = NULL;
3003 }
3004
3005 }
3006 }
3007
3008 return 1;
3009 }
3010
3011 /* Do ELF relocations which lack an explicit addend. All x86-linux
3012 relocations appear to be of this form. */
3013 static int
3014 do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
3015 Elf_Shdr* shdr, int shnum,
3016 Elf_Sym* stab, char* strtab )
3017 {
3018 int j;
3019 char *symbol;
3020 Elf_Word* targ;
3021 Elf_Rel* rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
3022 int nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
3023 int target_shndx = shdr[shnum].sh_info;
3024 int symtab_shndx = shdr[shnum].sh_link;
3025
3026 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3027 targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
3028 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3029 target_shndx, symtab_shndx ));
3030
3031 /* Skip sections that we're not interested in. */
3032 {
3033 int is_bss;
3034 SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
3035 if (kind == SECTIONKIND_OTHER) {
3036 IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
3037 return 1;
3038 }
3039 }
3040
3041 for (j = 0; j < nent; j++) {
3042 Elf_Addr offset = rtab[j].r_offset;
3043 Elf_Addr info = rtab[j].r_info;
3044
3045 Elf_Addr P = ((Elf_Addr)targ) + offset;
3046 Elf_Word* pP = (Elf_Word*)P;
3047 Elf_Addr A = *pP;
3048 Elf_Addr S;
3049 void* S_tmp;
3050 Elf_Addr value;
3051
3052 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
3053 j, (void*)offset, (void*)info ));
3054 if (!info) {
3055 IF_DEBUG(linker,debugBelch( " ZERO" ));
3056 S = 0;
3057 } else {
3058 Elf_Sym sym = stab[ELF_R_SYM(info)];
3059 /* First see if it is a local symbol. */
3060 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3061 /* Yes, so we can get the address directly from the ELF symbol
3062 table. */
3063 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3064 S = (Elf_Addr)
3065 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3066 + stab[ELF_R_SYM(info)].st_value);
3067
3068 } else {
3069 /* No, so look up the name in our global table. */
3070 symbol = strtab + sym.st_name;
3071 S_tmp = lookupSymbol( symbol );
3072 S = (Elf_Addr)S_tmp;
3073 }
3074 if (!S) {
3075 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3076 return 0;
3077 }
3078 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
3079 }
3080
3081 IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p\n",
3082 (void*)P, (void*)S, (void*)A ));
3083 checkProddableBlock ( oc, pP );
3084
3085 value = S + A;
3086
3087 switch (ELF_R_TYPE(info)) {
3088 # ifdef i386_HOST_ARCH
3089 case R_386_32: *pP = value; break;
3090 case R_386_PC32: *pP = value - P; break;
3091 # endif
3092 default:
3093 errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
3094 oc->fileName, ELF_R_TYPE(info));
3095 return 0;
3096 }
3097
3098 }
3099 return 1;
3100 }
3101
3102 /* Do ELF relocations for which explicit addends are supplied.
3103 sparc-solaris relocations appear to be of this form. */
3104 static int
3105 do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
3106 Elf_Shdr* shdr, int shnum,
3107 Elf_Sym* stab, char* strtab )
3108 {
3109 int j;
3110 char *symbol;
3111 Elf_Addr targ;
3112 Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
3113 int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
3114 int target_shndx = shdr[shnum].sh_info;
3115 int symtab_shndx = shdr[shnum].sh_link;
3116
3117 stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
3118 targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
3119 IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
3120 target_shndx, symtab_shndx ));
3121
3122 for (j = 0; j < nent; j++) {
3123 #if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
3124 /* This #ifdef only serves to avoid unused-var warnings. */
3125 Elf_Addr offset = rtab[j].r_offset;
3126 Elf_Addr P = targ + offset;
3127 #endif
3128 Elf_Addr info = rtab[j].r_info;
3129 Elf_Addr A = rtab[j].r_addend;
3130 Elf_Addr S;
3131 void* S_tmp;
3132 Elf_Addr value;
3133 # if defined(sparc_HOST_ARCH)
3134 Elf_Word* pP = (Elf_Word*)P;
3135 Elf_Word w1, w2;
3136 # elif defined(ia64_HOST_ARCH)
3137 Elf64_Xword *pP = (Elf64_Xword *)P;
3138 Elf_Addr addr;
3139 # elif defined(powerpc_HOST_ARCH)
3140 Elf_Sword delta;
3141 # endif
3142
3143 IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
3144 j, (void*)offset, (void*)info,
3145 (void*)A ));
3146 if (!info) {
3147 IF_DEBUG(linker,debugBelch( " ZERO" ));
3148 S = 0;
3149 } else {
3150 Elf_Sym sym = stab[ELF_R_SYM(info)];
3151 /* First see if it is a local symbol. */
3152 if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
3153 /* Yes, so we can get the address directly from the ELF symbol
3154 table. */
3155 symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
3156 S = (Elf_Addr)
3157 (ehdrC + shdr[ sym.st_shndx ].sh_offset
3158 + stab[ELF_R_SYM(info)].st_value);
3159 #ifdef ELF_FUNCTION_DESC
3160 /* Make a function descriptor for this function */
3161 if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
3162 S = allocateFunctionDesc(S + A);
3163 A = 0;
3164 }
3165 #endif
3166 } else {
3167 /* No, so look up the name in our global table. */
3168 symbol = strtab + sym.st_name;
3169 S_tmp = lookupSymbol( symbol );
3170 S = (Elf_Addr)S_tmp;
3171
3172 #ifdef ELF_FUNCTION_DESC
3173 /* If a function, already a function descriptor - we would
3174 have to copy it to add an offset. */
3175 if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
3176 errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
3177 #endif
3178 }
3179 if (!S) {
3180 errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
3181 return 0;
3182 }
3183 IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
3184 }
3185
3186 IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
3187 (void*)P, (void*)S, (void*)A ));
3188 /* checkProddableBlock ( oc, (void*)P ); */
3189
3190 value = S + A;
3191
3192 switch (ELF_R_TYPE(info)) {
3193 # if defined(sparc_HOST_ARCH)
3194 case R_SPARC_WDISP30:
3195 w1 = *pP & 0xC0000000;
3196 w2 = (Elf_Word)((value - P) >> 2);
3197 ASSERT((w2 & 0xC0000000) == 0);
3198 w1 |= w2;
3199 *pP = w1;
3200 break;
3201 case R_SPARC_HI22:
3202 w1 = *pP & 0xFFC00000;
3203 w2 = (Elf_Word)(value >> 10);
3204 ASSERT((w2 & 0xFFC00000) == 0);
3205 w1 |= w2;
3206 *pP = w1;
3207 break;
3208 case R_SPARC_LO10:
3209 w1 = *pP & ~0x3FF;
3210 w2 = (Elf_Word)(value & 0x3FF);
3211 ASSERT((w2 & ~0x3FF) == 0);
3212 w1 |= w2;
3213 *pP = w1;
3214 break;
3215 /* According to the Sun documentation:
3216 R_SPARC_UA32
3217 This relocation type resembles R_SPARC_32, except it refers to an
3218 unaligned word. That is, the word to be relocated must be treated
3219 as four separate bytes with arbitrary alignment, not as a word
3220 aligned according to the architecture requirements.
3221
3222 (JRS: which means that freeloading on the R_SPARC_32 case
3223 is probably wrong, but hey ...)
3224 */
3225 case R_SPARC_UA32:
3226 case R_SPARC_32:
3227 w2 = (Elf_Word)value;
3228 *pP = w2;
3229 break;
3230 # elif defined(ia64_HOST_ARCH)
3231 case R_IA64_DIR64LSB:
3232 case R_IA64_FPTR64LSB:
3233 *pP = value;
3234 break;
3235 case R_IA64_PCREL64LSB:
3236 *pP = value - P;
3237 break;
3238 case R_IA64_SEGREL64LSB:
3239 addr = findElfSegment(ehdrC, value);
3240 *pP = value - addr;
3241 break;
3242 case R_IA64_GPREL22:
3243 ia64_reloc_gprel22(P, value);
3244 break;
3245 case R_IA64_LTOFF22:
3246 case R_IA64_LTOFF22X:
3247 case R_IA64_LTOFF_FPTR22:
3248 addr = allocateGOTEntry(value);
3249 ia64_reloc_gprel22(P, addr);
3250 break;
3251 case R_IA64_PCREL21B:
3252 ia64_reloc_pcrel21(P, S, oc);
3253 break;
3254 case R_IA64_LDXMOV:
3255 /* This goes with R_IA64_LTOFF22X and points to the load to
3256 * convert into a move. We don't implement relaxation. */
3257 break;
3258 # elif defined(powerpc_HOST_ARCH)
3259 case R_PPC_ADDR16_LO:
3260 *(Elf32_Half*) P = value;
3261 break;
3262
3263 case R_PPC_ADDR16_HI:
3264 *(Elf32_Half*) P = value >> 16;
3265 break;
3266
3267 case R_PPC_ADDR16_HA:
3268 *(Elf32_Half*) P = (value + 0x8000) >> 16;
3269 break;
3270
3271 case R_PPC_ADDR32:
3272 *(Elf32_Word *) P = value;
3273 break;
3274
3275 case R_PPC_REL32:
3276 *(Elf32_Word *) P = value - P;
3277 break;
3278
3279 case R_PPC_REL24:
3280 delta = value - P;
3281
3282 if( delta << 6 >> 6 != delta )
3283 {
3284 value = makeJumpIsland( oc, ELF_R_SYM(info), value );
3285 delta = value - P;
3286
3287 if( value == 0 || delta << 6 >> 6 != delta )
3288 {
3289 barf( "Unable to make ppcJumpIsland for #%d",
3290 ELF_R_SYM(info) );
3291 return 0;
3292 }
3293 }
3294
3295 *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
3296 | (delta & 0x3fffffc);
3297 break;
3298 # endif
3299
3300 #if x86_64_HOST_ARCH
3301 case R_X86_64_64:
3302 *(Elf64_Xword *)P = value;
3303 break;
3304
3305 case R_X86_64_PC32:
3306 {
3307 StgInt64 off = value - P;
3308 if (off >= 0x7fffffffL || off < -0x80000000L) {
3309 barf("R_X86_64_PC32 relocation out of range: %s = %p",
3310 symbol, off);
3311 }
3312 *(Elf64_Word *)P = (Elf64_Word)off;
3313 break;
3314 }
3315
3316 case R_X86_64_32:
3317 if (value >= 0x7fffffffL) {
3318 barf("R_X86_64_32 relocation out of range: %s = %p\n",
3319 symbol, value);
3320 }
3321 *(Elf64_Word *)P = (Elf64_Word)value;
3322 break;
3323
3324 case R_X86_64_32S:
3325 if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
3326 barf("R_X86_64_32S relocation out of range: %s = %p\n",
3327 symbol, value);
3328 }
3329 *(Elf64_Sword *)P = (Elf64_Sword)value;
3330 break;
3331 #endif
3332
3333 default:
3334 errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
3335 oc->fileName, ELF_R_TYPE(info));
3336 return 0;
3337 }
3338
3339 }
3340 return 1;
3341 }
3342
3343 static int
3344 ocResolve_ELF ( ObjectCode* oc )
3345 {
3346 char *strtab;
3347 int shnum, ok;
3348 Elf_Sym* stab = NULL;
3349 char* ehdrC = (char*)(oc->image);
3350 Elf_Ehdr* ehdr = (Elf_Ehdr*) ehdrC;
3351 Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
3352
3353 /* first find "the" symbol table */
3354 stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
3355
3356 /* also go find the string table */
3357 strtab = findElfSection ( ehdrC, SHT_STRTAB );
3358
3359 if (stab == NULL || strtab == NULL) {
3360 errorBelch("%s: can't find string or symbol table", oc->fileName);
3361 return 0;
3362 }
3363
3364 /* Process the relocation sections. */
3365 for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
3366 if (shdr[shnum].sh_type == SHT_REL) {
3367 ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
3368 shnum, stab, strtab );
3369 if (!ok) return ok;
3370 }
3371 else
3372 if (shdr[shnum].sh_type == SHT_RELA) {
3373 ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
3374 shnum, stab, strtab );
3375 if (!ok) return ok;
3376 }
3377 }
3378
3379 /* Free the local symbol table; we won't need it again. */
3380 freeHashTable(oc->lochash, NULL);
3381 oc->lochash = NULL;
3382
3383 #if defined(powerpc_HOST_ARCH)
3384 ocFlushInstructionCache( oc );
3385 #endif
3386
3387 return 1;
3388 }
3389
3390 /*
3391 * IA64 specifics
3392 * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
3393 * at the front. The following utility functions pack and unpack instructions, and
3394 * take care of the most common relocations.
3395 */
3396
3397 #ifdef ia64_HOST_ARCH
3398
3399 static Elf64_Xword
3400 ia64_extract_instruction(Elf64_Xword *target)
3401 {
3402 Elf64_Xword w1, w2;
3403 int slot = (Elf_Addr)target & 3;
3404 target = (Elf_Addr)target & ~3;
3405
3406 w1 = *target;
3407 w2 = *(target+1);
3408
3409 switch (slot)
3410 {
3411 case 0:
3412 return ((w1 >> 5) & 0x1ffffffffff);
3413 case 1:
3414 return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
3415 case 2:
3416 return (w2 >> 23);
3417 default:
3418 barf("ia64_extract_instruction: invalid slot %p", target);
3419 }
3420 }
3421
3422 static void
3423 ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
3424 {
3425 int slot = (Elf_Addr)target & 3;
3426 target = (Elf_Addr)target & ~3;
3427
3428 switch (slot)
3429 {
3430 case 0:
3431 *target |= value << 5;
3432 break;
3433 case 1:
3434 *target |= value << 46;
3435 *(target+1) |= value >> 18;
3436 break;
3437 case 2:
3438 *(target+1) |= value << 23;
3439 break;
3440 }
3441 }
3442
3443 static void
3444 ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
3445 {
3446 Elf64_Xword instruction;
3447 Elf64_Sxword rel_value;
3448
3449 rel_value = value - gp_val;
3450 if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
3451 barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
3452
3453 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3454 instruction |= (((rel_value >> 0) & 0x07f) << 13) /* imm7b */
3455 | (((rel_value >> 7) & 0x1ff) << 27) /* imm9d */
3456 | (((rel_value >> 16) & 0x01f) << 22) /* imm5c */
3457 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3458 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3459 }
3460
3461 static void
3462 ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
3463 {
3464 Elf64_Xword instruction;
3465 Elf64_Sxword rel_value;
3466 Elf_Addr entry;
3467
3468 entry = allocatePLTEntry(value, oc);
3469
3470 rel_value = (entry >> 4) - (target >> 4);
3471 if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
3472 barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
3473
3474 instruction = ia64_extract_instruction((Elf64_Xword *)target);
3475 instruction |= ((rel_value & 0xfffff) << 13) /* imm20b */
3476 | ((Elf64_Xword)(rel_value < 0) << 36); /* s */
3477 ia64_deposit_instruction((Elf64_Xword *)target, instruction);
3478 }
3479
3480 #endif /* ia64 */
3481
3482 /*
3483 * PowerPC ELF specifics
3484 */
3485
3486 #ifdef powerpc_HOST_ARCH
3487
3488 static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
3489 {
3490 Elf_Ehdr *ehdr;
3491 Elf_Shdr* shdr;
3492 int i;
3493
3494 ehdr = (Elf_Ehdr *) oc->image;
3495 shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
3496
3497 for( i = 0; i < ehdr->e_shnum; i++ )
3498 if( shdr[i].sh_type == SHT_SYMTAB )
3499 break;
3500
3501 if( i == ehdr->e_shnum )
3502 {
3503 errorBelch( "This ELF file contains no symtab" );
3504 return 0;
3505 }
3506
3507 if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
3508 {
3509 errorBelch( "The entry size (%d) of the symtab isn't %d\n",
3510 shdr[i].sh_entsize, sizeof( Elf_Sym ) );
3511
3512 return 0;
3513 }
3514
3515 return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
3516 }
3517
3518 #endif /* powerpc */
3519
3520 #endif /* ELF */
3521
3522 /* --------------------------------------------------------------------------
3523 * Mach-O specifics
3524 * ------------------------------------------------------------------------*/
3525
3526 #if defined(OBJFORMAT_MACHO)
3527
3528 /*
3529 Support for MachO linking on Darwin/MacOS X
3530 by Wolfgang Thaller (wolfgang.thaller@gmx.net)
3531
3532 I hereby formally apologize for the hackish nature of this code.
3533 Things that need to be done:
3534 *) implement ocVerifyImage_MachO
3535 *) add still more sanity checks.
3536 */
3537
3538 #ifdef powerpc_HOST_ARCH
3539 static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
3540 {
3541 struct mach_header *header = (struct mach_header *) oc->image;
3542 struct load_command *lc = (struct load_command *) (header + 1);
3543 unsigned i;
3544
3545 for( i = 0; i < header->ncmds; i++ )
3546 {
3547 if( lc->cmd == LC_SYMTAB )
3548 {
3549 // Find out the first and last undefined external
3550 // symbol, so we don't have to allocate too many
3551 // jump islands.
3552 struct symtab_command *symLC = (struct symtab_command *) lc;
3553 unsigned min = symLC->nsyms, max = 0;
3554 struct nlist *nlist =
3555 symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
3556 : NULL;
3557 for(i=0;i<symLC->nsyms;i++)
3558 {
3559 if(nlist[i].n_type & N_STAB)
3560 ;
3561 else if(nlist[i].n_type & N_EXT)
3562 {
3563 if((nlist[i].n_type & N_TYPE) == N_UNDF
3564 && (nlist[i].n_value == 0))
3565 {
3566 if(i < min)
3567 min = i;
3568 if(i > max)
3569 max = i;
3570 }
3571 }
3572 }
3573 if(max >= min)
3574 return ocAllocateJumpIslands(oc, max - min + 1, min);
3575
3576 break;
3577 }
3578
3579 lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
3580 }
3581 return ocAllocateJumpIslands(oc,0,0);
3582 }
3583 #endif
3584
3585 static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
3586 {
3587 // FIXME: do some verifying here
3588 return 1;
3589 }
3590
3591 static int resolveImports(
3592 ObjectCode* oc,
3593 char *image,
3594 struct symtab_command *symLC,
3595 struct section *sect, // ptr to lazy or non-lazy symbol pointer section
3596 unsigned long *indirectSyms,
3597 struct nlist *nlist)
3598 {
3599 unsigned i;
3600
3601 for(i=0;i*4<sect->size;i++)
3602 {
3603 // according to otool, reserved1 contains the first index into the indirect symbol table
3604 struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
3605 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3606 void *addr = NULL;
3607
3608 if((symbol->n_type & N_TYPE) == N_UNDF
3609 && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
3610 addr = (void*) (symbol->n_value);
3611 else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
3612 ;
3613 else
3614 addr = lookupSymbol(nm);
3615 if(!addr)
3616 {
3617 errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
3618 return 0;
3619 }
3620 ASSERT(addr);
3621 checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
3622 ((void**)(image + sect->offset))[i] = addr;
3623 }
3624
3625 return 1;
3626 }
3627
3628 static unsigned long relocateAddress(
3629 ObjectCode* oc,
3630 int nSections,
3631 struct section* sections,
3632 unsigned long address)
3633 {
3634 int i;
3635 for(i = 0; i < nSections; i++)
3636 {
3637 if(sections[i].addr <= address
3638 && address < sections[i].addr + sections[i].size)
3639 {
3640 return (unsigned long)oc->image
3641 + sections[i].offset + address - sections[i].addr;
3642 }
3643 }
3644 barf("Invalid Mach-O file:"
3645 "Address out of bounds while relocating object file");
3646 return 0;
3647 }
3648
3649 static int relocateSection(
3650 ObjectCode* oc,
3651 char *image,
3652 struct symtab_command *symLC, struct nlist *nlist,
3653 int nSections, struct section* sections, struct section *sect)
3654 {
3655 struct relocation_info *relocs;
3656 int i,n;
3657
3658 if(!strcmp(sect->sectname,"__la_symbol_ptr"))
3659 return 1;
3660 else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
3661 return 1;
3662 else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
3663 return 1;
3664 else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
3665 return 1;
3666
3667 n = sect->nreloc;
3668 relocs = (struct relocation_info*) (image + sect->reloff);
3669
3670 for(i=0;i<n;i++)
3671 {
3672 if(relocs[i].r_address & R_SCATTERED)
3673 {
3674 struct scattered_relocation_info *scat =
3675 (struct scattered_relocation_info*) &relocs[i];
3676
3677 if(!scat->r_pcrel)
3678 {
3679 if(scat->r_length == 2)
3680 {
3681 unsigned long word = 0;
3682 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
3683 checkProddableBlock(oc,wordPtr);
3684
3685 // Note on relocation types:
3686 // i386 uses the GENERIC_RELOC_* types,
3687 // while ppc uses special PPC_RELOC_* types.
3688 // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
3689 // in both cases, all others are different.
3690 // Therefore, we use GENERIC_RELOC_VANILLA
3691 // and GENERIC_RELOC_PAIR instead of the PPC variants,
3692 // and use #ifdefs for the other types.
3693
3694 // Step 1: Figure out what the relocated value should be
3695 if(scat->r_type == GENERIC_RELOC_VANILLA)
3696 {
3697 word = *wordPtr + (unsigned long) relocateAddress(
3698 oc,
3699 nSections,
3700 sections,
3701 scat->r_value)
3702 - scat->r_value;
3703 }
3704 #ifdef powerpc_HOST_ARCH
3705 else if(scat->r_type == PPC_RELOC_SECTDIFF
3706 || scat->r_type == PPC_RELOC_LO16_SECTDIFF
3707 || scat->r_type == PPC_RELOC_HI16_SECTDIFF
3708 || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
3709 #else
3710 else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
3711 #endif
3712 {
3713 struct scattered_relocation_info *pair =
3714 (struct scattered_relocation_info*) &relocs[i+1];
3715
3716 if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
3717 barf("Invalid Mach-O file: "
3718 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
3719
3720 word = (unsigned long)
3721 (relocateAddress(oc, nSections, sections, scat->r_value)
3722 - relocateAddress(oc, nSections, sections, pair->r_value));
3723 i++;
3724 }
3725 #ifdef powerpc_HOST_ARCH
3726 else if(scat->r_type == PPC_RELOC_HI16
3727 || scat->r_type == PPC_RELOC_LO16
3728 || scat->r_type == PPC_RELOC_HA16
3729 || scat->r_type == PPC_RELOC_LO14)
3730 { // these are generated by label+offset things
3731 struct relocation_info *pair = &relocs[i+1];
3732 if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
3733 barf("Invalid Mach-O file: "
3734 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
3735
3736 if(scat->r_type == PPC_RELOC_LO16)
3737 {
3738 word = ((unsigned short*) wordPtr)[1];
3739 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3740 }
3741 else if(scat->r_type == PPC_RELOC_LO14)
3742 {
3743 barf("Unsupported Relocation: PPC_RELOC_LO14");
3744 word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
3745 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3746 }
3747 else if(scat->r_type == PPC_RELOC_HI16)
3748 {
3749 word = ((unsigned short*) wordPtr)[1] << 16;
3750 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3751 }
3752 else if(scat->r_type == PPC_RELOC_HA16)
3753 {
3754 word = ((unsigned short*) wordPtr)[1] << 16;
3755 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3756 }
3757
3758
3759 word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
3760 - scat->r_value;
3761
3762 i++;
3763 }
3764 #endif
3765 else
3766 continue; // ignore the others
3767
3768 #ifdef powerpc_HOST_ARCH
3769 if(scat->r_type == GENERIC_RELOC_VANILLA
3770 || scat->r_type == PPC_RELOC_SECTDIFF)
3771 #else
3772 if(scat->r_type == GENERIC_RELOC_VANILLA
3773 || scat->r_type == GENERIC_RELOC_SECTDIFF)
3774 #endif
3775 {
3776 *wordPtr = word;
3777 }
3778 #ifdef powerpc_HOST_ARCH
3779 else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
3780 {
3781 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3782 }
3783 else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
3784 {
3785 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3786 }
3787 else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
3788 {
3789 ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
3790 + ((word & (1<<15)) ? 1 : 0);
3791 }
3792 #endif
3793 }
3794 }
3795
3796 continue; // FIXME: I hope it's OK to ignore all the others.
3797 }
3798 else
3799 {
3800 struct relocation_info *reloc = &relocs[i];
3801 if(reloc->r_pcrel && !reloc->r_extern)
3802 continue;
3803
3804 if(reloc->r_length == 2)
3805 {
3806 unsigned long word = 0;
3807 #ifdef powerpc_HOST_ARCH
3808 unsigned long jumpIsland = 0;
3809 long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
3810 // to avoid warning and to catch
3811 // bugs.
3812 #endif
3813
3814 unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
3815 checkProddableBlock(oc,wordPtr);
3816
3817 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3818 {
3819 word = *wordPtr;
3820 }
3821 #ifdef powerpc_HOST_ARCH
3822 else if(reloc->r_type == PPC_RELOC_LO16)
3823 {
3824 word = ((unsigned short*) wordPtr)[1];
3825 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
3826 }
3827 else if(reloc->r_type == PPC_RELOC_HI16)
3828 {
3829 word = ((unsigned short*) wordPtr)[1] << 16;
3830 word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
3831 }
3832 else if(reloc->r_type == PPC_RELOC_HA16)
3833 {
3834 word = ((unsigned short*) wordPtr)[1] << 16;
3835 word += ((short)relocs[i+1].r_address & (short)0xFFFF);
3836 }
3837 else if(reloc->r_type == PPC_RELOC_BR24)
3838 {
3839 word = *wordPtr;
3840 word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
3841 }
3842 #endif
3843
3844 if(!reloc->r_extern)
3845 {
3846 long delta =
3847 sections[reloc->r_symbolnum-1].offset
3848 - sections[reloc->r_symbolnum-1].addr
3849 + ((long) image);
3850
3851 word += delta;
3852 }
3853 else
3854 {
3855 struct nlist *symbol = &nlist[reloc->r_symbolnum];
3856 char *nm = image + symLC->stroff + symbol->n_un.n_strx;
3857 void *symbolAddress = lookupSymbol(nm);
3858 if(!symbolAddress)
3859 {
3860 errorBelch("\nunknown symbol `%s'", nm);
3861 return 0;
3862 }
3863
3864 if(reloc->r_pcrel)
3865 {
3866 #ifdef powerpc_HOST_ARCH
3867 // In the .o file, this should be a relative jump to NULL
3868 // and we'll change it to a relative jump to the symbol
3869 ASSERT(-word == reloc->r_address);
3870 jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
3871 if(jumpIsland != 0)
3872 {
3873 offsetToJumpIsland = word + jumpIsland
3874 - (((long)image) + sect->offset - sect->addr);
3875 }
3876 #endif
3877 word += (unsigned long) symbolAddress
3878 - (((long)image) + sect->offset - sect->addr);
3879 }
3880 else
3881 {
3882 word += (unsigned long) symbolAddress;
3883 }
3884 }
3885
3886 if(reloc->r_type == GENERIC_RELOC_VANILLA)
3887 {
3888 *wordPtr = word;
3889 continue;
3890 }
3891 #ifdef powerpc_HOST_ARCH
3892 else if(reloc->r_type == PPC_RELOC_LO16)
3893 {
3894 ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
3895 i++; continue;
3896 }
3897 else if(reloc->r_type == PPC_RELOC_HI16)
3898 {
3899 ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
3900 i++; continue;
3901 }