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