[project @ 2001-06-25 09:44:10 by rrt]
[ghc-hetmet.git] / ghc / rts / Linker.c
1 /* -----------------------------------------------------------------------------
2  * $Id: Linker.c,v 1.45 2001/06/25 09:44:10 rrt Exp $
3  *
4  * (c) The GHC Team, 2000
5  *
6  * RTS Object Linker
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #include "Rts.h"
11 #include "RtsFlags.h"
12 #include "HsFFI.h"
13 #include "Hash.h"
14 #include "Linker.h"
15 #include "LinkerInternals.h"
16 #include "RtsUtils.h"
17 #include "StoragePriv.h"
18
19 #ifdef HAVE_SYS_TYPES_H
20 #include <sys/types.h>
21 #endif
22
23 #ifdef HAVE_SYS_STAT_H
24 #include <sys/stat.h>
25 #endif
26
27 #ifdef HAVE_DLFCN_H
28 #include <dlfcn.h>
29 #endif
30
31 #if defined(linux_TARGET_OS) || defined(solaris2_TARGET_OS) || defined(freebsd_TARGET_OS)
32 #  define OBJFORMAT_ELF
33 #elif defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
34 #  define OBJFORMAT_PEi386
35 #  include <windows.h>
36 #endif
37
38 /* Hash table mapping symbol names to Symbol */
39 /*Str*/HashTable *symhash;
40
41 #if defined(OBJFORMAT_ELF)
42 static int ocVerifyImage_ELF    ( ObjectCode* oc );
43 static int ocGetNames_ELF       ( ObjectCode* oc );
44 static int ocResolve_ELF        ( ObjectCode* oc );
45 #elif defined(OBJFORMAT_PEi386)
46 static int ocVerifyImage_PEi386 ( ObjectCode* oc );
47 static int ocGetNames_PEi386    ( ObjectCode* oc );
48 static int ocResolve_PEi386     ( ObjectCode* oc );
49 #endif
50
51 /* -----------------------------------------------------------------------------
52  * Built-in symbols from the RTS
53  */
54
55 typedef struct _RtsSymbolVal {
56     char   *lbl;
57     void   *addr;
58 } RtsSymbolVal;
59
60
61 #if !defined(PAR)
62 #define Maybe_ForeignObj        SymX(mkForeignObjzh_fast)
63
64 #define Maybe_Stable_Names      SymX(mkWeakzh_fast)                     \
65                                 SymX(makeStableNamezh_fast)             \
66                                 SymX(finalizzeWeakzh_fast)
67 #else
68 /* These are not available in GUM!!! -- HWL */
69 #define Maybe_ForeignObj
70 #define Maybe_Stable_Names
71 #endif
72
73 #if !defined (mingw32_TARGET_OS)
74
75 #define RTS_POSIX_ONLY_SYMBOLS                  \
76       SymX(stg_sig_install)                     \
77       Sym(nocldstop)
78 #define RTS_MINGW_ONLY_SYMBOLS /**/
79
80 #else
81
82 #define RTS_POSIX_ONLY_SYMBOLS
83 #define RTS_MINGW_ONLY_SYMBOLS                  \
84       SymX(abort)                               \
85       Sym(_alloca)                              \
86       Sym(isxdigit)                             \
87       Sym(isupper)                              \
88       Sym(ispunct)                              \
89       Sym(islower)                              \
90       Sym(isspace)                              \
91       Sym(isprint)                              \
92       Sym(isdigit)                              \
93       Sym(iscntrl)                              \
94       Sym(isalpha)                              \
95       Sym(isalnum)                              \
96       SymX(memset)                              \
97       SymX(strncpy)                             \
98       SymX(strcpy)                              \
99       SymX(strcmp)                              \
100       SymX(strerror)                            \
101       Sym(mktime)                               \
102       Sym(gmtime)                               \
103       Sym(strftime)                             \
104       Sym(localtime)                            \
105       SymX(getenv)                              \
106       SymX(rename)                              \
107       Sym(opendir)                              \
108       Sym(readdir)                              \
109       Sym(closedir)                             \
110       Sym(PrelHandle_stderr_closure)            \
111       Sym(Main_main_closure)                    \
112       Sym(__init_Main)                          \
113       SymX(pow)                                 \
114       SymX(tanh)                                \
115       SymX(cosh)                                \
116       SymX(sinh)                                \
117       SymX(atan)                                \
118       SymX(acos)                                \
119       SymX(asin)                                \
120       SymX(tan)                                 \
121       SymX(cos)                                 \
122       SymX(sin)                                 \
123       SymX(exp)                                 \
124       SymX(log)                                 \
125       SymX(sqrt)                                \
126       SymX(Sleep)                               \
127       SymX(system)                              \
128       SymX(memchr)                              \
129       SymX(memcpy)                              \
130       SymX(memmove)                             \
131       SymX(fprintf)                             \
132       Sym(_imp___iob)                           \
133       Sym(_imp___tzname)                        \
134       Sym(_imp___timezone)                      \
135       Sym(__udivdi3)                            \
136       SymX(GetProcessTimes)                     \
137       SymX(GetCurrentProcess)                   \
138       SymX(read)                                \
139       SymX(write)                               \
140       SymX(open)                                \
141       SymX(close)                               \
142       SymX(send)                                \
143       SymX(recv)                                \
144       SymX(malloc)                              \
145       SymX(free)                                \
146       SymX(realloc)                             \
147       SymX(fstat)                               \
148       SymX(stat)                                \
149       Sym(ftime)                                \
150       SymX(isatty)                              \
151       SymX(lseek)                               \
152       SymX(access)                              \
153       Sym(setmode)                              \
154       SymX(chmod)                               \
155       SymX(chdir)                               \
156       SymX(getcwd)                              \
157       SymX(unlink)                              \
158       SymX(rmdir)                               \
159       SymX(mkdir)                               \
160       SymX(CreateProcessA)                      \
161       SymX(WaitForSingleObject)                 \
162       SymX(GetExitCodeProcess)                  \
163       SymX(CloseHandle)                         \
164       SymX(_errno)                              \
165       SymX(closesocket)
166 #endif
167
168
169 #define RTS_SYMBOLS                             \
170       SymX(MainRegTable)                        \
171       Sym(stg_gc_enter_1)                       \
172       Sym(stg_gc_noregs)                        \
173       Sym(stg_gc_seq_1)                         \
174       Sym(stg_gc_d1)                            \
175       Sym(stg_gc_f1)                            \
176       Sym(stg_gc_ut_1_0)                        \
177       Sym(stg_gc_ut_0_1)                        \
178       Sym(stg_gc_unpt_r1)                       \
179       Sym(stg_gc_unbx_r1)                       \
180       Sym(stg_chk_0)                            \
181       Sym(stg_chk_1)                            \
182       Sym(stg_gen_chk)                          \
183       SymX(stg_exit)                            \
184       SymX(stg_update_PAP)                      \
185       SymX(stg_ap_1_upd_info)                   \
186       SymX(stg_ap_2_upd_info)                   \
187       SymX(stg_ap_3_upd_info)                   \
188       SymX(stg_ap_4_upd_info)                   \
189       SymX(stg_ap_5_upd_info)                   \
190       SymX(stg_ap_6_upd_info)                   \
191       SymX(stg_ap_7_upd_info)                   \
192       SymX(stg_ap_8_upd_info)                   \
193       SymX(stg_sel_0_upd_info)                  \
194       SymX(stg_sel_1_upd_info)                  \
195       SymX(stg_sel_2_upd_info)                  \
196       SymX(stg_sel_3_upd_info)                  \
197       SymX(stg_sel_4_upd_info)                  \
198       SymX(stg_sel_5_upd_info)                  \
199       SymX(stg_sel_6_upd_info)                  \
200       SymX(stg_sel_7_upd_info)                  \
201       SymX(stg_sel_8_upd_info)                  \
202       SymX(stg_sel_9_upd_info)                  \
203       SymX(stg_sel_10_upd_info)                 \
204       SymX(stg_sel_11_upd_info)                 \
205       SymX(stg_sel_12_upd_info)                 \
206       SymX(stg_sel_13_upd_info)                 \
207       SymX(stg_sel_14_upd_info)                 \
208       SymX(stg_sel_15_upd_info)                 \
209       SymX(stg_upd_frame_info)                  \
210       SymX(stg_seq_frame_info)                  \
211       SymX(stg_CAF_BLACKHOLE_info)              \
212       SymX(stg_IND_STATIC_info)                 \
213       SymX(stg_EMPTY_MVAR_info)                 \
214       SymX(stg_MUT_ARR_PTRS_FROZEN_info)        \
215       SymX(stg_WEAK_info)                       \
216       SymX(stg_CHARLIKE_closure)                \
217       SymX(stg_INTLIKE_closure)                 \
218       SymX(newCAF)                              \
219       SymX(newBCOzh_fast)                       \
220       SymX(mkApUpd0zh_fast)                     \
221       SymX(putMVarzh_fast)                      \
222       SymX(newMVarzh_fast)                      \
223       SymX(takeMVarzh_fast)                     \
224       SymX(tryTakeMVarzh_fast)                  \
225       SymX(tryPutMVarzh_fast)                   \
226       SymX(catchzh_fast)                        \
227       SymX(raisezh_fast)                        \
228       SymX(forkzh_fast)                         \
229       SymX(delayzh_fast)                        \
230       SymX(yieldzh_fast)                        \
231       SymX(killThreadzh_fast)                   \
232       SymX(waitReadzh_fast)                     \
233       SymX(waitWritezh_fast)                    \
234       SymX(suspendThread)                       \
235       SymX(resumeThread)                        \
236       SymX(stackOverflow)                       \
237       SymX(int2Integerzh_fast)                  \
238       SymX(word2Integerzh_fast)                 \
239       Maybe_ForeignObj                          \
240       SymX(__encodeDouble)                      \
241       SymX(decodeDoublezh_fast)                 \
242       SymX(decodeFloatzh_fast)                  \
243       SymX(gcdIntegerzh_fast)                   \
244       SymX(newArrayzh_fast)                     \
245       SymX(unsafeThawArrayzh_fast)              \
246       SymX(newByteArrayzh_fast)                 \
247       SymX(newMutVarzh_fast)                    \
248       SymX(quotRemIntegerzh_fast)               \
249       SymX(quotIntegerzh_fast)                  \
250       SymX(remIntegerzh_fast)                   \
251       SymX(divExactIntegerzh_fast)              \
252       SymX(divModIntegerzh_fast)                \
253       SymX(timesIntegerzh_fast)                 \
254       SymX(minusIntegerzh_fast)                 \
255       SymX(plusIntegerzh_fast)                  \
256       SymX(andIntegerzh_fast)                   \
257       SymX(orIntegerzh_fast)                    \
258       SymX(xorIntegerzh_fast)                   \
259       SymX(complementIntegerzh_fast)            \
260       Maybe_Stable_Names                        \
261       SymX(blockAsyncExceptionszh_fast)         \
262       SymX(unblockAsyncExceptionszh_fast)       \
263       SymX(isDoubleNaN)                         \
264       SymX(isDoubleInfinite)                    \
265       SymX(isDoubleDenormalized)                \
266       SymX(isDoubleNegativeZero)                \
267       SymX(__encodeFloat)                       \
268       SymX(isFloatNaN)                          \
269       SymX(isFloatInfinite)                     \
270       SymX(isFloatDenormalized)                 \
271       SymX(isFloatNegativeZero)                 \
272       SymX(__int_encodeFloat)                   \
273       SymX(__int_encodeDouble)                  \
274       SymX(__gmpz_cmp_si)                       \
275       SymX(__gmpz_cmp_ui)                       \
276       SymX(__gmpz_cmp)                          \
277       SymX(__gmpn_gcd_1)                        \
278       SymX(__gmpz_get_si)                       \
279       SymX(__gmpz_get_ui)                       \
280       SymX(prog_argv)                           \
281       SymX(prog_argc)                           \
282       SymX(resetNonBlockingFd)                  \
283       SymX(performGC)                           \
284       SymX(getStablePtr)                        \
285       SymX(stable_ptr_table)                    \
286       SymX(shutdownHaskellAndExit)              \
287       Sym(stg_enterStackTop)                    \
288       Sym(stg_yield_to_interpreter)             \
289       Sym(StgReturn)                            \
290       Sym(init_stack)                           \
291       SymX(cmp_thread)                          \
292       Sym(__init_PrelGHC)                       \
293       SymX(freeHaskellFunctionPtr)              \
294       SymX(OnExitHook)                          \
295       SymX(ErrorHdrHook)                        \
296       SymX(NoRunnableThreadsHook)               \
297       SymX(StackOverflowHook)                   \
298       SymX(OutOfHeapHook)                       \
299       SymX(MallocFailHook)                      \
300       SymX(PatErrorHdrHook)                     \
301       SymX(defaultsHook)                        \
302       SymX(PreTraceHook)                        \
303       SymX(PostTraceHook)                       \
304       SymX(createAdjustor)                      \
305       SymX(rts_mkChar)                          \
306       SymX(rts_mkInt)                           \
307       SymX(rts_mkInt8)                          \
308       SymX(rts_mkInt16)                         \
309       SymX(rts_mkInt32)                         \
310       SymX(rts_mkInt64)                         \
311       SymX(rts_mkWord)                          \
312       SymX(rts_mkWord8)                         \
313       SymX(rts_mkWord16)                        \
314       SymX(rts_mkWord32)                        \
315       SymX(rts_mkWord64)                        \
316       SymX(rts_mkPtr)                           \
317       SymX(rts_mkFloat)                         \
318       SymX(rts_mkDouble)                        \
319       SymX(rts_mkStablePtr)                     \
320       SymX(rts_mkBool)                          \
321       SymX(rts_mkString)                        \
322       SymX(rts_apply)                           \
323       SymX(rts_mkAddr)                          \
324       SymX(rts_getChar)                         \
325       SymX(rts_getInt)                          \
326       SymX(rts_getInt32)                        \
327       SymX(rts_getWord)                         \
328       SymX(rts_getWord32)                       \
329       SymX(rts_getPtr)                          \
330       SymX(rts_getFloat)                        \
331       SymX(rts_getDouble)                       \
332       SymX(rts_getStablePtr)                    \
333       SymX(rts_getBool)                         \
334       SymX(rts_getAddr)                         \
335       SymX(rts_eval)                            \
336       SymX(rts_eval_)                           \
337       SymX(rts_evalIO)                          \
338       SymX(rts_evalLazyIO)                      \
339       SymX(rts_checkSchedStatus)
340
341 #ifndef SUPPORT_LONG_LONGS
342 #define RTS_LONG_LONG_SYMS /* nothing */
343 #else
344 #define RTS_LONG_LONG_SYMS                      \
345       SymX(stg_gtWord64)                        \
346       SymX(stg_geWord64)                        \
347       SymX(stg_eqWord64)                        \
348       SymX(stg_neWord64)                        \
349       SymX(stg_ltWord64)                        \
350       SymX(stg_leWord64)                        \
351       SymX(stg_gtInt64)                         \
352       SymX(stg_geInt64)                         \
353       SymX(stg_eqInt64)                         \
354       SymX(stg_neInt64)                         \
355       SymX(stg_ltInt64)                         \
356       SymX(stg_leInt64)                         \
357       SymX(stg_remWord64)                       \
358       SymX(stg_quotWord64)                      \
359       SymX(stg_remInt64)                        \
360       SymX(stg_quotInt64)                       \
361       SymX(stg_negateInt64)                     \
362       SymX(stg_plusInt64)                       \
363       SymX(stg_minusInt64)                      \
364       SymX(stg_timesInt64)                      \
365       SymX(stg_and64)                           \
366       SymX(stg_or64)                            \
367       SymX(stg_xor64)                           \
368       SymX(stg_not64)                           \
369       SymX(stg_shiftL64)                        \
370       SymX(stg_shiftRL64)                       \
371       SymX(stg_iShiftL64)                       \
372       SymX(stg_iShiftRL64)                      \
373       SymX(stg_iShiftRA64)                      \
374       SymX(stg_intToInt64)                      \
375       SymX(stg_int64ToInt)                      \
376       SymX(stg_int64ToWord64)                   \
377       SymX(stg_wordToWord64)                    \
378       SymX(stg_word64ToWord)                    \
379       SymX(stg_word64ToInt64)                   \
380       SymX(int64ToIntegerzh_fast)               \
381       SymX(word64ToIntegerzh_fast)
382 #endif /* SUPPORT_LONG_LONGS */
383
384 /* entirely bogus claims about types of these symbols */
385 #define Sym(vvv)  extern void (vvv);
386 #define SymX(vvv) /**/
387 RTS_SYMBOLS
388 RTS_LONG_LONG_SYMS
389 RTS_POSIX_ONLY_SYMBOLS
390 RTS_MINGW_ONLY_SYMBOLS
391 #undef Sym
392 #undef SymX
393
394 #ifdef LEADING_UNDERSCORE
395 #define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
396 #else
397 #define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
398 #endif
399
400 #define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
401                     (void*)(&(vvv)) },
402 #define SymX(vvv) Sym(vvv)
403
404 static RtsSymbolVal rtsSyms[] = {
405       RTS_SYMBOLS
406       RTS_LONG_LONG_SYMS
407       RTS_POSIX_ONLY_SYMBOLS
408       RTS_MINGW_ONLY_SYMBOLS
409       { 0, 0 } /* sentinel */
410 };
411
412 /* -----------------------------------------------------------------------------
413  * initialize the object linker
414  */
415 #if defined(OBJFORMAT_ELF)
416 static void *dl_prog_handle;
417 #endif
418
419 void
420 initLinker( void )
421 {
422     RtsSymbolVal *sym;
423
424     symhash = allocStrHashTable();
425
426     /* populate the symbol table with stuff from the RTS */
427     for (sym = rtsSyms; sym->lbl != NULL; sym++) {
428         insertStrHashTable(symhash, sym->lbl, sym->addr);
429     }
430 #   if defined(OBJFORMAT_ELF)
431     dl_prog_handle = dlopen(NULL, RTLD_LAZY);
432 #   endif
433 }
434
435 /* -----------------------------------------------------------------------------
436  * Add a DLL from which symbols may be found.  In the ELF case, just
437  * do RTLD_GLOBAL-style add, so no further messing around needs to
438  * happen in order that symbols in the loaded .so are findable --
439  * lookupSymbol() will subsequently see them by dlsym on the program's
440  * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
441  *
442  * In the PEi386 case, open the DLLs and put handles to them in a 
443  * linked list.  When looking for a symbol, try all handles in the
444  * list.
445  */
446
447 #if defined(OBJFORMAT_PEi386)
448 /* A record for storing handles into DLLs. */
449
450 typedef
451    struct _OpenedDLL {
452       struct _OpenedDLL* next;
453       HINSTANCE instance;
454    } 
455    OpenedDLL;
456
457 /* A list thereof. */
458 static OpenedDLL* opened_dlls = NULL;
459 #endif
460
461
462
463 char*
464 addDLL ( char* path, char* dll_name )
465 {
466 #  if defined(OBJFORMAT_ELF)
467    void *hdl;
468    char *buf;
469    char *errmsg;
470
471    if (path == NULL || strlen(path) == 0) {
472       buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
473       sprintf(buf, "lib%s.so", dll_name);
474    } else {
475       buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll");
476       sprintf(buf, "%s/lib%s.so", path, dll_name);
477    }
478    hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL );
479    free(buf);
480    if (hdl == NULL) {
481       /* dlopen failed; return a ptr to the error msg. */
482       errmsg = dlerror();
483       if (errmsg == NULL) errmsg = "addDLL: unknown error";
484       return errmsg;
485    } else {
486       return NULL;
487    }
488    ASSERT(0); /*NOTREACHED*/
489 #  elif defined(OBJFORMAT_PEi386)
490
491    /* Add this DLL to the list of DLLs in which to search for symbols.
492       The first time through, also add the executable to the list,
493       since we need to search that too.  The path argument is ignored. */
494    char*      buf;
495    OpenedDLL* o_dll;
496    HINSTANCE  instance;
497    /* fprintf(stderr, "addDLL %s\n", dll_name ); */
498
499 #if 0
500    /* Later ... can't figure out why this doesn't work.  So retain the
501       RTS_MINGW_ONLY_SYMBOLS hack for the time being.  */
502    if (opened_dlls == NULL) {
503       /* First time through ... */
504       instance = GetModuleHandle(NULL);
505       if (instance == NULL)
506          return "addDLL: can't get handle to the executable";
507       o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL-init" );
508       o_dll->instance = instance;
509       o_dll->next     = opened_dlls;
510       opened_dlls     = o_dll;
511    }
512 #endif
513
514    buf = stgMallocBytes(strlen(dll_name) + 10, "addDll");
515    sprintf(buf, "%s.DLL", dll_name);
516    instance = LoadLibrary(buf);
517    free(buf);
518    if (instance == NULL) {
519      /* LoadLibrary failed; return a ptr to the error msg. */
520      return "addDLL: unknown error";
521    }
522
523    o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
524    o_dll->instance = instance;
525    o_dll->next     = opened_dlls;
526    opened_dlls     = o_dll;
527
528    return NULL;
529 #  else
530    barf("addDLL: not implemented on this platform");
531 #  endif
532 }
533
534 /* -----------------------------------------------------------------------------
535  * lookup a symbol in the hash table
536  */  
537 void *
538 lookupSymbol( char *lbl )
539 {
540     void *val;
541     ASSERT(symhash != NULL);
542     val = lookupStrHashTable(symhash, lbl);
543
544     if (val == NULL) {
545 #       if defined(OBJFORMAT_ELF)
546         return dlsym(dl_prog_handle, lbl);
547 #       elif defined(OBJFORMAT_PEi386)
548         OpenedDLL* o_dll;
549         void* sym;
550         for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
551            sym = GetProcAddress(o_dll->instance, lbl);
552            if (sym != NULL) return sym;
553         }
554         return NULL;
555 #       endif
556     } else {
557         return val;
558     }
559 }
560
561 static 
562 void *
563 lookupLocalSymbol( ObjectCode* oc, char *lbl )
564 {
565     void *val;
566     val = lookupStrHashTable(oc->lochash, lbl);
567
568     if (val == NULL) {
569         return NULL;
570     } else {
571         return val;
572     }
573 }
574
575
576 /* -----------------------------------------------------------------------------
577  * Load an obj (populate the global symbol table, but don't resolve yet)
578  *
579  * Returns: 1 if ok, 0 on error.
580  */
581 HsInt
582 loadObj( char *path )
583 {
584    ObjectCode* oc;
585    struct stat st;
586    int r, n;
587    FILE *f;
588
589    /* fprintf(stderr, "loadObj %s\n", path ); */
590 #  ifdef DEBUG
591    /* assert that we haven't already loaded this object */
592    { 
593        ObjectCode *o;
594        for (o = objects; o; o = o->next)
595            ASSERT(strcmp(o->fileName, path));
596    }
597 #  endif /* DEBUG */   
598
599    oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
600
601 #  if defined(OBJFORMAT_ELF)
602    oc->formatName = "ELF";
603 #  elif defined(OBJFORMAT_PEi386)
604    oc->formatName = "PEi386";
605 #  else
606    free(oc);
607    barf("loadObj: not implemented on this platform");
608 #  endif
609
610    r = stat(path, &st);
611    if (r == -1) { return 0; }
612
613    /* sigh, strdup() isn't a POSIX function, so do it the long way */
614    oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
615    strcpy(oc->fileName, path);
616
617    oc->fileSize          = st.st_size;
618    oc->image             = stgMallocBytes( st.st_size, "loadObj(image)" );
619    oc->symbols           = NULL;
620    oc->sections          = NULL;
621    oc->lochash           = allocStrHashTable();
622
623    /* chain it onto the list of objects */
624    oc->next              = objects;
625    objects               = oc;
626
627    /* load the image into memory */
628    f = fopen(path, "rb");
629    if (!f) {
630        barf("loadObj: can't read `%s'", path);
631    }
632    n = fread ( oc->image, 1, oc->fileSize, f );
633    if (n != oc->fileSize) {
634       fclose(f);
635       barf("loadObj: error whilst reading `%s'", path);
636    }
637
638    /* verify the in-memory image */
639 #  if defined(OBJFORMAT_ELF)
640    r = ocVerifyImage_ELF ( oc );
641 #  elif defined(OBJFORMAT_PEi386)
642    r = ocVerifyImage_PEi386 ( oc );
643 #  else
644    barf("loadObj: no verify method");
645 #  endif
646    if (!r) { return r; }
647
648    /* build the symbol list for this image */
649 #  if defined(OBJFORMAT_ELF)
650    r = ocGetNames_ELF ( oc );
651 #  elif defined(OBJFORMAT_PEi386)
652    r = ocGetNames_PEi386 ( oc );
653 #  else
654    barf("loadObj: no getNames method");
655 #  endif
656    if (!r) { return r; }
657
658    /* loaded, but not resolved yet */
659    oc->status = OBJECT_LOADED;
660
661    return 1;
662 }
663
664 /* -----------------------------------------------------------------------------
665  * resolve all the currently unlinked objects in memory
666  *
667  * Returns: 1 if ok, 0 on error.
668  */
669 HsInt 
670 resolveObjs( void )
671 {
672     ObjectCode *oc;
673     int r;
674
675     for (oc = objects; oc; oc = oc->next) {
676         if (oc->status != OBJECT_RESOLVED) {
677 #           if defined(OBJFORMAT_ELF)
678             r = ocResolve_ELF ( oc );
679 #           elif defined(OBJFORMAT_PEi386)
680             r = ocResolve_PEi386 ( oc );
681 #           else
682             barf("resolveObjs: not implemented on this platform");
683 #           endif
684             if (!r) { return r; }
685             oc->status = OBJECT_RESOLVED;
686         }
687     }
688     return 1;
689 }
690
691 /* -----------------------------------------------------------------------------
692  * delete an object from the pool
693  */
694 HsInt
695 unloadObj( char *path )
696 {
697     ObjectCode *oc, *prev;
698
699     ASSERT(symhash != NULL);
700     ASSERT(objects != NULL);
701
702     prev = NULL;
703     for (oc = objects; oc; prev = oc, oc = oc->next) {
704         if (!strcmp(oc->fileName,path)) {
705
706             /* Remove all the mappings for the symbols within this
707              * object..
708              */
709             { 
710                 int i;
711                 for (i = 0; i < oc->n_symbols; i++) {
712                    if (oc->symbols[i] != NULL) {
713                        removeStrHashTable(symhash, oc->symbols[i], NULL);
714                    }
715                 }
716             }
717
718             if (prev == NULL) {
719                 objects = oc->next;
720             } else {
721                 prev->next = oc->next;
722             }
723
724             /* We're going to leave this in place, in case there are
725                any pointers from the heap into it: */
726             /* free(oc->image); */
727             free(oc->fileName);
728             free(oc->symbols);
729             free(oc->sections);
730             /* The local hash table should have been freed at the end
731                of the ocResolve_ call on it. */
732             ASSERT(oc->lochash == NULL);
733             free(oc);
734             return 1;
735         }
736     }
737
738     belch("unloadObj: can't find `%s' to unload", path);
739     return 0;
740 }
741
742 /* --------------------------------------------------------------------------
743  * PEi386 specifics (Win32 targets)
744  * ------------------------------------------------------------------------*/
745
746 /* The information for this linker comes from 
747       Microsoft Portable Executable 
748       and Common Object File Format Specification
749       revision 5.1 January 1998
750    which SimonM says comes from the MS Developer Network CDs.
751 */
752       
753
754 #if defined(OBJFORMAT_PEi386)
755
756
757
758 typedef unsigned char  UChar;
759 typedef unsigned short UInt16;
760 typedef unsigned int   UInt32;
761 typedef          int   Int32;
762
763
764 typedef 
765    struct {
766       UInt16 Machine;
767       UInt16 NumberOfSections;
768       UInt32 TimeDateStamp;
769       UInt32 PointerToSymbolTable;
770       UInt32 NumberOfSymbols;
771       UInt16 SizeOfOptionalHeader;
772       UInt16 Characteristics;
773    }
774    COFF_header;
775
776 #define sizeof_COFF_header 20
777
778
779 typedef 
780    struct {
781       UChar  Name[8];
782       UInt32 VirtualSize;
783       UInt32 VirtualAddress;
784       UInt32 SizeOfRawData;
785       UInt32 PointerToRawData;
786       UInt32 PointerToRelocations;
787       UInt32 PointerToLinenumbers;
788       UInt16 NumberOfRelocations;
789       UInt16 NumberOfLineNumbers;
790       UInt32 Characteristics; 
791    }
792    COFF_section;
793
794 #define sizeof_COFF_section 40
795
796
797 typedef
798    struct {
799       UChar  Name[8];
800       UInt32 Value;
801       UInt16 SectionNumber;
802       UInt16 Type;
803       UChar  StorageClass;
804       UChar  NumberOfAuxSymbols;
805    }
806    COFF_symbol;
807
808 #define sizeof_COFF_symbol 18
809
810
811 typedef
812    struct {
813       UInt32 VirtualAddress;
814       UInt32 SymbolTableIndex;
815       UInt16 Type;
816    }
817    COFF_reloc;
818
819 #define sizeof_COFF_reloc 10
820
821
822 /* From PE spec doc, section 3.3.2 */
823 /* Note use of MYIMAGE_* since IMAGE_* are already defined in
824    windows.h -- for the same purpose, but I want to know what I'm
825    getting, here. */
826 #define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
827 #define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
828 #define MYIMAGE_FILE_DLL                 0x2000
829 #define MYIMAGE_FILE_SYSTEM              0x1000
830 #define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
831 #define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
832 #define MYIMAGE_FILE_32BIT_MACHINE       0x0100
833
834 /* From PE spec doc, section 5.4.2 and 5.4.4 */
835 #define MYIMAGE_SYM_CLASS_EXTERNAL       2
836 #define MYIMAGE_SYM_CLASS_STATIC         3
837 #define MYIMAGE_SYM_UNDEFINED            0
838
839 /* From PE spec doc, section 4.1 */
840 #define MYIMAGE_SCN_CNT_CODE             0x00000020
841 #define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
842
843 /* From PE spec doc, section 5.2.1 */
844 #define MYIMAGE_REL_I386_DIR32           0x0006
845 #define MYIMAGE_REL_I386_REL32           0x0014
846
847
848 /* We use myindex to calculate array addresses, rather than
849    simply doing the normal subscript thing.  That's because
850    some of the above structs have sizes which are not 
851    a whole number of words.  GCC rounds their sizes up to a
852    whole number of words, which means that the address calcs
853    arising from using normal C indexing or pointer arithmetic
854    are just plain wrong.  Sigh.
855 */
856 static UChar *
857 myindex ( int scale, void* base, int index )
858 {
859    return
860       ((UChar*)base) + scale * index;
861 }
862
863
864 static void
865 printName ( UChar* name, UChar* strtab )
866 {
867    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
868       UInt32 strtab_offset = * (UInt32*)(name+4);
869       fprintf ( stderr, "%s", strtab + strtab_offset );
870    } else {
871       int i;
872       for (i = 0; i < 8; i++) {
873          if (name[i] == 0) break;
874          fprintf ( stderr, "%c", name[i] );
875       }
876    }
877 }
878
879
880 static void
881 copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
882 {
883    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
884       UInt32 strtab_offset = * (UInt32*)(name+4);
885       strncpy ( dst, strtab+strtab_offset, dstSize );
886       dst[dstSize-1] = 0;
887    } else {
888       int i = 0;
889       while (1) {
890          if (i >= 8) break;
891          if (name[i] == 0) break;
892          dst[i] = name[i];
893          i++;
894       }
895       dst[i] = 0;
896    }
897 }
898
899
900 static UChar *
901 cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
902 {
903    UChar* newstr;
904    /* If the string is longer than 8 bytes, look in the
905       string table for it -- this will be correctly zero terminated. 
906    */
907    if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
908       UInt32 strtab_offset = * (UInt32*)(name+4);
909       return ((UChar*)strtab) + strtab_offset;
910    }
911    /* Otherwise, if shorter than 8 bytes, return the original,
912       which by defn is correctly terminated.
913    */
914    if (name[7]==0) return name;
915    /* The annoying case: 8 bytes.  Copy into a temporary
916       (which is never freed ...)
917    */
918    newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
919    ASSERT(newstr);
920    strncpy(newstr,name,8);
921    newstr[8] = 0;
922    return newstr;
923 }
924
925
926 /* Just compares the short names (first 8 chars) */
927 static COFF_section *
928 findPEi386SectionCalled ( ObjectCode* oc,  char* name )
929 {
930    int i;
931    COFF_header* hdr 
932       = (COFF_header*)(oc->image);
933    COFF_section* sectab 
934       = (COFF_section*) (
935            ((UChar*)(oc->image)) 
936            + sizeof_COFF_header + hdr->SizeOfOptionalHeader
937         );
938    for (i = 0; i < hdr->NumberOfSections; i++) {
939       UChar* n1;
940       UChar* n2;
941       COFF_section* section_i 
942          = (COFF_section*)
943            myindex ( sizeof_COFF_section, sectab, i );
944       n1 = (UChar*) &(section_i->Name);
945       n2 = name;
946       if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] && 
947           n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] && 
948           n1[6]==n2[6] && n1[7]==n2[7])
949          return section_i;
950    }
951
952    return NULL;
953 }
954
955
956 static void
957 zapTrailingAtSign ( UChar* sym )
958 {
959 #  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
960    int i, j;
961    if (sym[0] == 0) return;
962    i = 0; 
963    while (sym[i] != 0) i++;
964    i--;
965    j = i;
966    while (j > 0 && my_isdigit(sym[j])) j--;
967    if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
968 #  undef my_isdigit
969 }
970
971
972 static int
973 ocVerifyImage_PEi386 ( ObjectCode* oc )
974 {
975    int i, j;
976    COFF_header*  hdr;
977    COFF_section* sectab;
978    COFF_symbol*  symtab;
979    UChar*        strtab;
980    fprintf(stderr, "\nLOADING %s\n", oc->fileName);
981    hdr = (COFF_header*)(oc->image);
982    sectab = (COFF_section*) (
983                ((UChar*)(oc->image)) 
984                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
985             );
986    symtab = (COFF_symbol*) (
987                ((UChar*)(oc->image))
988                + hdr->PointerToSymbolTable 
989             );
990    strtab = ((UChar*)symtab)
991             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
992
993    if (hdr->Machine != 0x14c) {
994       belch("Not x86 PEi386");
995       return 0;
996    }
997    if (hdr->SizeOfOptionalHeader != 0) {
998       belch("PEi386 with nonempty optional header");
999       return 0;
1000    }
1001    if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
1002         (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
1003         (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
1004         (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
1005       belch("Not a PEi386 object file");
1006       return 0;
1007    }
1008    if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
1009         /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
1010       belch("Invalid PEi386 word size or endiannness: %d", 
1011             (int)(hdr->Characteristics));
1012       return 0;
1013    }
1014    /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
1015    if (* (UInt32*)strtab > 510000) {
1016       belch("PEi386 object has suspiciously large string table; > 64k relocs?");
1017       return 0;
1018    }
1019
1020    /* No further verification after this point; only debug printing. */
1021    i = 0;
1022    IF_DEBUG(linker, i=1);
1023    if (i == 0) return 1;
1024
1025    fprintf ( stderr, 
1026              "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
1027    fprintf ( stderr, 
1028              "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
1029    fprintf ( stderr, 
1030              "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
1031
1032    fprintf ( stderr, "\n" );
1033    fprintf ( stderr, 
1034              "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
1035    fprintf ( stderr, 
1036              "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
1037    fprintf ( stderr,
1038              "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
1039    fprintf ( stderr,
1040              "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
1041    fprintf ( stderr, 
1042              "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
1043    fprintf ( stderr, 
1044              "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
1045    fprintf ( stderr,
1046              "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
1047
1048    /* Print the section table. */
1049    fprintf ( stderr, "\n" );
1050    for (i = 0; i < hdr->NumberOfSections; i++) {
1051       COFF_reloc* reltab;
1052       COFF_section* sectab_i
1053          = (COFF_section*)
1054            myindex ( sizeof_COFF_section, sectab, i );
1055       fprintf ( stderr, 
1056                 "\n"
1057                 "section %d\n"
1058                 "     name `",
1059                 i 
1060               );
1061       printName ( sectab_i->Name, strtab );
1062       fprintf ( stderr, 
1063                 "'\n"
1064                 "    vsize %d\n"
1065                 "    vaddr %d\n"
1066                 "  data sz %d\n"
1067                 " data off %d\n"
1068                 "  num rel %d\n"
1069                 "  off rel %d\n",
1070                 sectab_i->VirtualSize,
1071                 sectab_i->VirtualAddress,
1072                 sectab_i->SizeOfRawData,
1073                 sectab_i->PointerToRawData,
1074                 sectab_i->NumberOfRelocations,
1075                 sectab_i->PointerToRelocations
1076               );
1077       reltab = (COFF_reloc*) (
1078                   ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1079                );
1080
1081       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1082          COFF_symbol* sym;
1083          COFF_reloc* rel = (COFF_reloc*)
1084                            myindex ( sizeof_COFF_reloc, reltab, j );
1085          fprintf ( stderr, 
1086                    "        type 0x%-4x   vaddr 0x%-8x   name `",
1087                    (UInt32)rel->Type, 
1088                    rel->VirtualAddress );
1089          sym = (COFF_symbol*)
1090                myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
1091          printName ( sym->Name, strtab -10 );
1092          fprintf ( stderr, "'\n" );
1093       }
1094       fprintf ( stderr, "\n" );
1095    }
1096
1097    fprintf ( stderr, "\n" );
1098    fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
1099    fprintf ( stderr, "---START of string table---\n");
1100    for (i = 4; i < *(Int32*)strtab; i++) {
1101       if (strtab[i] == 0) 
1102          fprintf ( stderr, "\n"); else 
1103          fprintf( stderr, "%c", strtab[i] );
1104    }
1105    fprintf ( stderr, "--- END  of string table---\n");
1106
1107    fprintf ( stderr, "\n" );
1108    i = 0;
1109    while (1) {
1110       COFF_symbol* symtab_i;
1111       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1112       symtab_i = (COFF_symbol*)
1113                  myindex ( sizeof_COFF_symbol, symtab, i );
1114       fprintf ( stderr, 
1115                 "symbol %d\n"
1116                 "     name `",
1117                 i 
1118               );
1119       printName ( symtab_i->Name, strtab );
1120       fprintf ( stderr, 
1121                 "'\n"
1122                 "    value 0x%x\n"
1123                 "     sec# %d\n"
1124                 "     type 0x%x\n"
1125                 "   sclass 0x%x\n"
1126                 "     nAux %d\n",
1127                 symtab_i->Value,
1128                 (Int32)(symtab_i->SectionNumber) - 1,
1129                 (UInt32)symtab_i->Type,
1130                 (UInt32)symtab_i->StorageClass,
1131                 (UInt32)symtab_i->NumberOfAuxSymbols 
1132               );
1133       i += symtab_i->NumberOfAuxSymbols;
1134       i++;
1135    }
1136
1137    fprintf ( stderr, "\n" );
1138    return 1;
1139 }
1140
1141
1142 static int
1143 ocGetNames_PEi386 ( ObjectCode* oc )
1144 {
1145    COFF_header*  hdr;
1146    COFF_section* sectab;
1147    COFF_symbol*  symtab;
1148    UChar*        strtab;
1149
1150    UChar* sname;
1151    void*  addr;
1152    int    i;
1153    
1154    hdr = (COFF_header*)(oc->image);
1155    sectab = (COFF_section*) (
1156                ((UChar*)(oc->image)) 
1157                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1158             );
1159    symtab = (COFF_symbol*) (
1160                ((UChar*)(oc->image))
1161                + hdr->PointerToSymbolTable 
1162             );
1163    strtab = ((UChar*)(oc->image))
1164             + hdr->PointerToSymbolTable
1165             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1166
1167    /* Copy exported symbols into the ObjectCode. */
1168
1169    oc->n_symbols = hdr->NumberOfSymbols;
1170    oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
1171                                   "ocGetNames_PEi386(oc->symbols)");
1172    /* Call me paranoid; I don't care. */
1173    for (i = 0; i < oc->n_symbols; i++) 
1174       oc->symbols[i] = NULL;
1175
1176    i = 0;
1177    while (1) {
1178       COFF_symbol* symtab_i;
1179       if (i >= (Int32)(hdr->NumberOfSymbols)) break;
1180       symtab_i = (COFF_symbol*)
1181                  myindex ( sizeof_COFF_symbol, symtab, i );
1182
1183       if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL &&
1184           symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
1185
1186          /* This symbol is global and defined, viz, exported */
1187          COFF_section* sectabent;
1188
1189          /* cstring_from_COFF_symbol_name always succeeds. */
1190          sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
1191
1192          /* for MYIMAGE_SYMCLASS_EXTERNAL 
1193                 && !MYIMAGE_SYM_UNDEFINED,
1194             the address of the symbol is: 
1195                 address of relevant section + offset in section
1196          */
1197          sectabent = (COFF_section*)
1198                      myindex ( sizeof_COFF_section, 
1199                                sectab,
1200                                symtab_i->SectionNumber-1 );
1201          addr = ((UChar*)(oc->image))
1202                 + (sectabent->PointerToRawData
1203                    + symtab_i->Value);
1204          /* fprintf(stderr,"addSymbol %p `%s'\n", addr,sname); */
1205          IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
1206          ASSERT(i >= 0 && i < oc->n_symbols);
1207          oc->symbols[i] = sname;
1208          insertStrHashTable(symhash, sname, addr);
1209       }
1210       i += symtab_i->NumberOfAuxSymbols;
1211       i++;
1212    }
1213
1214    /* Copy section information into the ObjectCode. */
1215
1216    oc->n_sections = hdr->NumberOfSections;
1217    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section), 
1218                                   "ocGetNamesPEi386" );
1219
1220    for (i = 0; i < oc->n_sections; i++) {
1221       UChar* start;
1222       UChar* end;
1223
1224       SectionKind kind 
1225          = SECTIONKIND_OTHER;
1226       COFF_section* sectab_i
1227          = (COFF_section*)
1228            myindex ( sizeof_COFF_section, sectab, i );
1229       IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
1230
1231 #if 0
1232       /* I'm sure this is the Right Way to do it.  However, the 
1233          alternative of testing the sectab_i->Name field seems to
1234          work ok with Cygwin.
1235       */
1236       if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE || 
1237           sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
1238          kind = SECTIONKIND_CODE_OR_RODATA;
1239 #endif
1240
1241       if (0==strcmp(".text",sectab_i->Name))
1242          kind = SECTIONKIND_CODE_OR_RODATA;
1243       if (0==strcmp(".data",sectab_i->Name) ||
1244           0==strcmp(".bss",sectab_i->Name))
1245          kind = SECTIONKIND_RWDATA;
1246
1247       start = ((UChar*)(oc->image)) 
1248               + sectab_i->PointerToRawData;
1249       end   = start 
1250               + sectab_i->SizeOfRawData - 1;
1251
1252       if (kind == SECTIONKIND_OTHER) {
1253          belch("Unknown PEi386 section name `%s'", sectab_i->Name);
1254          return 0;
1255       }
1256
1257       oc->sections[i].start = start;
1258       oc->sections[i].end   = end;
1259       oc->sections[i].kind  = kind;
1260    }
1261
1262    return 1;   
1263 }
1264
1265
1266 static int
1267 ocResolve_PEi386 ( ObjectCode* oc )
1268 {
1269    COFF_header*  hdr;
1270    COFF_section* sectab;
1271    COFF_symbol*  symtab;
1272    UChar*        strtab;
1273
1274    UInt32        A;
1275    UInt32        S;
1276    UInt32*       pP;
1277
1278    int i, j;
1279
1280    /* ToDo: should be variable-sized?  But is at least safe in the
1281       sense of buffer-overrun-proof. */
1282    char symbol[1000];
1283    /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
1284
1285    hdr = (COFF_header*)(oc->image);
1286    sectab = (COFF_section*) (
1287                ((UChar*)(oc->image)) 
1288                + sizeof_COFF_header + hdr->SizeOfOptionalHeader
1289             );
1290    symtab = (COFF_symbol*) (
1291                ((UChar*)(oc->image))
1292                + hdr->PointerToSymbolTable 
1293             );
1294    strtab = ((UChar*)(oc->image))
1295             + hdr->PointerToSymbolTable
1296             + hdr->NumberOfSymbols * sizeof_COFF_symbol;
1297
1298    for (i = 0; i < hdr->NumberOfSections; i++) {
1299       COFF_section* sectab_i
1300          = (COFF_section*)
1301            myindex ( sizeof_COFF_section, sectab, i );
1302       COFF_reloc* reltab
1303          = (COFF_reloc*) (
1304               ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
1305            );
1306       for (j = 0; j < sectab_i->NumberOfRelocations; j++) {
1307          COFF_symbol* sym;
1308          COFF_reloc* reltab_j 
1309             = (COFF_reloc*)
1310               myindex ( sizeof_COFF_reloc, reltab, j );
1311
1312          /* the location to patch */
1313          pP = (UInt32*)(
1314                  ((UChar*)(oc->image)) 
1315                  + (sectab_i->PointerToRawData 
1316                     + reltab_j->VirtualAddress
1317                     - sectab_i->VirtualAddress )
1318               );
1319          /* the existing contents of pP */
1320          A = *pP;
1321          /* the symbol to connect to */
1322          sym = (COFF_symbol*)
1323                myindex ( sizeof_COFF_symbol, 
1324                          symtab, reltab_j->SymbolTableIndex );
1325          IF_DEBUG(linker,
1326                   fprintf ( stderr, 
1327                             "reloc sec %2d num %3d:  type 0x%-4x   "
1328                             "vaddr 0x%-8x   name `",
1329                             i, j,
1330                             (UInt32)reltab_j->Type, 
1331                             reltab_j->VirtualAddress );
1332                             printName ( sym->Name, strtab );
1333                             fprintf ( stderr, "'\n" ));
1334
1335          if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
1336             COFF_section* section_sym 
1337                = findPEi386SectionCalled ( oc, sym->Name );
1338             if (!section_sym) {
1339                fprintf ( stderr, "bad section = `%s'\n", sym->Name );
1340                barf("Can't find abovementioned PEi386 section");
1341                return 0;
1342             }
1343             S = ((UInt32)(oc->image))
1344                 + (section_sym->PointerToRawData
1345                    + sym->Value);
1346          } else {
1347             copyName ( sym->Name, strtab, symbol, 1000-1 );
1348             zapTrailingAtSign ( symbol );
1349             (void*)S = lookupLocalSymbol( oc, symbol );
1350             if ((void*)S == NULL)
1351                (void*)S = lookupSymbol( symbol );
1352             if (S == 0) {
1353                 belch("ocResolve_PEi386: %s: unknown symbol `%s'", 
1354                       oc->fileName, symbol);
1355                 return 0;
1356             }
1357          }
1358
1359          switch (reltab_j->Type) {
1360             case MYIMAGE_REL_I386_DIR32: 
1361                *pP = A + S; 
1362                break;
1363             case MYIMAGE_REL_I386_REL32:
1364                /* Tricky.  We have to insert a displacement at
1365                   pP which, when added to the PC for the _next_
1366                   insn, gives the address of the target (S).
1367                   Problem is to know the address of the next insn
1368                   when we only know pP.  We assume that this
1369                   literal field is always the last in the insn,
1370                   so that the address of the next insn is pP+4
1371                   -- hence the constant 4.
1372                   Also I don't know if A should be added, but so
1373                   far it has always been zero.
1374                */
1375                ASSERT(A==0);
1376                *pP = S - ((UInt32)pP) - 4;
1377                break;
1378             default: 
1379                fprintf(stderr, 
1380                        "unhandled PEi386 relocation type %d\n",
1381                        reltab_j->Type);
1382                barf("unhandled PEi386 relocation type");
1383                return 0;
1384          }
1385
1386       }
1387    }
1388    
1389    /* fprintf(stderr, "completed     %s\n", oc->fileName); */
1390    return 1;
1391 }
1392
1393 #endif /* defined(OBJFORMAT_PEi386) */
1394
1395
1396 /* --------------------------------------------------------------------------
1397  * ELF specifics
1398  * ------------------------------------------------------------------------*/
1399
1400 #if defined(OBJFORMAT_ELF)
1401
1402 #define FALSE 0
1403 #define TRUE  1
1404
1405 #if defined(sparc_TARGET_ARCH)
1406 #  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
1407 #endif
1408
1409 #include <elf.h>
1410
1411 static char *
1412 findElfSection ( void* objImage, Elf32_Word sh_type )
1413 {
1414    int i;
1415    char* ehdrC = (char*)objImage;
1416    Elf32_Ehdr* ehdr = ( Elf32_Ehdr*)ehdrC;
1417    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1418    char* ptr = NULL;
1419    for (i = 0; i < ehdr->e_shnum; i++) {
1420       if (shdr[i].sh_type == sh_type &&
1421           i !=  ehdr->e_shstrndx) {
1422          ptr = ehdrC + shdr[i].sh_offset;
1423          break;
1424       }
1425    }
1426    return ptr;
1427 }
1428
1429
1430 static int
1431 ocVerifyImage_ELF ( ObjectCode* oc )
1432 {
1433    Elf32_Shdr* shdr;
1434    Elf32_Sym*  stab;
1435    int i, j, nent, nstrtab, nsymtabs;
1436    char* sh_strtab;
1437    char* strtab;
1438
1439    char*       ehdrC = (char*)(oc->image);
1440    Elf32_Ehdr* ehdr  = ( Elf32_Ehdr*)ehdrC;
1441
1442    if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
1443        ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
1444        ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
1445        ehdr->e_ident[EI_MAG3] != ELFMAG3) {
1446       belch("ocVerifyImage_ELF: not an ELF header");
1447       return 0;
1448    }
1449    IF_DEBUG(linker,belch( "Is an ELF header" ));
1450
1451    if (ehdr->e_ident[EI_CLASS] != ELFCLASS32) {
1452       belch("ocVerifyImage_ELF: not 32 bit ELF" );
1453       return 0;
1454    }
1455
1456    IF_DEBUG(linker,belch( "Is 32 bit ELF" ));
1457
1458    if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
1459        IF_DEBUG(linker,belch( "Is little-endian" ));
1460    } else
1461    if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
1462        IF_DEBUG(linker,belch( "Is big-endian" ));
1463    } else {
1464        belch("ocVerifyImage_ELF: unknown endiannness");
1465        return 0;
1466    }
1467
1468    if (ehdr->e_type != ET_REL) {
1469       belch("ocVerifyImage_ELF: not a relocatable object (.o) file");
1470       return 0;
1471    }
1472    IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
1473
1474    IF_DEBUG(linker,belch( "Architecture is " ));
1475    switch (ehdr->e_machine) {
1476       case EM_386:   IF_DEBUG(linker,belch( "x86" )); break;
1477       case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
1478       default:       IF_DEBUG(linker,belch( "unknown" )); 
1479                      belch("ocVerifyImage_ELF: unknown architecture");
1480                      return 0;
1481    }
1482
1483    IF_DEBUG(linker,belch(
1484              "\nSection header table: start %d, n_entries %d, ent_size %d", 
1485              ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
1486
1487    ASSERT (ehdr->e_shentsize == sizeof(Elf32_Shdr));
1488
1489    shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1490
1491    if (ehdr->e_shstrndx == SHN_UNDEF) {
1492       belch("ocVerifyImage_ELF: no section header string table");
1493       return 0;
1494    } else {
1495       IF_DEBUG(linker,belch( "Section header string table is section %d", 
1496                           ehdr->e_shstrndx));
1497       sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1498    }
1499
1500    for (i = 0; i < ehdr->e_shnum; i++) {
1501       IF_DEBUG(linker,fprintf(stderr, "%2d:  ", i ));
1502       IF_DEBUG(linker,fprintf(stderr, "type=%2d  ", (int)shdr[i].sh_type ));
1503       IF_DEBUG(linker,fprintf(stderr, "size=%4d  ", (int)shdr[i].sh_size ));
1504       IF_DEBUG(linker,fprintf(stderr, "offs=%4d  ", (int)shdr[i].sh_offset ));
1505       IF_DEBUG(linker,fprintf(stderr, "  (%p .. %p)  ",
1506                ehdrC + shdr[i].sh_offset, 
1507                       ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
1508
1509       if (shdr[i].sh_type == SHT_REL) {
1510           IF_DEBUG(linker,fprintf(stderr, "Rel  " ));
1511       } else if (shdr[i].sh_type == SHT_RELA) {
1512           IF_DEBUG(linker,fprintf(stderr, "RelA " ));
1513       } else {
1514           IF_DEBUG(linker,fprintf(stderr,"     "));
1515       }
1516       if (sh_strtab) {
1517           IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
1518       }
1519    }
1520
1521    IF_DEBUG(linker,belch( "\nString tables" ));
1522    strtab = NULL;
1523    nstrtab = 0;
1524    for (i = 0; i < ehdr->e_shnum; i++) {
1525       if (shdr[i].sh_type == SHT_STRTAB &&
1526           i !=  ehdr->e_shstrndx) {
1527           IF_DEBUG(linker,belch("   section %d is a normal string table", i ));
1528          strtab = ehdrC + shdr[i].sh_offset;
1529          nstrtab++;
1530       }
1531    }  
1532    if (nstrtab != 1) {
1533       belch("ocVerifyImage_ELF: no string tables, or too many");
1534       return 0;
1535    }
1536
1537    nsymtabs = 0;
1538    IF_DEBUG(linker,belch( "\nSymbol tables" )); 
1539    for (i = 0; i < ehdr->e_shnum; i++) {
1540       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1541       IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
1542       nsymtabs++;
1543       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1544       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1545       IF_DEBUG(linker,belch( "   number of entries is apparently %d (%d rem)",
1546                nent,
1547                shdr[i].sh_size % sizeof(Elf32_Sym)
1548              ));
1549       if (0 != shdr[i].sh_size % sizeof(Elf32_Sym)) {
1550          belch("ocVerifyImage_ELF: non-integral number of symbol table entries");
1551          return 0;
1552       }
1553       for (j = 0; j < nent; j++) {
1554          IF_DEBUG(linker,fprintf(stderr, "   %2d  ", j ));
1555          IF_DEBUG(linker,fprintf(stderr, "  sec=%-5d  size=%-3d  val=%5p  ", 
1556                              (int)stab[j].st_shndx,
1557                              (int)stab[j].st_size,
1558                              (char*)stab[j].st_value ));
1559
1560          IF_DEBUG(linker,fprintf(stderr, "type=" ));
1561          switch (ELF32_ST_TYPE(stab[j].st_info)) {
1562             case STT_NOTYPE:  IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
1563             case STT_OBJECT:  IF_DEBUG(linker,fprintf(stderr, "object " )); break;
1564             case STT_FUNC  :  IF_DEBUG(linker,fprintf(stderr, "func   " )); break;
1565             case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
1566             case STT_FILE:    IF_DEBUG(linker,fprintf(stderr, "file   " )); break;
1567             default:          IF_DEBUG(linker,fprintf(stderr, "?      " )); break;
1568          }
1569          IF_DEBUG(linker,fprintf(stderr, "  " ));
1570
1571          IF_DEBUG(linker,fprintf(stderr, "bind=" ));
1572          switch (ELF32_ST_BIND(stab[j].st_info)) {
1573             case STB_LOCAL :  IF_DEBUG(linker,fprintf(stderr, "local " )); break;
1574             case STB_GLOBAL:  IF_DEBUG(linker,fprintf(stderr, "global" )); break;
1575             case STB_WEAK  :  IF_DEBUG(linker,fprintf(stderr, "weak  " )); break;
1576             default:          IF_DEBUG(linker,fprintf(stderr, "?     " )); break;
1577          }
1578          IF_DEBUG(linker,fprintf(stderr, "  " ));
1579
1580          IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
1581       }
1582    }
1583
1584    if (nsymtabs == 0) {
1585       belch("ocVerifyImage_ELF: didn't find any symbol tables");
1586       return 0;
1587    }
1588
1589    return 1;
1590 }
1591
1592
1593 static int
1594 ocGetNames_ELF ( ObjectCode* oc )
1595 {
1596    int i, j, k, nent;
1597    Elf32_Sym* stab;
1598
1599    char*       ehdrC      = (char*)(oc->image);
1600    Elf32_Ehdr* ehdr       = (Elf32_Ehdr*)ehdrC;
1601    char*       strtab     = findElfSection ( ehdrC, SHT_STRTAB );
1602    Elf32_Shdr* shdr       = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1603    char*       sh_strtab  = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
1604
1605    ASSERT(symhash != NULL);
1606
1607    if (!strtab) {
1608       belch("ocGetNames_ELF: no strtab");
1609       return 0;
1610    }
1611
1612    k = 0;
1613    oc->n_sections = ehdr->e_shnum;
1614    oc->sections = stgMallocBytes( oc->n_sections * sizeof(Section), 
1615                                   "ocGetNames_ELF(oc->sections)" );
1616
1617    for (i = 0; i < oc->n_sections; i++) {
1618
1619       /* make a section entry for relevant sections */
1620       SectionKind kind = SECTIONKIND_OTHER;
1621       if (!strcmp(".data",sh_strtab+shdr[i].sh_name) ||
1622           !strcmp(".data1",sh_strtab+shdr[i].sh_name))
1623           kind = SECTIONKIND_RWDATA;
1624       if (!strcmp(".text",sh_strtab+shdr[i].sh_name) ||
1625           !strcmp(".rodata",sh_strtab+shdr[i].sh_name) ||
1626           !strcmp(".rodata1",sh_strtab+shdr[i].sh_name))
1627           kind = SECTIONKIND_CODE_OR_RODATA;
1628
1629       /* fill in the section info */
1630       oc->sections[i].start = ehdrC + shdr[i].sh_offset;
1631       oc->sections[i].end   = ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1;
1632       oc->sections[i].kind  = kind;
1633       
1634       if (shdr[i].sh_type != SHT_SYMTAB) continue;
1635
1636       /* copy stuff into this module's object symbol table */
1637       stab = (Elf32_Sym*) (ehdrC + shdr[i].sh_offset);
1638       nent = shdr[i].sh_size / sizeof(Elf32_Sym);
1639
1640       oc->n_symbols = nent;
1641       oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*), 
1642                                    "ocGetNames_ELF(oc->symbols)");
1643
1644       for (j = 0; j < nent; j++) {
1645          if ( ( ELF32_ST_BIND(stab[j].st_info)==STB_GLOBAL
1646                 || ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL
1647               )
1648               /* and not an undefined symbol */
1649               && stab[j].st_shndx != SHN_UNDEF
1650               /* and not in a "special section" */
1651               && stab[j].st_shndx < SHN_LORESERVE
1652               &&
1653               /* and it's a not a section or string table or anything silly */
1654               ( ELF32_ST_TYPE(stab[j].st_info)==STT_FUNC ||
1655                 ELF32_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
1656                 ELF32_ST_TYPE(stab[j].st_info)==STT_NOTYPE 
1657               )
1658             ) { 
1659             char* nm = strtab + stab[j].st_name;
1660             char* ad = ehdrC 
1661                        + shdr[ stab[j].st_shndx ].sh_offset
1662                        + stab[j].st_value;
1663             ASSERT(nm != NULL);
1664             ASSERT(ad != NULL);
1665             oc->symbols[j] = nm;
1666             if (ELF32_ST_BIND(stab[j].st_info)==STB_LOCAL) {
1667                IF_DEBUG(linker,belch( "addOTabName(LOCL): %10p  %s %s",
1668                                       ad, oc->fileName, nm ));
1669                insertStrHashTable(oc->lochash, nm, ad);
1670             } else {
1671                IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p  %s %s",
1672                                       ad, oc->fileName, nm ));
1673                insertStrHashTable(symhash, nm, ad);
1674             }
1675          }
1676          else {
1677             IF_DEBUG(linker,belch( "skipping `%s'", 
1678                                    strtab + stab[j].st_name ));
1679             /*
1680             fprintf(stderr, 
1681                     "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
1682                     (int)ELF32_ST_BIND(stab[j].st_info), 
1683                     (int)ELF32_ST_TYPE(stab[j].st_info), 
1684                     (int)stab[j].st_shndx,
1685                     strtab + stab[j].st_name
1686                    );
1687             */
1688             oc->symbols[j] = NULL;
1689          }
1690       }
1691    }
1692
1693    return 1;
1694 }
1695
1696
1697 /* Do ELF relocations which lack an explicit addend.  All x86-linux
1698    relocations appear to be of this form. */
1699 static int do_Elf32_Rel_relocations ( ObjectCode* oc, char* ehdrC,
1700                                       Elf32_Shdr* shdr, int shnum, 
1701                                       Elf32_Sym*  stab, char* strtab )
1702 {
1703    int j;
1704    char *symbol;
1705    Elf32_Word* targ;
1706    Elf32_Rel*  rtab = (Elf32_Rel*) (ehdrC + shdr[shnum].sh_offset);
1707    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rel);
1708    int target_shndx = shdr[shnum].sh_info;
1709    int symtab_shndx = shdr[shnum].sh_link;
1710    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1711    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1712    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1713                           target_shndx, symtab_shndx ));
1714    for (j = 0; j < nent; j++) {
1715       Elf32_Addr offset = rtab[j].r_offset;
1716       Elf32_Word info   = rtab[j].r_info;
1717
1718       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1719       Elf32_Word* pP = (Elf32_Word*)P;
1720       Elf32_Addr  A  = *pP;
1721       Elf32_Addr  S;
1722
1723       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)", 
1724                              j, (void*)offset, (void*)info ));
1725       if (!info) {
1726          IF_DEBUG(linker,belch( " ZERO" ));
1727          S = 0;
1728       } else {
1729          /* First see if it is a nameless local symbol. */
1730          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1731             symbol = "(noname)";
1732             S = (Elf32_Addr)
1733                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1734                        + stab[ELF32_R_SYM(info)].st_value);
1735          } else {
1736             /* No?  Should be in a symbol table then; first try the
1737                local one. */
1738             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1739             (void*)S = lookupLocalSymbol( oc, symbol );
1740             if ((void*)S == NULL)
1741                (void*)S = lookupSymbol( symbol );
1742          }
1743          if (!S) {
1744             barf("do_Elf32_Rel_relocations:  %s: unknown symbol `%s'", 
1745                  oc->fileName, symbol);
1746          }
1747          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1748       }
1749       IF_DEBUG(linker,belch( "Reloc: P = %p   S = %p   A = %p",
1750                              (void*)P, (void*)S, (void*)A )); 
1751       switch (ELF32_R_TYPE(info)) {
1752 #        ifdef i386_TARGET_ARCH
1753          case R_386_32:   *pP = S + A;     break;
1754          case R_386_PC32: *pP = S + A - P; break;
1755 #        endif
1756          default: 
1757             fprintf(stderr, "unhandled ELF relocation(Rel) type %d\n",
1758                             ELF32_R_TYPE(info));
1759             barf("do_Elf32_Rel_relocations: unhandled ELF relocation type");
1760             return 0;
1761       }
1762
1763    }
1764    return 1;
1765 }
1766
1767
1768 /* Do ELF relocations for which explicit addends are supplied.
1769    sparc-solaris relocations appear to be of this form. */
1770 static int do_Elf32_Rela_relocations ( ObjectCode* oc, char* ehdrC,
1771                                        Elf32_Shdr* shdr, int shnum, 
1772                                        Elf32_Sym*  stab, char* strtab )
1773 {
1774    int j;
1775    char *symbol;
1776    Elf32_Word* targ;
1777    Elf32_Rela* rtab = (Elf32_Rela*) (ehdrC + shdr[shnum].sh_offset);
1778    int         nent = shdr[shnum].sh_size / sizeof(Elf32_Rela);
1779    int target_shndx = shdr[shnum].sh_info;
1780    int symtab_shndx = shdr[shnum].sh_link;
1781    stab  = (Elf32_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
1782    targ  = (Elf32_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
1783    IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
1784                           target_shndx, symtab_shndx ));
1785    for (j = 0; j < nent; j++) {
1786       Elf32_Addr  offset = rtab[j].r_offset;
1787       Elf32_Word  info   = rtab[j].r_info;
1788       Elf32_Sword addend = rtab[j].r_addend;
1789
1790       Elf32_Addr  P  = ((Elf32_Addr)targ) + offset;
1791       Elf32_Addr  A  = addend;
1792       Elf32_Addr  S;
1793 #     if defined(sparc_TARGET_ARCH)
1794       /* This #ifdef only serves to avoid unused-var warnings. */
1795       Elf32_Word* pP = (Elf32_Word*)P;
1796       Elf32_Word  w1, w2;
1797 #     endif
1798
1799       IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p)   ", 
1800                              j, (void*)offset, (void*)info, 
1801                                 (void*)addend ));
1802       if (!info) {
1803          IF_DEBUG(linker,belch( " ZERO" ));
1804          S = 0;
1805       } else {
1806          /* First see if it is a nameless local symbol. */
1807          if (stab[ ELF32_R_SYM(info)].st_name == 0) {
1808             symbol = "(noname)";
1809             S = (Elf32_Addr)
1810                 (ehdrC + shdr[stab[ELF32_R_SYM(info)].st_shndx ].sh_offset
1811                        + stab[ELF32_R_SYM(info)].st_value);
1812          } else {
1813             /* No?  Should be in a symbol table then; first try the
1814                local one. */
1815             symbol = strtab+stab[ ELF32_R_SYM(info)].st_name;
1816             (void*)S = lookupLocalSymbol( oc, symbol );
1817             if ((void*)S == NULL)
1818                (void*)S = lookupSymbol( symbol );
1819          }
1820          if (!S) {
1821            barf("do_Elf32_Rela_relocations: %s: unknown symbol `%s'", 
1822                    oc->fileName, symbol);
1823            /* 
1824            S = 0x11223344;
1825            fprintf ( stderr, "S %p A %p S+A %p S+A-P %p\n",S,A,S+A,S+A-P);
1826            */
1827          }
1828          IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
1829       }
1830       IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p   S = %p   A = %p\n",
1831                                         (void*)P, (void*)S, (void*)A )); 
1832       switch (ELF32_R_TYPE(info)) {
1833 #        if defined(sparc_TARGET_ARCH)
1834          case R_SPARC_WDISP30: 
1835             w1 = *pP & 0xC0000000;
1836             w2 = (Elf32_Word)((S + A - P) >> 2);
1837             ASSERT((w2 & 0xC0000000) == 0);
1838             w1 |= w2;
1839             *pP = w1;
1840             break;
1841          case R_SPARC_HI22:
1842             w1 = *pP & 0xFFC00000;
1843             w2 = (Elf32_Word)((S + A) >> 10);
1844             ASSERT((w2 & 0xFFC00000) == 0);
1845             w1 |= w2;
1846             *pP = w1;
1847             break;
1848          case R_SPARC_LO10:
1849             w1 = *pP & ~0x3FF;
1850             w2 = (Elf32_Word)((S + A) & 0x3FF);
1851             ASSERT((w2 & ~0x3FF) == 0);
1852             w1 |= w2;
1853             *pP = w1;
1854             break;
1855          case R_SPARC_32:
1856             w2 = (Elf32_Word)(S + A);
1857             *pP = w2;
1858             break;
1859 #        endif
1860          default: 
1861             fprintf(stderr, "unhandled ELF relocation(RelA) type %d\n",
1862                             ELF32_R_TYPE(info));
1863             barf("do_Elf32_Rela_relocations: unhandled ELF relocation type");
1864             return 0;
1865       }
1866
1867    }
1868    return 1;
1869 }
1870
1871
1872 static int
1873 ocResolve_ELF ( ObjectCode* oc )
1874 {
1875    char *strtab;
1876    int   shnum, ok;
1877    Elf32_Sym*  stab = NULL;
1878    char*       ehdrC = (char*)(oc->image);
1879    Elf32_Ehdr* ehdr = (Elf32_Ehdr*) ehdrC;
1880    Elf32_Shdr* shdr = (Elf32_Shdr*) (ehdrC + ehdr->e_shoff);
1881
1882    /* first find "the" symbol table */
1883    stab = (Elf32_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
1884
1885    /* also go find the string table */
1886    strtab = findElfSection ( ehdrC, SHT_STRTAB );
1887
1888    if (stab == NULL || strtab == NULL) {
1889       belch("ocResolve_ELF: can't find string or symbol table");
1890       return 0; 
1891    }
1892
1893    /* Process the relocation sections. */
1894    for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
1895       if (shdr[shnum].sh_type == SHT_REL ) {
1896          ok = do_Elf32_Rel_relocations ( oc, ehdrC, shdr, 
1897                                          shnum, stab, strtab );
1898          if (!ok) return ok;
1899       }
1900       else
1901       if (shdr[shnum].sh_type == SHT_RELA) {
1902          ok = do_Elf32_Rela_relocations ( oc, ehdrC, shdr, 
1903                                           shnum, stab, strtab );
1904          if (!ok) return ok;
1905       }
1906    }
1907
1908    /* Free the local symbol table; we won't need it again. */
1909    freeHashTable(oc->lochash, NULL);
1910    oc->lochash = NULL;
1911
1912    return 1;
1913 }
1914
1915
1916 #endif /* ELF */