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