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