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