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