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