#include "posix/Signals.h"
#endif
-#if defined(mingw32_HOST_OS)
// get protos for is*()
#include <ctype.h>
-#endif
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
/* List of currently loaded objects */
ObjectCode *objects = NULL; /* initially empty */
+static HsInt loadOc( ObjectCode* oc );
+static ObjectCode* mkOc( char *path, char *image, int imageSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , int misalignment
+#endif
+#endif
+ );
+
#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
#define RTS_POSIX_ONLY_SYMBOLS /**/
#define RTS_CYGWIN_ONLY_SYMBOLS /**/
-/* Extra syms gen'ed by mingw-2's gcc-3.2: */
-#if __GNUC__>=3
-#define RTS_MINGW_EXTRA_SYMS \
- SymI_NeedsProto(_imp____mb_cur_max) \
- SymI_NeedsProto(_imp___pctype)
-#else
-#define RTS_MINGW_EXTRA_SYMS
-#endif
-
#if HAVE_GETTIMEOFDAY
#define RTS_MINGW_GETTIMEOFDAY_SYM SymI_NeedsProto(gettimeofday)
#else
SymI_NeedsProto(opendir) \
SymI_NeedsProto(readdir) \
SymI_NeedsProto(rewinddir) \
- RTS_MINGW_EXTRA_SYMS \
+ SymI_NeedsProto(_imp____mb_cur_max) \
+ SymI_NeedsProto(_imp___pctype) \
+ SymI_NeedsProto(__chkstk) \
RTS_MINGW_GETTIMEOFDAY_SYM \
SymI_NeedsProto(closedir)
#endif
+
#if defined(darwin_HOST_OS) && HAVE_PRINTF_LDBLSTUB
#define RTS_DARWIN_ONLY_SYMBOLS \
SymI_NeedsProto(asprintf$LDBLStub) \
SymI_HasProto(stg_isCurrentThreadBoundzh) \
SymI_HasProto(stg_isEmptyMVarzh) \
SymI_HasProto(stg_killThreadzh) \
+ SymI_HasProto(loadArchive) \
SymI_HasProto(loadObj) \
SymI_HasProto(insertStableSymbol) \
SymI_HasProto(insertSymbol) \
SymI_HasProto(stg_writeTVarzh) \
SymI_HasProto(stg_yieldzh) \
SymI_NeedsProto(stg_interp_constr_entry) \
+ SymI_HasProto(stg_arg_bitmaps) \
SymI_HasProto(alloc_blocks_lim) \
SymI_HasProto(g0) \
SymI_HasProto(allocate) \
}
#endif // USE_MMAP
+static ObjectCode*
+mkOc( char *path, char *image, int imageSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , int misalignment
+#endif
+#endif
+ ) {
+ ObjectCode* oc;
+
+ oc = stgMallocBytes(sizeof(ObjectCode), "loadArchive(oc)");
+
+# if defined(OBJFORMAT_ELF)
+ oc->formatName = "ELF";
+# elif defined(OBJFORMAT_PEi386)
+ oc->formatName = "PEi386";
+# elif defined(OBJFORMAT_MACHO)
+ oc->formatName = "Mach-O";
+# else
+ stgFree(oc);
+ barf("loadObj: not implemented on this platform");
+# endif
+
+ oc->image = image;
+ /* sigh, strdup() isn't a POSIX function, so do it the long way */
+ /* XXX What should this be for an archive? */
+ oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
+ strcpy(oc->fileName, path);
+
+ oc->fileSize = imageSize;
+ oc->symbols = NULL;
+ oc->sections = NULL;
+ oc->proddables = NULL;
+
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ oc->misalignment = misalignment;
+#endif
+#endif
+
+ /* chain it onto the list of objects */
+ oc->next = objects;
+ objects = oc;
+
+ return oc;
+}
+
+#if defined(USE_ARCHIVES_FOR_GHCI)
+HsInt
+loadArchive( char *path )
+{
+ ObjectCode* oc;
+ char *image;
+ int imageSize;
+ FILE *f;
+ int n;
+ size_t fileNameSize;
+ char *file;
+ size_t fileSize;
+ int isObject;
+ char tmp[12];
+
+ IF_DEBUG(linker, debugBelch("loadArchive `%s'\n", path));
+
+ fileSize = 32;
+ file = stgMallocBytes(fileSize, "loadArchive(file)");
+
+ f = fopen(path, "rb");
+ if (!f)
+ barf("loadObj: can't read `%s'", path);
+
+ n = fread ( tmp, 1, 8, f );
+ if (strncmp(tmp, "!<arch>\n", 8) != 0)
+ barf("loadArchive: Not an archive: `%s'", path);
+
+ while(1) {
+ n = fread ( file, 1, 16, f );
+ if (n != 16) {
+ if (feof(f)) {
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading file name from `%s'", path);
+ }
+ }
+ n = fread ( tmp, 1, 12, f );
+ if (n != 12)
+ barf("loadArchive: Failed reading mod time from `%s'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading owner from `%s'", path);
+ n = fread ( tmp, 1, 6, f );
+ if (n != 6)
+ barf("loadArchive: Failed reading group from `%s'", path);
+ n = fread ( tmp, 1, 8, f );
+ if (n != 8)
+ barf("loadArchive: Failed reading mode from `%s'", path);
+ n = fread ( tmp, 1, 10, f );
+ if (n != 10)
+ barf("loadArchive: Failed reading size from `%s'", path);
+ tmp[10] = '\0';
+ for (n = 0; isdigit(tmp[n]); n++);
+ tmp[n] = '\0';
+ imageSize = atoi(tmp);
+ n = fread ( tmp, 1, 2, f );
+ if (strncmp(tmp, "\x60\x0A", 2) != 0)
+ barf("loadArchive: Failed reading magic from `%s' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]);
+
+ /* Check for BSD-variant large filenames */
+ if (0 == strncmp(file, "#1/", 3)) {
+ file[16] = '\0';
+ for (n = 3; isdigit(file[n]); n++);
+ file[n] = '\0';
+ fileNameSize = atoi(file + 3);
+ imageSize -= fileNameSize;
+ if (fileNameSize > fileSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileSize = fileNameSize * 2;
+ file = stgReallocBytes(file, fileSize, "loadArchive(file)");
+ }
+ n = fread ( file, 1, fileNameSize, f );
+ if (n != (int)fileNameSize)
+ barf("loadArchive: Failed reading filename from `%s'", path);
+ }
+ else {
+ fileNameSize = 16;
+ }
+
+ isObject = 0;
+ for (n = 0; n < (int)fileNameSize - 1; n++) {
+ if ((file[n] == '.') && (file[n + 1] == 'o')) {
+ isObject = 1;
+ break;
+ }
+ }
+
+ if (isObject) {
+ /* We can't mmap from the archive directly, as object
+ files need to be 8-byte aligned but files in .ar
+ archives are 2-byte aligned, and if we malloc the
+ memory then we can be given memory above 2^32, so we
+ mmap some anonymous memory and use that. We could
+ do better here. */
+ image = mmapForLinker(imageSize, MAP_ANONYMOUS, -1);
+ n = fread ( image, 1, imageSize, f );
+ if (n != imageSize)
+ barf("loadObj: error whilst reading `%s'", path);
+ oc = mkOc(path, image, imageSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , 0
+#endif
+#endif
+ );
+ if (0 == loadOc(oc)) {
+ stgFree(file);
+ return 0;
+ }
+ }
+ else {
+ n = fseek(f, imageSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking by %d in `%s'",
+ imageSize, path);
+ }
+ /* .ar files are 2-byte aligned */
+ if (imageSize % 2) {
+ n = fread ( tmp, 1, 1, f );
+ if (n != 1) {
+ if (feof(f)) {
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading padding from `%s'", path);
+ }
+ }
+ }
+ }
+
+ fclose(f);
+
+ stgFree(file);
+ return 1;
+}
+#else
+HsInt GNU_ATTRIBUTE(__noreturn__)
+loadArchive( char *path STG_UNUSED ) {
+ barf("loadArchive: not enabled");
+}
+#endif
+
/* -----------------------------------------------------------------------------
* Load an obj (populate the global symbol table, but don't resolve yet)
*
loadObj( char *path )
{
ObjectCode* oc;
+ char *image;
+ int fileSize;
struct stat st;
int r;
#ifdef USE_MMAP
FILE *f;
#endif
IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
initLinker();
/* debugBelch("loadObj %s\n", path ); */
}
}
- oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
-
-# if defined(OBJFORMAT_ELF)
- oc->formatName = "ELF";
-# elif defined(OBJFORMAT_PEi386)
- oc->formatName = "PEi386";
-# elif defined(OBJFORMAT_MACHO)
- oc->formatName = "Mach-O";
-# else
- stgFree(oc);
- barf("loadObj: not implemented on this platform");
-# endif
-
r = stat(path, &st);
if (r == -1) {
IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
return 0;
}
- /* sigh, strdup() isn't a POSIX function, so do it the long way */
- oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
- strcpy(oc->fileName, path);
-
- oc->fileSize = st.st_size;
- oc->symbols = NULL;
- oc->sections = NULL;
- oc->proddables = NULL;
-
- /* chain it onto the list of objects */
- oc->next = objects;
- objects = oc;
+ fileSize = st.st_size;
#ifdef USE_MMAP
/* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
if (fd == -1)
barf("loadObj: can't open `%s'", path);
- oc->image = mmapForLinker(oc->fileSize, 0, fd);
+ image = mmapForLinker(fileSize, 0, fd);
close(fd);
# if defined(mingw32_HOST_OS)
// TODO: We would like to use allocateExec here, but allocateExec
// cannot currently allocate blocks large enough.
- oc->image = VirtualAlloc(NULL, oc->fileSize, MEM_RESERVE | MEM_COMMIT,
+ image = VirtualAlloc(NULL, fileSize, MEM_RESERVE | MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
# elif defined(darwin_HOST_OS)
// In a Mach-O .o file, all sections can and will be misaligned
// as SSE (used by gcc for floating point) and Altivec require
// 16-byte alignment.
// We calculate the correct alignment from the header before
- // reading the file, and then we misalign oc->image on purpose so
+ // reading the file, and then we misalign image on purpose so
// that the actual sections end up aligned again.
- oc->misalignment = machoGetMisalignment(f);
- oc->image = stgMallocBytes(oc->fileSize + oc->misalignment, "loadObj(image)");
- oc->image += oc->misalignment;
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
+ image += misalignment;
# else
- oc->image = stgMallocBytes(oc->fileSize, "loadObj(image)");
+ image = stgMallocBytes(fileSize, "loadObj(image)");
# endif
{
int n;
- n = fread ( oc->image, 1, oc->fileSize, f );
- if (n != oc->fileSize)
+ n = fread ( image, 1, fileSize, f );
+ if (n != fileSize)
barf("loadObj: error whilst reading `%s'", path);
}
fclose(f);
#endif /* USE_MMAP */
+ oc = mkOc(path, image, fileSize
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , misalignment
+#endif
+#endif
+ );
+
+ return loadOc(oc);
+}
+
+static HsInt
+loadOc( ObjectCode* oc ) {
+ int r;
+
+ IF_DEBUG(linker, debugBelch("loadOc\n"));
+
# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
r = ocAllocateSymbolExtras_MachO ( oc );
if (!r) {
*/
if (name[7]==0) return name;
/* The annoying case: 8 bytes. Copy into a temporary
- (which is never freed ...)
+ (XXX which is never freed ...)
*/
newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
ASSERT(newstr);
return newstr;
}
+/* Getting the name of a section is mildly tricky, so we make a
+ function for it. Sadly, in one case we have to copy the string
+ (when it is exactly 8 bytes long there's no trailing '\0'), so for
+ consistency we *always* copy the string; the caller must free it
+*/
+static char *
+cstring_from_section_name (UChar* name, UChar* strtab)
+{
+ char *newstr;
+
+ if (name[0]=='/') {
+ int strtab_offset = strtol((char*)name+1,NULL,10);
+ int len = strlen(((char*)strtab) + strtab_offset);
+
+ newstr = stgMallocBytes(len, "cstring_from_section_symbol_name");
+ strcpy((char*)newstr, (char*)((UChar*)strtab) + strtab_offset);
+ return newstr;
+ }
+ else
+ {
+ newstr = stgMallocBytes(9, "cstring_from_section_symbol_name");
+ ASSERT(newstr);
+ strncpy((char*)newstr,(char*)name,8);
+ newstr[8] = 0;
+ return newstr;
+ }
+}
/* Just compares the short names (first 8 chars) */
static COFF_section *
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- if (0 != strcmp((char*)sectab_i->Name, ".bss")) continue;
+
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+ if (0 != strcmp(secname, ".bss")) {
+ stgFree(secname);
+ continue;
+ }
+
+ stgFree(secname);
+
/* 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,
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
+
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
+ IF_DEBUG(linker, debugBelch("section name = %s\n", secname ));
# if 0
/* I'm sure this is the Right Way to do it. However, the
kind = SECTIONKIND_CODE_OR_RODATA;
# endif
- if (0==strcmp(".text",(char*)sectab_i->Name) ||
- 0==strcmp(".rdata",(char*)sectab_i->Name)||
- 0==strcmp(".rodata",(char*)sectab_i->Name))
+ if (0==strcmp(".text",(char*)secname) ||
+ 0==strcmp(".rdata",(char*)secname)||
+ 0==strcmp(".rodata",(char*)secname))
kind = SECTIONKIND_CODE_OR_RODATA;
- if (0==strcmp(".data",(char*)sectab_i->Name) ||
- 0==strcmp(".bss",(char*)sectab_i->Name))
+ if (0==strcmp(".data",(char*)secname) ||
+ 0==strcmp(".bss",(char*)secname))
kind = SECTIONKIND_RWDATA;
ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
if (kind == SECTIONKIND_OTHER
/* Ignore sections called which contain stabs debugging
information. */
- && 0 != strcmp(".stab", (char*)sectab_i->Name)
- && 0 != strcmp(".stabstr", (char*)sectab_i->Name)
+ && 0 != strcmp(".stab", (char*)secname)
+ && 0 != strcmp(".stabstr", (char*)secname)
/* ignore constructor section for now */
- && 0 != strcmp(".ctors", (char*)sectab_i->Name)
+ && 0 != strcmp(".ctors", (char*)secname)
/* ignore section generated from .ident */
- && 0!= strcmp("/4", (char*)sectab_i->Name)
+ && 0!= strncmp(".debug", (char*)secname, 6)
/* ignore unknown section that appeared in gcc 3.4.5(?) */
- && 0!= strcmp(".reloc", (char*)sectab_i->Name)
+ && 0!= strcmp(".reloc", (char*)secname)
+ && 0 != strcmp(".rdata$zzz", (char*)secname)
) {
- errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
+ errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
+ stgFree(secname);
return 0;
}
addSection(oc, kind, start, end);
addProddableBlock(oc, start, end - start + 1);
}
+
+ stgFree(secname);
}
/* Copy exported symbols into the ObjectCode. */
((UChar*)(oc->image)) + sectab_i->PointerToRelocations
);
+ char *secname = cstring_from_section_name(sectab_i->Name, strtab);
+
/* Ignore sections called which contain stabs debugging
information. */
- if (0 == strcmp(".stab", (char*)sectab_i->Name)
- || 0 == strcmp(".stabstr", (char*)sectab_i->Name)
- || 0 == strcmp(".ctors", (char*)sectab_i->Name))
- continue;
+ if (0 == strcmp(".stab", (char*)secname)
+ || 0 == strcmp(".stabstr", (char*)secname)
+ || 0 == strcmp(".ctors", (char*)secname)
+ || 0 == strncmp(".debug", (char*)secname, 6)
+ || 0 == strcmp(".rdata$zzz", (char*)secname)) {
+ stgFree(secname);
+ continue;
+ }
+
+ stgFree(secname);
if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
/* If the relocation field (a short) has overflowed, the
char *commonStorage = NULL;
unsigned long commonCounter;
+ IF_DEBUG(linker,debugBelch("ocGetNames_MachO\n"));
+
for(i=0;i<header->ncmds;i++)
{
if(lc->cmd == LC_SEGMENT || lc->cmd == LC_SEGMENT_64)
; // weak definition, and we already have a definition
else
{
+ IF_DEBUG(linker,debugBelch("Adding symbol 1 %s\n", nm));
ghciInsertStrHashTable(oc->fileName, symhash, nm,
image
+ sections[nlist[i].n_sect-1].offset
nlist[i].n_value = commonCounter;
+ IF_DEBUG(linker,debugBelch("Adding symbol 2 %s\n", nm));
ghciInsertStrHashTable(oc->fileName, symhash, nm,
(void*)commonCounter);
oc->symbols[curSymbol++] = nm;