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