#include "PosixSource.h"
#endif
-// Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h>.
+/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and
+ MREMAP_MAYMOVE from <sys/mman.h>.
+ */
#ifdef __linux__
#define _GNU_SOURCE
#endif
#include <sys/stat.h>
#endif
-#if defined(HAVE_FRAMEWORK_HASKELLSUPPORT)
-#include <HaskellSupport/dlfcn.h>
-#elif defined(HAVE_DLFCN_H)
+#if defined(HAVE_DLFCN_H)
#include <dlfcn.h>
#endif
#include <sys/wait.h>
#endif
-#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
+#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
#define USE_MMAP
#include <fcntl.h>
#include <sys/mman.h>
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
+#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
SymX(log) \
SymX(sqrt) \
SymX(memcpy) \
- SymX(stg_InstallConsoleEvent) \
+ SymX(rts_InstallConsoleEvent) \
+ SymX(rts_ConsoleHandlerDone) \
Sym(mktime) \
Sym(_imp___timezone) \
Sym(_imp___tzname) \
Sym(_imp___iob) \
+ Sym(_imp___osver) \
Sym(localtime) \
Sym(gmtime) \
Sym(opendir) \
# define MAIN_CAP_SYM
#endif
+#if !defined(mingw32_HOST_OS)
+#define RTS_USER_SIGNALS_SYMBOLS \
+ SymX(startSignalHandler) \
+ SymX(setIOManagerPipe)
+#else
+#define RTS_USER_SIGNALS_SYMBOLS /* nothing */
+#endif
+
#ifdef TABLES_NEXT_TO_CODE
#define RTS_RET_SYMBOLS /* nothing */
#else
SymX(genericRaise) \
SymX(getProgArgv) \
SymX(getStablePtr) \
- SymX(initLinker) \
+ SymX(hs_init) \
+ SymX(hs_exit) \
+ SymX(hs_set_argv) \
+ SymX(hs_add_root) \
+ SymX(hs_perform_gc) \
+ SymX(hs_free_stable_ptr) \
+ SymX(hs_free_fun_ptr) \
+ SymX(initLinker) \
SymX(int2Integerzh_fast) \
SymX(integer2Intzh_fast) \
SymX(integer2Wordzh_fast) \
SymX(stable_ptr_table) \
SymX(stackOverflow) \
SymX(stg_CAF_BLACKHOLE_info) \
- SymX(stg_BLACKHOLE_BQ_info) \
SymX(awakenBlockedQueue) \
SymX(stg_CHARLIKE_closure) \
SymX(stg_EMPTY_MVAR_info) \
SymX(stg_IND_STATIC_info) \
SymX(stg_INTLIKE_closure) \
SymX(stg_MUT_ARR_PTRS_FROZEN_info) \
+ SymX(stg_MUT_ARR_PTRS_FROZEN0_info) \
SymX(stg_WEAK_info) \
SymX(stg_ap_0_info) \
SymX(stg_ap_v_info) \
SymX(word2Integerzh_fast) \
SymX(writeTVarzh_fast) \
SymX(xorIntegerzh_fast) \
- SymX(yieldzh_fast)
+ SymX(yieldzh_fast) \
+ RTS_USER_SIGNALS_SYMBOLS
#ifdef SUPPORT_LONG_LONGS
#define RTS_LONG_LONG_SYMS \
# if defined(openbsd_HOST_OS)
dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
# endif
-# endif // RTLD_DEFAULT
+# endif /* RTLD_DEFAULT */
# endif
}
#endif
n = ROUND_UP(oc->fileSize, pagesize);
- oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
+
+ /* Link objects into the lower 2Gb on x86_64. GHC assumes the
+ * small memory model on this architecture (see gcc docs,
+ * -mcmodel=small).
+ */
+#ifdef x86_64_HOST_ARCH
+#define EXTRA_MAP_FLAGS MAP_32BIT
+#else
+#define EXTRA_MAP_FLAGS 0
+#endif
+
+ oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE,
+ MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
if (oc->image == MAP_FAILED)
barf("loadObj: can't map `%s'", path);
static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
{
+#ifdef USE_MMAP
+ int pagesize, n, m;
+#endif
int aligned;
if( count > 0 )
{
-#ifdef USE_MMAP
- #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
-#endif
// round up to the nearest 4
aligned = (oc->fileSize + 3) & ~3;
+#ifdef USE_MMAP
+ #ifndef linux_HOST_OS /* mremap is a linux extension */
+ #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
+ #endif
+
+ pagesize = getpagesize();
+ n = ROUND_UP( oc->fileSize, pagesize );
+ m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
+
+ /* The effect of this mremap() call is only the ensure that we have
+ * a sufficient number of virtually contiguous pages. As returned from
+ * mremap, the pages past the end of the file are not backed. We give
+ * them a backing by using MAP_FIXED to map in anonymous pages.
+ */
+ if( (oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE )) == MAP_FAILED )
+ {
+ errorBelch( "Unable to mremap for Jump Islands\n" );
+ return 0;
+ }
+
+ if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
+ MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
+ {
+ errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
+ return 0;
+ }
+
+#else
oc->image = stgReallocBytes( oc->image,
- aligned + sizeof( ppcJumpIsland ) * count,
+ aligned + sizeof (ppcJumpIsland) * count,
"ocAllocateJumpIslands" );
- oc->jump_islands = (ppcJumpIsland *) (((char *) oc->image) + aligned);
- memset( oc->jump_islands, 0, sizeof( ppcJumpIsland ) * count );
+#endif /* USE_MMAP */
+
+ oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
+ memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
}
else
oc->jump_islands = NULL;
# endif
if (0==strcmp(".text",sectab_i->Name) ||
+ 0==strcmp(".rdata",sectab_i->Name)||
0==strcmp(".rodata",sectab_i->Name))
kind = SECTIONKIND_CODE_OR_RODATA;
if (0==strcmp(".data",sectab_i->Name) ||
&& 0 != strcmp(".stab", sectab_i->Name)
&& 0 != strcmp(".stabstr", sectab_i->Name)
) {
- errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
+ errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
return 0;
}
/* Newline first because the interactive linker has printed "linking..." */
errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
- foundit:
+ foundit:;
}
checkProddableBlock(oc, pP);
switch (reltab_j->Type) {
case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
#endif
case EM_PPC: IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
+#ifdef EM_X86_64
+ case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
+#endif
default: IF_DEBUG(linker,debugBelch( "unknown" ));
errorBelch("%s: unknown architecture", oc->fileName);
return 0;
target_shndx, symtab_shndx ));
for (j = 0; j < nent; j++) {
-#if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH)
+#if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
/* This #ifdef only serves to avoid unused-var warnings. */
Elf_Addr offset = rtab[j].r_offset;
Elf_Addr P = targ + offset;
| (delta & 0x3fffffc);
break;
# endif
+
+#if x86_64_HOST_OS
+ case R_X86_64_64:
+ *(Elf64_Xword *)P = value;
+ break;
+
+ case R_X86_64_PC32:
+ *(Elf64_Word *)P = (Elf64_Word) (value - P);
+ break;
+
+ case R_X86_64_32:
+ *(Elf64_Word *)P = (Elf64_Word)value;
+ break;
+
+ case R_X86_64_32S:
+ *(Elf64_Sword *)P = (Elf64_Sword)value;
+ break;
+#endif
+
default:
errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
oc->fileName, ELF_R_TYPE(info));
// symbol, so we don't have to allocate too many
// jump islands.
struct symtab_command *symLC = (struct symtab_command *) lc;
- int min = symLC->nsyms, max = 0;
+ unsigned min = symLC->nsyms, max = 0;
struct nlist *nlist =
symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
: NULL;
return ocAllocateJumpIslands(oc,0,0);
}
-static int ocVerifyImage_MachO(ObjectCode* oc)
+static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
{
// FIXME: do some verifying here
return 1;
return 1;
}
-static char* relocateAddress(
+static unsigned long relocateAddress(
ObjectCode* oc,
int nSections,
struct section* sections,
if(sections[i].addr <= address
&& address < sections[i].addr + sections[i].size)
{
- return oc->image + sections[i].offset + address - sections[i].addr;
+ return (unsigned long)oc->image
+ + sections[i].offset + address - sections[i].addr;
}
}
barf("Invalid Mach-O file:"
"Address out of bounds while relocating object file");
- return NULL;
+ return 0;
}
static int relocateSection(
{
unsigned long word = 0;
unsigned long jumpIsland = 0;
- long offsetToJumpIsland;
+ long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
+ // to avoid warning and to catch
+ // bugs.
unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
checkProddableBlock(oc,wordPtr);
{
struct nlist *symbol = &nlist[reloc->r_symbolnum];
char *nm = image + symLC->stroff + symbol->n_un.n_strx;
- unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
+ void *symbolAddress = lookupSymbol(nm);
if(!symbolAddress)
{
errorBelch("\nunknown symbol `%s'", nm);
// In the .o file, this should be a relative jump to NULL
// and we'll change it to a jump to a relative jump to the symbol
ASSERT(-word == reloc->r_address);
- word = symbolAddress;
+ word = (unsigned long) symbolAddress;
jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,word);
word -= ((long)image) + sect->offset + reloc->r_address;
if(jumpIsland != 0)
}
else
{
- word += symbolAddress;
+ word += (unsigned long) symbolAddress;
}
}
char *image = (char*) oc->image;
struct mach_header *header = (struct mach_header*) image;
struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
- unsigned i,curSymbol;
+ unsigned i,curSymbol = 0;
struct segment_command *segLC = NULL;
struct section *sections;
struct symtab_command *symLC = NULL;
if(symLC)
{
- curSymbol = 0;
for(i=0;i<symLC->nsyms;i++)
{
if(nlist[i].n_type & N_STAB)
{
extern void* symbolsWithoutUnderscore[];
void **p = symbolsWithoutUnderscore;
- __asm__ volatile(".data\n_symbolsWithoutUnderscore:");
+ __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
#undef Sym
#define Sym(x) \
projects / ghc-hetmet.git / blobdiff