ghc/rts/Linker.c

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