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