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