ghc/rts/Linker.c

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