#include "RtsUtils.h"
#include "Schedule.h"
#include "Storage.h"
+#include "Sparks.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#if !defined(PAR)
-#define Maybe_ForeignObj SymX(mkForeignObjzh_fast)
-
#define Maybe_Stable_Names SymX(mkWeakzh_fast) \
SymX(makeStableNamezh_fast) \
SymX(finalizzeWeakzh_fast)
#else
/* These are not available in GUM!!! -- HWL */
-#define Maybe_ForeignObj
#define Maybe_Stable_Names
#endif
#if !defined (mingw32_HOST_OS)
#define RTS_POSIX_ONLY_SYMBOLS \
+ SymX(signal_handlers) \
SymX(stg_sig_install) \
Sym(nocldstop)
#endif
SymX(exp) \
SymX(log) \
SymX(sqrt) \
+ SymX(powf) \
+ SymX(tanhf) \
+ SymX(coshf) \
+ SymX(sinhf) \
+ SymX(atanf) \
+ SymX(acosf) \
+ SymX(asinf) \
+ SymX(tanf) \
+ SymX(cosf) \
+ SymX(sinf) \
+ SymX(expf) \
+ SymX(logf) \
+ SymX(sqrtf) \
SymX(memcpy) \
SymX(rts_InstallConsoleEvent) \
SymX(rts_ConsoleHandlerDone) \
Sym(closedir)
#endif
+#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
+#define RTS_DARWIN_ONLY_SYMBOLS \
+ Sym(asprintf$LDBLStub) \
+ Sym(err$LDBLStub) \
+ Sym(errc$LDBLStub) \
+ Sym(errx$LDBLStub) \
+ Sym(fprintf$LDBLStub) \
+ Sym(fscanf$LDBLStub) \
+ Sym(fwprintf$LDBLStub) \
+ Sym(fwscanf$LDBLStub) \
+ Sym(printf$LDBLStub) \
+ Sym(scanf$LDBLStub) \
+ Sym(snprintf$LDBLStub) \
+ Sym(sprintf$LDBLStub) \
+ Sym(sscanf$LDBLStub) \
+ Sym(strtold$LDBLStub) \
+ Sym(swprintf$LDBLStub) \
+ Sym(swscanf$LDBLStub) \
+ Sym(syslog$LDBLStub) \
+ Sym(vasprintf$LDBLStub) \
+ Sym(verr$LDBLStub) \
+ Sym(verrc$LDBLStub) \
+ Sym(verrx$LDBLStub) \
+ Sym(vfprintf$LDBLStub) \
+ Sym(vfscanf$LDBLStub) \
+ Sym(vfwprintf$LDBLStub) \
+ Sym(vfwscanf$LDBLStub) \
+ Sym(vprintf$LDBLStub) \
+ Sym(vscanf$LDBLStub) \
+ Sym(vsnprintf$LDBLStub) \
+ Sym(vsprintf$LDBLStub) \
+ Sym(vsscanf$LDBLStub) \
+ Sym(vswprintf$LDBLStub) \
+ Sym(vswscanf$LDBLStub) \
+ Sym(vsyslog$LDBLStub) \
+ Sym(vwarn$LDBLStub) \
+ Sym(vwarnc$LDBLStub) \
+ Sym(vwarnx$LDBLStub) \
+ Sym(vwprintf$LDBLStub) \
+ Sym(vwscanf$LDBLStub) \
+ Sym(warn$LDBLStub) \
+ Sym(warnc$LDBLStub) \
+ Sym(warnx$LDBLStub) \
+ Sym(wcstold$LDBLStub) \
+ Sym(wprintf$LDBLStub) \
+ Sym(wscanf$LDBLStub)
+#else
+#define RTS_DARWIN_ONLY_SYMBOLS
+#endif
+
#ifndef SMP
# define MAIN_CAP_SYM SymX(MainCapability)
#else
#if !defined(mingw32_HOST_OS)
#define RTS_USER_SIGNALS_SYMBOLS \
- SymX(startSignalHandler) \
SymX(setIOManagerPipe)
#else
#define RTS_USER_SIGNALS_SYMBOLS /* nothing */
#define RTS_RET_SYMBOLS \
SymX(stg_enter_ret) \
SymX(stg_gc_fun_ret) \
- SymX(stg_ap_0_ret) \
SymX(stg_ap_v_ret) \
SymX(stg_ap_f_ret) \
SymX(stg_ap_d_ret) \
#endif
#define RTS_SYMBOLS \
- Maybe_ForeignObj \
Maybe_Stable_Names \
Sym(StgReturn) \
SymX(stg_enter_info) \
SymX(delayzh_fast) \
SymX(deRefWeakzh_fast) \
SymX(deRefStablePtrzh_fast) \
+ SymX(dirty_MUT_VAR) \
SymX(divExactIntegerzh_fast) \
SymX(divModIntegerzh_fast) \
SymX(forkzh_fast) \
+ SymX(forkOnzh_fast) \
SymX(forkProcess) \
SymX(forkOS_createThread) \
SymX(freeHaskellFunctionPtr) \
SymX(newTVarzh_fast) \
SymX(atomicModifyMutVarzh_fast) \
SymX(newPinnedByteArrayzh_fast) \
+ SymX(newSpark) \
SymX(orIntegerzh_fast) \
SymX(performGC) \
SymX(performMajorGC) \
SymX(rts_mkWord8) \
SymX(rts_unlock) \
SymX(rtsSupportsBoundThreads) \
- SymX(run_queue_hd) \
SymX(__hscore_get_saved_termios) \
SymX(__hscore_set_saved_termios) \
SymX(setProgArgv) \
SymX(stg_EMPTY_MVAR_info) \
SymX(stg_IND_STATIC_info) \
SymX(stg_INTLIKE_closure) \
+ SymX(stg_MUT_ARR_PTRS_DIRTY_info) \
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(stg_ap_f_info) \
SymX(stg_ap_d_info) \
SymX(stg_ap_pppp_info) \
SymX(stg_ap_ppppp_info) \
SymX(stg_ap_pppppp_info) \
+ SymX(stg_ap_0_fast) \
+ SymX(stg_ap_v_fast) \
+ SymX(stg_ap_f_fast) \
+ SymX(stg_ap_d_fast) \
+ SymX(stg_ap_l_fast) \
+ SymX(stg_ap_n_fast) \
+ SymX(stg_ap_p_fast) \
+ SymX(stg_ap_pv_fast) \
+ SymX(stg_ap_pp_fast) \
+ SymX(stg_ap_ppv_fast) \
+ SymX(stg_ap_ppp_fast) \
+ SymX(stg_ap_pppv_fast) \
+ SymX(stg_ap_pppp_fast) \
+ SymX(stg_ap_ppppp_fast) \
+ SymX(stg_ap_pppppp_fast) \
SymX(stg_ap_1_upd_info) \
SymX(stg_ap_2_upd_info) \
SymX(stg_ap_3_upd_info) \
SymX(writeTVarzh_fast) \
SymX(xorIntegerzh_fast) \
SymX(yieldzh_fast) \
+ SymX(stg_interp_constr_entry) \
+ SymX(stg_interp_constr1_entry) \
+ SymX(stg_interp_constr2_entry) \
+ SymX(stg_interp_constr3_entry) \
+ SymX(stg_interp_constr4_entry) \
+ SymX(stg_interp_constr5_entry) \
+ SymX(stg_interp_constr6_entry) \
+ SymX(stg_interp_constr7_entry) \
+ SymX(stg_interp_constr8_entry) \
+ SymX(stgMallocBytesRWX) \
+ SymX(getAllocations) \
+ SymX(revertCAFs) \
+ SymX(RtsFlags) \
RTS_USER_SIGNALS_SYMBOLS
#ifdef SUPPORT_LONG_LONGS
RTS_POSIX_ONLY_SYMBOLS
RTS_MINGW_ONLY_SYMBOLS
RTS_CYGWIN_ONLY_SYMBOLS
+RTS_DARWIN_ONLY_SYMBOLS
RTS_LIBGCC_SYMBOLS
#undef Sym
#undef SymX
// debugBelch("ghci_enquire: can't find %s\n", sym);
}
else if (addr-DELTA <= a && a <= addr+DELTA) {
- debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
+ debugBelch("%p + %3d == `%s'\n", addr, (int)(a - addr), sym);
}
}
}
// reading the file, and then we misalign oc->image on purpose so
// that the actual sections end up aligned again.
misalignment = machoGetMisalignment(f);
+ oc->misalignment = misalignment;
#else
misalignment = 0;
#endif
int pagesize, n, m;
#endif
int aligned;
+ int misalignment = 0;
+#if darwin_HOST_OS
+ misalignment = oc->misalignment;
+#endif
if( count > 0 )
{
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 we have a half-page-size file and map one page of it then
+ * the part of the page after the size of the file remains accessible.
+ * If, however, we map in 2 pages, the 2nd page is not accessible
+ * and will give a "Bus Error" on access. To get around this, we check
+ * if we need any extra pages for the jump islands and map them in
+ * anonymously. We must check that we actually require extra pages
+ * otherwise the attempt to mmap 0 pages of anonymous memory will
+ * fail -EINVAL.
*/
- 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 )
+ if( m > n )
{
- errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
- return 0;
+ /* 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.
+ */
+ oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
+
+ if( oc->image == 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 -= misalignment;
oc->image = stgReallocBytes( oc->image,
+ misalignment +
aligned + sizeof (ppcJumpIsland) * count,
"ocAllocateJumpIslands" );
+ oc->image += misalignment;
#endif /* USE_MMAP */
oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
/* Allocate space for any (local, anonymous) .bss sections. */
for (i = 0; i < hdr->NumberOfSections; i++) {
+ UInt32 bss_sz;
UChar* zspace;
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
if (0 != strcmp(sectab_i->Name, ".bss")) continue;
- if (sectab_i->VirtualSize == 0) continue;
+ /* sof 10/05: the PE spec text isn't too clear regarding what
+ * the SizeOfRawData field is supposed to hold for object
+ * file sections containing just uninitialized data -- for executables,
+ * it is supposed to be zero; unclear what it's supposed to be
+ * for object files. However, VirtualSize is guaranteed to be
+ * zero for object files, which definitely suggests that SizeOfRawData
+ * will be non-zero (where else would the size of this .bss section be
+ * stored?) Looking at the COFF_section info for incoming object files,
+ * this certainly appears to be the case.
+ *
+ * => I suspect we've been incorrectly handling .bss sections in (relocatable)
+ * object files up until now. This turned out to bite us with ghc-6.4.1's use
+ * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
+ * variable decls into to the .bss section. (The specific function in Q which
+ * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
+ */
+ if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
/* This is a non-empty .bss section. Allocate zeroed space for
it, and set its PointerToRawData field such that oc->image +
PointerToRawData == addr_of_zeroed_space. */
- zspace = stgCallocBytes(1, sectab_i->VirtualSize,
- "ocGetNames_PEi386(anonymous bss)");
+ bss_sz = sectab_i->VirtualSize;
+ if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
+ zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
- addProddableBlock(oc, zspace, sectab_i->VirtualSize);
+ addProddableBlock(oc, zspace, bss_sz);
/* debugBelch("BSS anon section at 0x%x\n", zspace); */
}
COFF_reloc* rel = (COFF_reloc*)
myindex ( sizeof_COFF_reloc, reltab, 0 );
noRelocs = rel->VirtualAddress;
+
+ /* 10/05: we now assume (and check for) a GNU ld that is capable
+ * of handling object files with (>2^16) of relocs.
+ */
+#if 0
debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
noRelocs);
+#endif
j = 1;
} else {
noRelocs = sectab_i->NumberOfRelocations;
}
IF_DEBUG(linker,debugBelch(
- "\nSection header table: start %d, n_entries %d, ent_size %d\n",
- ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
+ "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
+ (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
nsymtabs++;
stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
nent = shdr[i].sh_size / sizeof(Elf_Sym);
- IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)\n",
+ IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%ld rem)\n",
nent,
- shdr[i].sh_size % sizeof(Elf_Sym)
+ (long)shdr[i].sh_size % sizeof(Elf_Sym)
));
if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
case R_386_PC32: *pP = value - P; break;
# endif
default:
- errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
- oc->fileName, ELF_R_TYPE(info));
+ errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
+ oc->fileName, (lnat)ELF_R_TYPE(info));
return 0;
}
Elf_Sym* stab, char* strtab )
{
int j;
- char *symbol;
+ char *symbol = NULL;
Elf_Addr targ;
Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
int nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
#endif
default:
- errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
- oc->fileName, ELF_R_TYPE(info));
+ errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
+ oc->fileName, (lnat)ELF_R_TYPE(info));
return 0;
}
struct nlist *nlist)
{
unsigned i;
+ size_t itemSize = 4;
+
+#if i386_HOST_ARCH
+ int isJumpTable = 0;
+ if(!strcmp(sect->sectname,"__jump_table"))
+ {
+ isJumpTable = 1;
+ itemSize = 5;
+ ASSERT(sect->reserved2 == itemSize);
+ }
+#endif
- for(i=0;i*4<sect->size;i++)
+ for(i=0; i*itemSize < sect->size;i++)
{
// according to otool, reserved1 contains the first index into the indirect symbol table
struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
return 0;
}
ASSERT(addr);
- checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
- ((void**)(image + sect->offset))[i] = addr;
+
+#if i386_HOST_ARCH
+ if(isJumpTable)
+ {
+ checkProddableBlock(oc,image + sect->offset + i*itemSize);
+ *(image + sect->offset + i*itemSize) = 0xe9; // jmp
+ *(unsigned*)(image + sect->offset + i*itemSize + 1)
+ = (char*)addr - (image + sect->offset + i*itemSize + 5);
+ }
+ else
+#endif
+ {
+ checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
+ ((void**)(image + sect->offset))[i] = addr;
+ }
}
return 1;
struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
unsigned i;
struct segment_command *segLC = NULL;
- struct section *sections, *la_ptrs = NULL, *nl_ptrs = NULL;
+ struct section *sections;
struct symtab_command *symLC = NULL;
struct dysymtab_command *dsymLC = NULL;
struct nlist *nlist;
nlist = symLC ? (struct nlist*) (image + symLC->symoff)
: NULL;
- for(i=0;i<segLC->nsects;i++)
- {
- if(!strcmp(sections[i].sectname,"__la_symbol_ptr"))
- la_ptrs = §ions[i];
- else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr"))
- nl_ptrs = §ions[i];
- else if(!strcmp(sections[i].sectname,"__la_sym_ptr2"))
- la_ptrs = §ions[i];
- else if(!strcmp(sections[i].sectname,"__la_sym_ptr3"))
- la_ptrs = §ions[i];
- }
-
if(dsymLC)
{
unsigned long *indirectSyms
= (unsigned long*) (image + dsymLC->indirectsymoff);
- if(la_ptrs)
- if(!resolveImports(oc,image,symLC,la_ptrs,indirectSyms,nlist))
- return 0;
- if(nl_ptrs)
- if(!resolveImports(oc,image,symLC,nl_ptrs,indirectSyms,nlist))
- return 0;
+ for(i=0;i<segLC->nsects;i++)
+ {
+ if( !strcmp(sections[i].sectname,"__la_symbol_ptr")
+ || !strcmp(sections[i].sectname,"__la_sym_ptr2")
+ || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
+ {
+ if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
+ return 0;
+ }
+ else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
+ || !strcmp(sections[i].sectname,"__pointers"))
+ {
+ if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
+ return 0;
+ }
+ else if(!strcmp(sections[i].sectname,"__jump_table"))
+ {
+ if(!resolveImports(oc,image,symLC,§ions[i],indirectSyms,nlist))
+ return 0;
+ }
+ }
}
for(i=0;i<segLC->nsects;i++)
projects / ghc-hetmet.git / blobdiff