Linker.c 226 KB
Newer Older
1 2
/* -----------------------------------------------------------------------------
 *
Gabor Greif's avatar
typo  
Gabor Greif committed
3
 * (c) The GHC Team, 2000-2012
4 5 6 7 8
 *
 * RTS Object Linker
 *
 * ---------------------------------------------------------------------------*/

sof's avatar
sof committed
9
#if 0
10
#include "PosixSource.h"
sof's avatar
sof committed
11
#endif
12

13 14
#include "Rts.h"
#include "HsFFI.h"
Simon Marlow's avatar
Simon Marlow committed
15 16

#include "sm/Storage.h"
Simon Marlow's avatar
Simon Marlow committed
17
#include "Stats.h"
18
#include "Hash.h"
19
#include "LinkerInternals.h"
20
#include "RtsUtils.h"
21
#include "Trace.h"
Simon Marlow's avatar
Simon Marlow committed
22
#include "StgPrimFloat.h" // for __int_encodeFloat etc.
23
#include "Proftimer.h"
24
#include "GetEnv.h"
25
#include "Stable.h"
26
#include "RtsSymbols.h"
27
#include "RtsSymbolInfo.h"
28
#include "Profiling.h"
29 30
#include "sm/OSMem.h"
#include "linker/M32Alloc.h"
31
#include "linker/CacheFlush.h"
32
#include "linker/SymbolExtras.h"
33
#include "PathUtils.h"
Simon Marlow's avatar
Simon Marlow committed
34 35 36 37

#if !defined(mingw32_HOST_OS)
#include "posix/Signals.h"
#endif
38

Simon Marlow's avatar
Simon Marlow committed
39 40 41
// get protos for is*()
#include <ctype.h>

42
#ifdef HAVE_SYS_TYPES_H
43
#include <sys/types.h>
44 45
#endif

Ian Lynagh's avatar
Ian Lynagh committed
46
#include <inttypes.h>
47 48
#include <stdlib.h>
#include <string.h>
49 50
#include <stdio.h>
#include <assert.h>
51

52
#ifdef HAVE_SYS_STAT_H
53
#include <sys/stat.h>
54
#endif
55

56
#if defined(HAVE_DLFCN_H)
57
#include <dlfcn.h>
58
#endif
59

pcapriotti's avatar
pcapriotti committed
60
#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(kfreebsdgnu_HOST_OS) || defined(dragonfly_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(gnu_HOST_OS)
61
#  define OBJFORMAT_ELF
Ian Lynagh's avatar
Ian Lynagh committed
62 63
#  include <regex.h>    // regex is already used by dlopen() so this is OK
                        // to use here without requiring an additional lib
64
#elif defined (mingw32_HOST_OS)
65
#  define OBJFORMAT_PEi386
66
#  include <windows.h>
67
#  include <shfolder.h> /* SHGetFolderPathW */
sof's avatar
sof committed
68
#  include <math.h>
69
#  include <wchar.h>
70
#elif defined(darwin_HOST_OS)
71
#  define OBJFORMAT_MACHO
72
#  include <regex.h>
Ian Lynagh's avatar
Ian Lynagh committed
73 74
#  include <mach/machine.h>
#  include <mach-o/fat.h>
75 76 77
#  include <mach-o/loader.h>
#  include <mach-o/nlist.h>
#  include <mach-o/reloc.h>
78 79 80
#if defined(powerpc_HOST_ARCH)
#  include <mach-o/ppc/reloc.h>
#endif
81 82 83
#if defined(x86_64_HOST_ARCH)
#  include <mach-o/x86_64/reloc.h>
#endif
84 85
#endif

86 87 88 89
#if defined(x86_64_HOST_ARCH) && defined(darwin_HOST_OS)
#define ALWAYS_PIC
#endif

90 91 92 93
#if defined(dragonfly_HOST_OS)
#include <sys/tls.h>
#endif

94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
/* `symhash` is a Hash table mapping symbol names to RtsSymbolInfo.
   This hashtable will contain information on all symbols
   that we know of, however the .o they are in may not be loaded.

   Until the ObjectCode the symbol belongs to is actually
   loaded this symbol may be replaced. So do not rely on
   addresses of unloaded symbols.

   Note [runtime-linker-phases]
   --------------------------------------
   Broadly the behavior of the runtime linker can be
   split into the following four phases:

   - Indexing (e.g. ocVerifyImage and ocGetNames)
   - Initialization (e.g. ocResolve and ocRunInit)
   - Resolve (e.g. resolveObjs())
   - Lookup (e.g. lookupSymbol)

   This is to enable lazy loading of symbols. Eager loading is problematic
   as it means that all symbols must be available, even those which we will
   never use. This is especially painful of Windows, where the number of
   libraries required to link things like mingwex grows to be quite high.

   We proceed through these stages as follows,

   * During Indexing we verify and open the ObjectCode and
     perform a quick scan/indexing of the ObjectCode. All the work
     required to actually load the ObjectCode is done.

     All symbols from the ObjectCode is also inserted into
     `symhash`, where possible duplicates are handled via the semantics
     described in `ghciInsertSymbolTable`.

     This phase will produce ObjectCode with status `OBJECT_LOADED` or `OBJECT_NEEDED`
     depending on whether they are an archive members or not.

   * During initialization we load ObjectCode, perform relocations, execute
     static constructors etc. This phase may trigger other ObjectCodes to
     be loaded because of the calls to lookupSymbol.

     This phase will produce ObjectCode with status `OBJECT_NEEDED` if the
     previous status was `OBJECT_LOADED`.

   * During resolve we attempt to resolve all the symbols needed for the
     initial link. This essentially means, that for any ObjectCode given
     directly to the command-line we perform lookupSymbols on the required
     symbols. lookupSymbols may trigger the loading of additional ObjectCode
     if required.

     This phase will produce ObjectCode with status `OBJECT_RESOLVED` if
     the previous status was `OBJECT_NEEDED`.

   * Lookup symbols is used to lookup any symbols required, both during initial
     link and during statement and expression compilations in the REPL.
     Declaration of e.g. an foreign import, will eventually call lookupSymbol
     which will either fail (symbol unknown) or succeed (and possibly triggered a
     load).

     This phase may transition an ObjectCode from `OBJECT_LOADED` to `OBJECT_RESOLVED`

   When a new scope is introduced (e.g. a new module imported) GHCi does a full re-link
   by calling unloadObj and starting over.
   When a new declaration or statement is performed ultimately lookupSymbol is called
   without doing a re-link.

Tamar Christina's avatar
Tamar Christina committed
159 160 161 162 163 164 165 166 167 168
   The goal of these different phases is to allow the linker to be able to perform
   "lazy loading" of ObjectCode. The reason for this is that we want to only link
   in symbols that are actually required for the link. This reduces:

   1) Dependency chains, if A.o required a .o in libB but A.o isn't required to link
      then we don't need to load libB. This means the dependency chain for libraries
      such as mingw32 and mingwex can be broken down.

   2) The number of duplicate symbols, since now only symbols that are
      true duplicates will display the error.
169
 */
170
static /*Str*/HashTable *symhash;
171

172
/* List of currently loaded objects */
Ian Lynagh's avatar
Ian Lynagh committed
173
ObjectCode *objects = NULL;     /* initially empty */
174

175 176 177 178
/* List of objects that have been unloaded via unloadObj(), but are waiting
   to be actually freed via checkUnload() */
ObjectCode *unloaded_objects = NULL; /* initially empty */

179
#ifdef THREADED_RTS
180
/* This protects all the Linker's global state except unloaded_objects */
181
Mutex linker_mutex;
182 183 184 185
/*
 * This protects unloaded_objects.  We have a separate mutex for this, because
 * the GC needs to access unloaded_objects in checkUnload, while the linker only
 * needs to access unloaded_objects in unloadObj(), so this allows most linker
186
 * operations proceed concurrently with the GC.
187 188
 */
Mutex linker_unloaded_mutex;
189 190
#endif

191 192 193 194 195 196 197
static HsInt isAlreadyLoaded( pathchar *path );
static HsInt loadOc( ObjectCode* oc );
static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
                         rtsBool mapped, char *archiveMemberName,
                         int misalignment
                       );

198 199 200
/* Generic wrapper function to try and Resolve and RunInit oc files */
int ocTryLoad( ObjectCode* oc );

201
#if defined(OBJFORMAT_ELF)
202 203 204
static int ocVerifyImage_ELF    ( ObjectCode* oc );
static int ocGetNames_ELF       ( ObjectCode* oc );
static int ocResolve_ELF        ( ObjectCode* oc );
205
static int ocRunInit_ELF        ( ObjectCode* oc );
206
#if NEED_SYMBOL_EXTRAS
207
static int ocAllocateSymbolExtras_ELF ( ObjectCode* oc );
208
#endif
209
#elif defined(OBJFORMAT_PEi386)
210 211 212
static int ocVerifyImage_PEi386 ( ObjectCode* oc );
static int ocGetNames_PEi386    ( ObjectCode* oc );
static int ocResolve_PEi386     ( ObjectCode* oc );
213
static int ocRunInit_PEi386     ( ObjectCode* oc );
214
static void *lookupSymbolInDLLs ( unsigned char *lbl );
215 216 217 218
/* See Note [mingw-w64 name decoration scheme] */
#ifndef x86_64_HOST_ARCH
 static void zapTrailingAtSign   ( unsigned char *sym );
#endif
219 220

#if defined(x86_64_HOST_ARCH)
221
#define USED_IF_x86_64_HOST_ARCH    /* Nothing */
222
#else
223
#define USED_IF_x86_64_HOST_ARCH    STG_UNUSED
224 225
#endif

226
static char *allocateImageAndTrampolines (
Austin Seipp's avatar
Austin Seipp committed
227 228
   pathchar* arch_name, char* member_name,
   FILE* f,
229 230
   int size,
   int isThin);
231 232 233 234 235 236 237
#if defined(x86_64_HOST_ARCH)
static int ocAllocateSymbolExtras_PEi386 ( ObjectCode* oc );
static size_t makeSymbolExtra_PEi386( ObjectCode* oc, size_t, char* symbol );
#define PEi386_IMAGE_OFFSET 4
#else
#define PEi386_IMAGE_OFFSET 0
#endif
238 239 240 241
#elif defined(OBJFORMAT_MACHO)
static int ocVerifyImage_MachO    ( ObjectCode* oc );
static int ocGetNames_MachO       ( ObjectCode* oc );
static int ocResolve_MachO        ( ObjectCode* oc );
242
static int ocRunInit_MachO        ( ObjectCode* oc );
243
static int machoGetMisalignment( FILE * );
244
#if NEED_SYMBOL_EXTRAS
245 246
static int ocAllocateSymbolExtras_MachO ( ObjectCode* oc );
#endif
247
#ifdef powerpc_HOST_ARCH
248
static void machoInitSymbolsWithoutUnderscore( void );
249
#endif
250
#endif
251

252
#if defined(OBJFORMAT_PEi386)
253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
static int checkAndLoadImportLibrary(
    pathchar* arch_name,
    char* member_name,
    FILE* f);

static int findAndLoadImportLibrary(
    ObjectCode* oc
    );

static UChar *myindex(
    int scale,
    void* base,
    int index);
static UChar *cstring_from_COFF_symbol_name(
    UChar* name,
    UChar* strtab);
static char *cstring_from_section_name(
    UChar* name,
    UChar* strtab);

273 274 275 276 277 278 279 280 281 282 283

/* Add ld symbol for PE image base. */
#if defined(__GNUC__)
#define __ImageBase __MINGW_LSYMBOL(_image_base__)
#endif

/* Get the base of the module.       */
/* This symbol is defined by ld.     */
extern IMAGE_DOS_HEADER __ImageBase;
#define __image_base (void*)((HINSTANCE)&__ImageBase)

284
// MingW-w64 is missing these from the implementation. So we have to look them up
285 286
typedef DLL_DIRECTORY_COOKIE(WINAPI *LPAddDLLDirectory)(PCWSTR NewDirectory);
typedef WINBOOL(WINAPI *LPRemoveDLLDirectory)(DLL_DIRECTORY_COOKIE Cookie);
287
#endif /* OBJFORMAT_PEi386 */
288

289 290 291 292 293 294 295 296 297 298 299 300 301
/* on x86_64 we have a problem with relocating symbol references in
 * code that was compiled without -fPIC.  By default, the small memory
 * model is used, which assumes that symbol references can fit in a
 * 32-bit slot.  The system dynamic linker makes this work for
 * references to shared libraries by either (a) allocating a jump
 * table slot for code references, or (b) moving the symbol at load
 * time (and copying its contents, if necessary) for data references.
 *
 * We unfortunately can't tell whether symbol references are to code
 * or data.  So for now we assume they are code (the vast majority
 * are), and allocate jump-table slots.  Unfortunately this will
 * SILENTLY generate crashing code for data references.  This hack is
 * enabled by X86_64_ELF_NONPIC_HACK.
Ian Lynagh's avatar
Ian Lynagh committed
302
 *
303 304 305 306 307 308 309 310
 * One workaround is to use shared Haskell libraries.  This is
 * coming.  Another workaround is to keep the static libraries but
 * compile them with -fPIC, because that will generate PIC references
 * to data which can be relocated.  The PIC code is still too green to
 * do this systematically, though.
 *
 * See bug #781
 * See thread http://www.haskell.org/pipermail/cvs-ghc/2007-September/038458.html
311 312 313 314 315 316 317 318 319 320 321 322
 *
 * Naming Scheme for Symbol Macros
 *
 * SymI_*: symbol is internal to the RTS. It resides in an object
 *         file/library that is statically.
 * SymE_*: symbol is external to the RTS library. It might be linked
 *         dynamically.
 *
 * Sym*_HasProto  : the symbol prototype is imported in an include file
 *                  or defined explicitly
 * Sym*_NeedsProto: the symbol is undefined and we add a dummy
 *                  default proto extern void sym(void);
323 324
 */
#define X86_64_ELF_NONPIC_HACK 1
325

326 327 328 329 330 331 332 333 334 335 336 337
/* Link objects into the lower 2Gb on x86_64.  GHC assumes the
 * small memory model on this architecture (see gcc docs,
 * -mcmodel=small).
 *
 * MAP_32BIT not available on OpenBSD/amd64
 */
#if defined(x86_64_HOST_ARCH) && defined(MAP_32BIT)
#define TRY_MAP_32BIT MAP_32BIT
#else
#define TRY_MAP_32BIT 0
#endif

Ben Gamari's avatar
Ben Gamari committed
338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361
/*
  Note [The ARM/Thumb Story]
  ~~~~~~~~~~~~~~~~~~~~~~~~~~

  Support for the ARM architecture is complicated by the fact that ARM has not
  one but several instruction encodings. The two relevant ones here are the original
  ARM encoding and Thumb, a more dense variant of ARM supporting only a subset
  of the instruction set.

  How the CPU decodes a particular instruction is determined by a mode bit. This
  mode bit is set on jump instructions, the value being determined by the low
  bit of the target address: An odd address means the target is a procedure
  encoded in the Thumb encoding whereas an even address means it's a traditional
  ARM procedure (the actual address jumped to is even regardless of the encoding bit).

  Interoperation between Thumb- and ARM-encoded object code (known as "interworking")
  is tricky. If the linker needs to link a call by an ARM object into Thumb code
  (or vice-versa) it will produce a jump island. This, however, is incompatible with
  GHC's tables-next-to-code. For this reason, it is critical that GHC emit
  exclusively ARM or Thumb objects for all Haskell code.

  We still do, however, need to worry about foreign code.
*/

362 363 364 365 366 367 368 369 370 371 372 373 374 375
/*
 * Due to the small memory model (see above), on x86_64 we have to map
 * all our non-PIC object files into the low 2Gb of the address space
 * (why 2Gb and not 4Gb?  Because all addresses must be reachable
 * using a 32-bit signed PC-relative offset). On Linux we can do this
 * using the MAP_32BIT flag to mmap(), however on other OSs
 * (e.g. *BSD, see #2063, and also on Linux inside Xen, see #2512), we
 * can't do this.  So on these systems, we have to pick a base address
 * in the low 2Gb of the address space and try to allocate memory from
 * there.
 *
 * We pick a default address based on the OS, but also make this
 * configurable via an RTS flag (+RTS -xm)
 */
376
#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
377 378 379 380 381 382 383 384 385

#if defined(MAP_32BIT)
// Try to use MAP_32BIT
#define MMAP_32BIT_BASE_DEFAULT 0
#else
// A guess: 1Gb.
#define MMAP_32BIT_BASE_DEFAULT 0x40000000
#endif

Ian Lynagh's avatar
Ian Lynagh committed
386
static void *mmap_32bit_base = (void *)MMAP_32BIT_BASE_DEFAULT;
387 388
#endif

389
static void ghciRemoveSymbolTable(HashTable *table, const SymbolName* key,
390 391 392 393 394 395 396 397
    ObjectCode *owner)
{
    RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
    if (!pinfo || owner != pinfo->owner) return;
    removeStrHashTable(table, key, NULL);
    stgFree(pinfo);
}

398 399
/* -----------------------------------------------------------------------------
 * Insert symbols into hash tables, checking for duplicates.
400 401
 *
 * Returns: 0 on failure, nonzero on success
402
 */
403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418
/*
 Note [weak-symbols-support]
 -------------------------------------
 While ghciInsertSymbolTable does implement extensive
 logic for weak symbol support, weak symbols are not currently
 fully supported by the RTS. This code is mostly here for COMDAT
 support which uses the weak symbols support.

 Linking weak symbols defined purely in C code with other C code
 should also work, probably. Observing weak symbols in Haskell
 won't.

 Some test have been written for weak symbols but have been disabled
 mostly because it's unsure how the weak symbols support should look.
 See Trac #11223
 */
419
static int ghciInsertSymbolTable(
420 421
   pathchar* obj_name,
   HashTable *table,
422 423
   const SymbolName* key,
   SymbolAddr* data,
424 425
   HsBool weak,
   ObjectCode *owner)
426
{
427 428 429 430 431 432 433 434
   RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
   if (!pinfo) /* new entry */
   {
      pinfo = stgMallocBytes(sizeof (*pinfo), "ghciInsertToSymbolTable");
      pinfo->value = data;
      pinfo->owner = owner;
      pinfo->weak = weak;
      insertStrHashTable(table, key, pinfo);
435 436
      return 1;
   }
437
   else if (weak && data && pinfo->weak && !pinfo->value)
438
   {
439 440 441 442 443 444 445 446 447 448 449 450 451 452
       /* The existing symbol is weak with a zero value; replace it with the new symbol. */
       pinfo->value = data;
       pinfo->owner = owner;
       return 1;
   }
   else if (weak)
   {
       return 1; /* weak symbol, because the symbol is weak, data = 0 and we
                 already know of another copy throw this one away.

                 or both weak symbols have a nonzero value. Keep the existing one.

                 This also preserves the semantics of linking against
                 the first symbol we find. */
453
   }
454
   else if (pinfo->weak && !weak) /* weak symbol is in the table */
Simon Marlow's avatar
Simon Marlow committed
455
   {
456 457 458 459
      /* override the weak definition with the non-weak one */
      pinfo->value = data;
      pinfo->owner = owner;
      pinfo->weak = HS_BOOL_FALSE;
460
      return 1;
Simon Marlow's avatar
Simon Marlow committed
461
   }
462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497
   else if (  pinfo->owner
           && pinfo->owner->status != OBJECT_RESOLVED
           && pinfo->owner->status != OBJECT_NEEDED)
   {
        /* If the other symbol hasn't been loaded or will be loaded and we want to
           explicitly load the new one, we can just swap it out and load the one
           that has been requested. If not, just keep the first one encountered.

           Because the `symHash' table consists symbols we've also not loaded but
           found during the initial scan this is safe to do. If however the existing
           symbol has been loaded then it means we have a duplicate.

           This is essentially emulating the behavior of a linker wherein it will always
           link in object files that are .o file arguments, but only take object files
           from archives as needed. */
       if (owner && (owner->status == OBJECT_NEEDED || owner->status == OBJECT_RESOLVED)) {
           pinfo->value = data;
           pinfo->owner = owner;
           pinfo->weak  = weak;
       }

       return 1;
    }
    else if (pinfo->owner == owner)
    {
       /* If it's the same symbol, ignore. This makes ghciInsertSymbolTable idempotent */
       return 1;
    }
    else if (owner && owner->status == OBJECT_LOADED)
    {
        /* If the duplicate symbol is just in state OBJECT_LOADED it means we're in discovery of an
           member. It's not a real duplicate yet. If the Oc Becomes OBJECT_NEEDED then ocTryLoad will
           call this function again to trigger the duplicate error. */
        return 1;
    }

498
   pathchar* archiveName = NULL;
Simon Marlow's avatar
Simon Marlow committed
499
   debugBelch(
500
      "GHC runtime linker: fatal error: I found a duplicate definition for symbol\n"
501 502
      "   %s\n"
      "whilst processing object file\n"
503
      "   %" PATH_FMT "\n"
504 505
      "The symbol was previously defined in\n"
      "   %" PATH_FMT "\n"
506 507 508 509
      "This could be caused by:\n"
      "   * Loading two different object files which export the same symbol\n"
      "   * Specifying the same object file twice on the GHCi command line\n"
      "   * An incorrect `package.conf' entry, causing some object to be\n"
510
      "     loaded twice.\n",
511
      (char*)key,
512
      obj_name,
513 514
      pinfo->owner == NULL ? WSTR("(GHCi built-in symbols)") :
      pinfo->owner->archiveMemberName ? archiveName = mkPath(pinfo->owner->archiveMemberName)
515
      : pinfo->owner->fileName
Simon Marlow's avatar
Simon Marlow committed
516
   );
517 518 519 520 521 522

   if (archiveName)
   {
       stgFree(archiveName);
       archiveName = NULL;
   }
523
   return 0;
524
}
525

526 527 528 529 530 531 532
/* -----------------------------------------------------------------------------
* Looks up symbols into hash tables.
*
* Returns: 0 on failure and result is not set,
*          nonzero on success and result set to nonzero pointer
*/
static HsBool ghciLookupSymbolInfo(HashTable *table,
533
    const SymbolName* key, RtsSymbolInfo **result)
534 535 536 537 538 539 540
{
    RtsSymbolInfo *pinfo = lookupStrHashTable(table, key);
    if (!pinfo) {
        *result = NULL;
        return HS_BOOL_FALSE;
    }
    if (pinfo->weak)
541
        IF_DEBUG(linker, debugBelch("lookupSymbolInfo: promoting %s\n", key));
542 543 544
    /* Once it's looked up, it can no longer be overridden */
    pinfo->weak = HS_BOOL_FALSE;

545
    *result = pinfo;
546 547 548
    return HS_BOOL_TRUE;
}

549 550 551
/* -----------------------------------------------------------------------------
 * initialize the object linker
 */
552 553 554 555


static int linker_init_done = 0 ;

556
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
557
static void *dl_prog_handle;
558 559 560 561 562
static regex_t re_invalid;
static regex_t re_realso;
#ifdef THREADED_RTS
static Mutex dl_mutex; // mutex to protect dlopen/dlerror critical section
#endif
563 564
#elif defined(OBJFORMAT_PEi386)
void addDLLHandle(pathchar* dll_name, HINSTANCE instance);
565
#endif
566

567 568 569 570
void initLinker (void)
{
    // default to retaining CAFs for backwards compatibility.  Most
    // users will want initLinker_(0): otherwise unloadObj() will not
Gabor Greif's avatar
Gabor Greif committed
571
    // be able to unload object files when they contain CAFs.
572 573 574
    initLinker_(1);
}

575
void
576
initLinker_ (int retain_cafs)
577
{
578
    RtsSymbolVal *sym;
Simon Marlow's avatar
Simon Marlow committed
579
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
580
    int compileResult;
Simon Marlow's avatar
Simon Marlow committed
581
#endif
582

583 584
    IF_DEBUG(linker, debugBelch("initLinker: start\n"));

585
    /* Make initLinker idempotent, so we can call it
Gabor Greif's avatar
typo  
Gabor Greif committed
586
       before every relevant operation; that means we
587
       don't need to initialise the linker separately */
Ian Lynagh's avatar
Ian Lynagh committed
588 589 590
    if (linker_init_done == 1) {
        IF_DEBUG(linker, debugBelch("initLinker: idempotent return\n"));
        return;
591 592
    } else {
        linker_init_done = 1;
593 594
    }

595 596 597
    objects = NULL;
    unloaded_objects = NULL;

598 599
#if defined(THREADED_RTS)
    initMutex(&linker_mutex);
600
    initMutex(&linker_unloaded_mutex);
601
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
602
    initMutex(&dl_mutex);
603
#endif
604
#endif
605

606 607 608 609
    symhash = allocStrHashTable();

    /* populate the symbol table with stuff from the RTS */
    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
610 611 612 613
        if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"),
                                    symhash, sym->lbl, sym->addr, HS_BOOL_FALSE, NULL)) {
            barf("ghciInsertSymbolTable failed");
        }
Ian Lynagh's avatar
Ian Lynagh committed
614
        IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
615
    }
616
#   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
617 618
    machoInitSymbolsWithoutUnderscore();
#   endif
619 620 621 622 623
    /* GCC defines a special symbol __dso_handle which is resolved to NULL if
       referenced from a statically linked module. We need to mimic this, but
       we cannot use NULL because we use it to mean nonexistent symbols. So we
       use an arbitrary (hopefully unique) address here.
    */
624 625 626 627
    if (! ghciInsertSymbolTable(WSTR("(GHCi special symbols)"),
                                symhash, "__dso_handle", (void *)0x12345687, HS_BOOL_FALSE, NULL)) {
        barf("ghciInsertSymbolTable failed");
    }
628

629 630 631 632 633 634 635 636
#if defined(OBJFORMAT_PEi386)
    if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"),
                               symhash, "__image_base__", __image_base, HS_BOOL_TRUE, NULL)) {
        barf("ghciInsertSymbolTable failed");
    }
#endif /* OBJFORMAT_PEi386 */


Gabor Greif's avatar
Gabor Greif committed
637
    // Redirect newCAF to newRetainedCAF if retain_cafs is true.
638 639
    if (! ghciInsertSymbolTable(WSTR("(GHCi built-in symbols)"), symhash,
                                MAYBE_LEADING_UNDERSCORE_STR("newCAF"),
640
                                retain_cafs ? newRetainedCAF : newGCdCAF,
641 642 643
                                HS_BOOL_FALSE, NULL)) {
        barf("ghciInsertSymbolTable failed");
    }
644

645
#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
646
#   if defined(RTLD_DEFAULT)
647 648
    dl_prog_handle = RTLD_DEFAULT;
#   else
649
    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
650
#   endif /* RTLD_DEFAULT */
651 652

    compileResult = regcomp(&re_invalid,
653
           "(([^ \t()])+\\.so([^ \t:()])*):([ \t])*(invalid ELF header|file too short)",
654
           REG_EXTENDED);
Ian Lynagh's avatar
Ian Lynagh committed
655 656 657
    if (compileResult != 0) {
        barf("Compiling re_invalid failed");
    }
658
    compileResult = regcomp(&re_realso,
659
           "(GROUP|INPUT) *\\( *([^ )]+)",
660
           REG_EXTENDED);
Ian Lynagh's avatar
Ian Lynagh committed
661 662 663
    if (compileResult != 0) {
        barf("Compiling re_realso failed");
    }
664
#   endif
665

666
#if !defined(ALWAYS_PIC) && defined(x86_64_HOST_ARCH)
667 668 669 670 671
    if (RtsFlags.MiscFlags.linkerMemBase != 0) {
        // User-override for mmap_32bit_base
        mmap_32bit_base = (void*)RtsFlags.MiscFlags.linkerMemBase;
    }
#endif
672 673 674 675 676 677 678

#if defined(mingw32_HOST_OS)
    /*
     * These two libraries cause problems when added to the static link,
     * but are necessary for resolving symbols in GHCi, hence we load
     * them manually here.
     */
679 680
    addDLL(WSTR("msvcrt"));
    addDLL(WSTR("kernel32"));
681
    addDLLHandle(WSTR("*.exe"), GetModuleHandle(NULL));
682
#endif
683

684 685
    if (RTS_LINKER_USE_MMAP)
        m32_allocator_init();
686

687 688
    IF_DEBUG(linker, debugBelch("initLinker: done\n"));
    return;
689 690
}

691 692 693 694 695 696 697 698 699 700 701
void
exitLinker( void ) {
#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
   if (linker_init_done == 1) {
      regfree(&re_invalid);
      regfree(&re_realso);
#ifdef THREADED_RTS
      closeMutex(&dl_mutex);
#endif
   }
#endif
702 703 704
   if (linker_init_done == 1) {
       freeHashTable(symhash, free);
   }
705 706 707
#ifdef THREADED_RTS
   closeMutex(&linker_mutex);
#endif
708 709
}

710
/* -----------------------------------------------------------------------------
711 712 713
 *                  Loading DLL or .so dynamic libraries
 * -----------------------------------------------------------------------------
 *
714 715 716 717
 * Add a DLL from which symbols may be found.  In the ELF case, just
 * do RTLD_GLOBAL-style add, so no further messing around needs to
 * happen in order that symbols in the loaded .so are findable --
 * lookupSymbol() will subsequently see them by dlsym on the program's
718 719
 * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
 *
720
 * In the PEi386 case, open the DLLs and put handles to them in a
721
 * linked list.  When looking for a symbol, try all handles in the
722 723 724 725 726
 * list.  This means that we need to load even DLLs that are guaranteed
 * to be in the ghc.exe image already, just so we can get a handle
 * to give to loadSymbol, so that we can find the symbols.  For such
 * libraries, the LoadLibrary call should be a no-op except for returning
 * the handle.
727
 *
728
 */
729 730 731 732 733 734

#if defined(OBJFORMAT_PEi386)
/* A record for storing handles into DLLs. */

typedef
   struct _OpenedDLL {
735
      pathchar*          name;
736 737
      struct _OpenedDLL* next;
      HINSTANCE instance;
738
   }
739 740 741 742
   OpenedDLL;

/* A list thereof. */
static OpenedDLL* opened_dlls = NULL;
743 744 745 746

/* A record for storing indirectly linked functions from DLLs. */
typedef
   struct _IndirectAddr {
747
      SymbolAddr*           addr;
748 749 750 751 752 753 754
      struct _IndirectAddr* next;
   }
   IndirectAddr;

/* A list thereof. */
static IndirectAddr* indirects = NULL;

755 756 757 758 759 760 761 762 763 764
/* Adds a DLL instance to the list of DLLs in which to search for symbols. */
void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
   OpenedDLL* o_dll;
   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLLHandle" );
   o_dll->name     = dll_name ? pathdup(dll_name) : NULL;
   o_dll->instance = instance;
   o_dll->next     = opened_dlls;
   opened_dlls     = o_dll;
}

765 766
#endif

767
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
768

769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790
/* Suppose in ghci we load a temporary SO for a module containing
       f = 1
   and then modify the module, recompile, and load another temporary
   SO with
       f = 2
   Then as we don't unload the first SO, dlsym will find the
       f = 1
   symbol whereas we want the
       f = 2
   symbol. We therefore need to keep our own SO handle list, and
   try SOs in the right order. */

typedef
   struct _OpenedSO {
      struct _OpenedSO* next;
      void *handle;
   }
   OpenedSO;

/* A list thereof. */
static OpenedSO* openedSOs = NULL;

791
static const char *
792 793
internal_dlopen(const char *dll_name)
{
794
   OpenedSO* o_so;
795
   void *hdl;
796 797
   const char *errmsg;
   char *errmsg_copy;
798

799 800
   // omitted: RTLD_NOW
   // see http://www.haskell.org/pipermail/cvs-ghc/2007-September/038570.html
801 802 803 804 805 806 807 808 809 810
   IF_DEBUG(linker,
      debugBelch("internal_dlopen: dll_name = '%s'\n", dll_name));

   //-------------- Begin critical section ------------------
   // This critical section is necessary because dlerror() is not
   // required to be reentrant (see POSIX -- IEEE Std 1003.1-2008)
   // Also, the error message returned must be copied to preserve it
   // (see POSIX also)

   ACQUIRE_LOCK(&dl_mutex);
811
   hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
dons's avatar
dons committed
812

813
   errmsg = NULL;
814 815 816 817
   if (hdl == NULL) {
      /* dlopen failed; return a ptr to the error msg. */
      errmsg = dlerror();
      if (errmsg == NULL) errmsg = "addDLL: unknown error";
818 819 820
      errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
      strcpy(errmsg_copy, errmsg);
      errmsg = errmsg_copy;
821 822 823 824 825
   } else {
      o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
      o_so->handle = hdl;
      o_so->next   = openedSOs;
      openedSOs    = o_so;
826
   }
827

828 829 830 831 832
   RELEASE_LOCK(&dl_mutex);
   //--------------- End critical section -------------------

   return errmsg;
}
833

834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851
/*
  Note [RTLD_LOCAL]

  In GHCi we want to be able to override previous .so's with newly
  loaded .so's when we recompile something.  This further implies that
  when we look up a symbol in internal_dlsym() we have to iterate
  through the loaded libraries (in order from most recently loaded to
  oldest) looking up the symbol in each one until we find it.

  However, this can cause problems for some symbols that are copied
  by the linker into the executable image at runtime - see #8935 for a
  lengthy discussion.  To solve that problem we need to look up
  symbols in the main executable *first*, before attempting to look
  them up in the loaded .so's.  But in order to make that work, we
  have to always call dlopen with RTLD_LOCAL, so that the loaded
  libraries don't populate the global symbol table.
*/

852
static void *
853
internal_dlsym(const char *symbol) {
854 855 856 857 858 859
    OpenedSO* o_so;
    void *v;

    // We acquire dl_mutex as concurrent dl* calls may alter dlerror
    ACQUIRE_LOCK(&dl_mutex);
    dlerror();
860 861 862 863 864 865 866
    // look in program first
    v = dlsym(dl_prog_handle, symbol);
    if (dlerror() == NULL) {
        RELEASE_LOCK(&dl_mutex);
        return v;
    }

867 868 869 870 871 872 873 874 875 876
    for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) {
        v = dlsym(o_so->handle, symbol);
        if (dlerror() == NULL) {
            RELEASE_LOCK(&dl_mutex);
            return v;
        }
    }
    RELEASE_LOCK(&dl_mutex);
    return v;
}
877 878 879
#  endif

const char *
880
addDLL( pathchar *dll_name )
881 882 883 884 885 886
{
#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
   /* ------------------- ELF DLL loader ------------------- */

#define NMATCH 5
   regmatch_t match[NMATCH];
887
   const char *errmsg;
888 889 890 891 892 893 894 895 896 897
   FILE* fp;
   size_t match_length;
#define MAXLINE 1000
   char line[MAXLINE];
   int result;

   IF_DEBUG(linker, debugBelch("addDLL: dll_name = '%s'\n", dll_name));
   errmsg = internal_dlopen(dll_name);

   if (errmsg == NULL) {
898 899
      return NULL;
   }
900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921

   // GHC Trac ticket #2615
   // On some systems (e.g., Gentoo Linux) dynamic files (e.g. libc.so)
   // contain linker scripts rather than ELF-format object code. This
   // code handles the situation by recognizing the real object code
   // file name given in the linker script.
   //
   // If an "invalid ELF header" error occurs, it is assumed that the
   // .so file contains a linker script instead of ELF object code.
   // In this case, the code looks for the GROUP ( ... ) linker
   // directive. If one is found, the first file name inside the
   // parentheses is treated as the name of a dynamic library and the
   // code attempts to dlopen that file. If this is also unsuccessful,
   // an error message is returned.

   // see if the error message is due to an invalid ELF header
   IF_DEBUG(linker, debugBelch("errmsg = '%s'\n", errmsg));
   result = regexec(&re_invalid, errmsg, (size_t) NMATCH, match, 0);
   IF_DEBUG(linker, debugBelch("result = %i\n", result));
   if (result == 0) {
      // success -- try to read the named file as a linker script
      match_length = (size_t) stg_min((match[1].rm_eo - match[1].rm_so),
Ian Lynagh's avatar
Ian Lynagh committed
922
                                 MAXLINE-1);
923 924 925 926
      strncpy(line, (errmsg+(match[1].rm_so)),match_length);
      line[match_length] = '\0'; // make sure string is null-terminated
      IF_DEBUG(linker, debugBelch ("file name = '%s'\n", line));
      if ((fp = fopen(line, "r")) == NULL) {
Ian Lynagh's avatar
Ian Lynagh committed
927
         return errmsg; // return original error if open fails
928
      }
929
      // try to find a GROUP or INPUT ( ... ) command
930
      while (fgets(line, MAXLINE, fp) != NULL) {
Ian Lynagh's avatar
Ian Lynagh committed
931 932
         IF_DEBUG(linker, debugBelch("input line = %s", line));
         if (regexec(&re_realso, line, (size_t) NMATCH, match, 0) == 0) {
933 934
            // success -- try to dlopen the first named file
            IF_DEBUG(linker, debugBelch("match%s\n",""));
935
            line[match[2].rm_eo] = '\0';
936
            stgFree((void*)errmsg); // Free old message before creating new one
937
            errmsg = internal_dlopen(line+match[2].rm_so);
Ian Lynagh's avatar
Ian Lynagh committed
938 939
            break;
         }
940 941 942
         // if control reaches here, no GROUP or INPUT ( ... ) directive
         // was found and the original error message is returned to the
         // caller
943 944 945 946
      }
      fclose(fp);
   }
   return errmsg;
947

948
#  elif defined(OBJFORMAT_PEi386)
949
   /* ------------------- Win32 DLL loader ------------------- */
950

951
   pathchar*      buf;
952
   OpenedDLL* o_dll;
953
   HINSTANCE  instance;
954

955
   IF_DEBUG(linker, debugBelch("\naddDLL; dll_name = `%" PATH_FMT "'\n", dll_name));
956 957 958

   /* See if we've already got it, and ignore if so. */
   for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
959
      if (0 == pathcmp(o_dll->name, dll_name))
960
         return NULL;
961 962
   }

963 964 965 966
   /* The file name has no suffix (yet) so that we can try
      both foo.dll and foo.drv

      The documentation for LoadLibrary says:
Ian Lynagh's avatar
Ian Lynagh committed
967 968 969 970 971
        If no file name extension is specified in the lpFileName
        parameter, the default library extension .dll is
        appended. However, the file name string can include a trailing
        point character (.) to indicate that the module name has no
        extension. */
972

973 974
   size_t bufsize = pathlen(dll_name) + 10;
   buf = stgMallocBytes(bufsize * sizeof(wchar_t), "addDLL");
975 976

   /* These are ordered by probability of success and order we'd like them */
977
   const wchar_t *formats[] = { L"%ls.DLL", L"%ls.DRV", L"lib%ls.DLL", L"%ls" };
978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005
   const DWORD flags[]      = { LOAD_LIBRARY_SEARCH_USER_DIRS | LOAD_LIBRARY_SEARCH_DEFAULT_DIRS, 0 };

   int cFormat;
   int cFlag;
   int flags_start = 1; // Assume we don't support the new API

   /* Detect if newer API are available, if not, skip the first flags entry */
   if (GetProcAddress((HMODULE)LoadLibraryW(L"Kernel32.DLL"), "AddDllDirectory")) {
       flags_start = 0;
   }

   /* Iterate through the possible flags and formats */
   for (cFlag = flags_start; cFlag < 2; cFlag++)
   {
       for (cFormat = 0; cFormat < 4; cFormat++)
       {
           snwprintf(buf, bufsize, formats[cFormat], dll_name);
           instance = LoadLibraryExW(buf, NULL, flags[cFlag]);
           if (instance == NULL)
           {
               if (GetLastError() != ERROR_MOD_NOT_FOUND)
               {
                   goto error;
               }
           }
           else
           {
               break; // We're done. DLL has been loaded.
1006 1007
           }
       }
1008
   }
1009 1010 1011 1012 1013 1014

   // Check if we managed to load the DLL
   if (instance == NULL) {
       goto error;
   }

sof's avatar
sof committed
1015
   stgFree(buf);
1016

1017
   addDLLHandle(dll_name, instance);
1018 1019

   return NULL;
1020 1021 1022

error:
   stgFree(buf);
1023
   sysErrorBelch("addDLL: %" PATH_FMT " (Win32 error %lu)", dll_name, GetLastError());
Simon Marlow's avatar
Simon Marlow committed
1024

1025 1026
   /* LoadLibrary failed; return a ptr to the error msg. */
   return "addDLL: could not load DLL";
Simon Marlow's avatar
Simon Marlow committed
1027 1028 1029 1030

#  else
   barf("addDLL: not implemented on this platform");
#  endif
1031 1032
}

1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067
/* -----------------------------------------------------------------------------
* Searches the system directories to determine if there is a system DLL that
* satisfies the given name. This prevent GHCi from linking against a static
* library if a DLL is available.
*
* Returns: NULL on failure or no DLL found, else the full path to the DLL
*          that can be loaded.
*/
pathchar* findSystemLibrary(pathchar* dll_name)
{
    IF_DEBUG(linker, debugBelch("\nfindSystemLibrary: dll_name = `%" PATH_FMT "'\n", dll_name));

#if defined(OBJFORMAT_PEi386)
    const unsigned int init_buf_size = 1024;
    unsigned int bufsize     = init_buf_size;
    wchar_t* result = malloc(sizeof(wchar_t) * bufsize);
    DWORD wResult   = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL);

    if (wResult > bufsize) {
        result  = realloc(result, sizeof(wchar_t) * wResult);
        wResult = SearchPathW(NULL, dll_name, NULL, wResult, result, NULL);
    }


    if (!wResult) {
        free(result);
        return NULL;
    }

    return result;
#else
    (void)(dll_name); // Function not implemented for other platforms.
    return NULL;
#endif
}
1068 1069