#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
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) \
# if defined(openbsd_HOST_OS)
dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
# endif
-# endif // RTLD_DEFAULT
+# endif /* RTLD_DEFAULT */
# endif
}
void *hdl;
char *errmsg;
+ // *** HACK
+ // If we load libHSbase_cbits_dyn.[so|dylib],
+ // then we know that we need to activate another newCAF
+ // related hack in Storage.c because we can't redirect
+ // newCAF to newDynCAF with the system dynamic linker.
+#ifdef OBJFORMAT_MACHO
+ const char *hsbase = "/libHSbase_cbits_dyn.dylib";
+#else
+ const char *hsbase = "/libHSbase_cbits_dyn.so";
+#endif
+ int namelen = strlen(dll_name);
+ int baselen = strlen(hsbase);
+ if(namelen > baselen && !strcmp(dll_name + namelen - baselen, hsbase))
+ {
+ keepCAFs = rtsTrue;
+ }
+ // *** END HACK.
+
initLinker();
hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
/* 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) {
return ptr;
}
-static int
-findElfSectionIndexByName( ObjectCode *oc, const char *sh_name,
- Elf_Word expected_type, Elf_Word expected_entsize )
-{
- Elf_Ehdr *ehdr = (Elf_Ehdr *) oc->image;
- Elf_Shdr *shdr = (Elf_Shdr *) (oc->image + ehdr->e_shoff);
- char *sectnames = oc->image + shdr[ehdr->e_shstrndx].sh_offset;
- int i;
-
- for( i = 0; i < ehdr->e_shnum; i++ )
- if( !strcmp( sectnames + shdr[i].sh_name, sh_name ) )
- {
- if( shdr[i].sh_type != expected_type )
- {
- errorBelch( "The entry type (%d) of the '%s' section isn't %d\n",
- shdr[i].sh_type, sh_name, expected_type );
- return -1;
- }
-
- if( shdr[i].sh_entsize != expected_entsize )
- {
- errorBelch( "The entry size (%d) of the '%s' section isn't %d\n",
- shdr[i].sh_entsize, sh_name, expected_entsize );
-
- return -1;
- }
-
- return i;
- }
-
- errorBelch( "This ELF file contains no '%s' section", sh_name );
- return -1;
-}
-
-static char *
-findElfSectionByName( ObjectCode *oc, const char *sh_name,
- Elf_Word expected_type, int expected_entsize,
- int *num_entries )
-{
- Elf_Ehdr *ehdr = (Elf_Ehdr *) oc->image;
- Elf_Shdr *shdr = (Elf_Shdr *) (oc->image + ehdr->e_shoff);
- int section;
-
- section = findElfSectionIndexByName( oc, sh_name, expected_type,
- expected_entsize );
-
- if( section < 0 )
- return NULL;
-
- /* allow for meaningful results in num_entries even when entsize is 0 */
- if( expected_entsize == 0 )
- expected_entsize = 1;
-
- if( num_entries )
- *num_entries = shdr[section].sh_size / expected_entsize;
-
- return oc->image + shdr[section].sh_offset;
-}
-
#if defined(ia64_HOST_ARCH)
static Elf_Addr
findElfSegment ( void* objImage, Elf_Addr vaddr )
// 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)