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