ghc/rts/Linker.c

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