+ if (gnuFileIndex == NULL) {
+ barf("loadArchive: GNU-variant filename without an index while reading from `%s'", path);
+ }
+ if (n < 0 || n > gnuFileIndexSize) {
+ barf("loadArchive: GNU-variant filename offset %d out of range [0..%d] while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ if (n != 0 && gnuFileIndex[n - 1] != '\n') {
+ barf("loadArchive: GNU-variant filename offset %d invalid (range [0..%d]) while reading filename from `%s'", n, gnuFileIndexSize, path);
+ }
+ for (i = n; gnuFileIndex[i] != '/'; i++);
+ thisFileNameSize = i - n;
+ if (thisFileNameSize >= fileNameSize) {
+ /* Double it to avoid potentially continually
+ increasing it by 1 */
+ fileNameSize = thisFileNameSize * 2;
+ fileName = stgReallocBytes(fileName, fileNameSize, "loadArchive(fileName)");
+ }
+ memcpy(fileName, gnuFileIndex + n, thisFileNameSize);
+ fileName[thisFileNameSize] = '\0';
+ }
+ else if (fileName[1] == ' ') {
+ fileName[0] = '\0';
+ thisFileNameSize = 0;
+ }
+ else {
+ barf("loadArchive: GNU-variant filename offset not found while reading filename from `%s'", path);
+ }
+ }
+ /* Finally, the case where the filename field actually contains
+ the filename */
+ else {
+ /* GNU ar terminates filenames with a '/', this allowing
+ spaces in filenames. So first look to see if there is a
+ terminating '/'. */
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == '/') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ /* If we didn't find a '/', then a space teminates the
+ filename. Note that if we don't find one, then
+ thisFileNameSize ends up as 16, and we already have the
+ '\0' at the end. */
+ if (thisFileNameSize == 16) {
+ for (thisFileNameSize = 0;
+ thisFileNameSize < 16;
+ thisFileNameSize++) {
+ if (fileName[thisFileNameSize] == ' ') {
+ fileName[thisFileNameSize] = '\0';
+ break;
+ }
+ }
+ }
+ }
+
+ IF_DEBUG(linker,
+ debugBelch("loadArchive: Found member file `%s'\n", fileName));
+
+ isObject = thisFileNameSize >= 2
+ && fileName[thisFileNameSize - 2] == '.'
+ && fileName[thisFileNameSize - 1] == 'o';
+
+ IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
+ IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
+
+ if (isObject) {
+ char *archiveMemberName;
+
+ IF_DEBUG(linker, debugBelch("loadArchive: Member is an object file...loading...\n"));
+
+ /* 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. When possible we use mmap
+ to get some anonymous memory, as on 64-bit platforms if
+ we use malloc then we can be given memory above 2^32.
+ In the mmap case we're probably wasting lots of space;
+ we could do better. */
+#if defined(USE_MMAP)
+ image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1);
+#elif defined(darwin_HOST_OS)
+ /* See loadObj() */
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(memberSize + misalignment, "loadArchive(image)");
+ image += misalignment;
+#else
+ image = stgMallocBytes(memberSize, "loadArchive(image)");
+#endif
+ n = fread ( image, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", path);
+ }
+
+ archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
+ "loadArchive(file)");
+ sprintf(archiveMemberName, "%s(%.*s)",
+ path, (int)thisFileNameSize, fileName);
+
+ oc = mkOc(path, image, memberSize, archiveMemberName
+#ifndef USE_MMAP
+#ifdef darwin_HOST_OS
+ , misalignment
+#endif
+#endif
+ );
+
+ stgFree(archiveMemberName);
+
+ if (0 == loadOc(oc)) {
+ stgFree(fileName);
+ return 0;
+ }
+ }
+ else if (isGnuIndex) {
+ if (gnuFileIndex != NULL) {
+ barf("loadArchive: GNU-variant index found, but already have an index, while reading filename from `%s'", path);
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: Found GNU-variant file index\n"));
+#ifdef USE_MMAP
+ gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1);
+#else
+ gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
+#endif
+ n = fread ( gnuFileIndex, 1, memberSize, f );
+ if (n != memberSize) {
+ barf("loadArchive: error whilst reading `%s'", path);
+ }
+ gnuFileIndex[memberSize] = '/';
+ gnuFileIndexSize = memberSize;
+ }
+ else {
+ IF_DEBUG(linker, debugBelch("loadArchive: '%s' does not appear to be an object file\n", fileName));
+ n = fseek(f, memberSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking by %d in `%s'",
+ memberSize, path);
+ }
+
+ /* .ar files are 2-byte aligned */
+ if (memberSize % 2) {
+ IF_DEBUG(linker, debugBelch("loadArchive: trying to read one pad byte\n"));
+ n = fread ( tmp, 1, 1, f );
+ if (n != 1) {
+ if (feof(f)) {
+ IF_DEBUG(linker, debugBelch("loadArchive: found EOF while reading one pad byte\n"));
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading padding from `%s'", path);
+ }
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: successfully read one pad byte\n"));
+ }
+ IF_DEBUG(linker, debugBelch("loadArchive: reached end of archive loading while loop\n"));
+ }
+
+ fclose(f);
+
+ stgFree(fileName);
+ if (gnuFileIndex != NULL) {
+#ifdef USE_MMAP
+ munmap(gnuFileIndex, gnuFileIndexSize + 1);
+#else
+ stgFree(gnuFileIndex);
+#endif
+ }
+
+ IF_DEBUG(linker, debugBelch("loadArchive: done\n"));
+ return 1;
+}
+
+/* -----------------------------------------------------------------------------
+ * Load an obj (populate the global symbol table, but don't resolve yet)
+ *
+ * Returns: 1 if ok, 0 on error.
+ */
+HsInt
+loadObj( char *path )
+{
+ ObjectCode* oc;
+ char *image;
+ int fileSize;
+ struct stat st;
+ int r;
+#ifdef USE_MMAP
+ int fd;
+#else
+ FILE *f;
+# if defined(darwin_HOST_OS)
+ int misalignment;
+# endif
+#endif
+ IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
+
+ initLinker();
+
+ /* debugBelch("loadObj %s\n", path ); */
+
+ /* Check that we haven't already loaded this object.
+ Ignore requests to load multiple times */
+ {
+ ObjectCode *o;
+ int is_dup = 0;
+ for (o = objects; o; o = o->next) {
+ if (0 == strcmp(o->fileName, path)) {
+ is_dup = 1;
+ break; /* don't need to search further */
+ }
+ }
+ if (is_dup) {
+ IF_DEBUG(linker, debugBelch(
+ "GHCi runtime linker: warning: looks like you're trying to load the\n"
+ "same object file twice:\n"
+ " %s\n"
+ "GHCi will ignore this, but be warned.\n"
+ , path));
+ return 1; /* success */
+ }
+ }
+
+ r = stat(path, &st);
+ if (r == -1) {
+ IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
+ return 0;
+ }
+
+ fileSize = st.st_size;
+
+#ifdef USE_MMAP
+ /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
+
+#if defined(openbsd_HOST_OS)
+ fd = open(path, O_RDONLY, S_IRUSR);
+#else
+ fd = open(path, O_RDONLY);
+#endif
+ if (fd == -1)
+ barf("loadObj: can't open `%s'", path);
+
+ image = mmapForLinker(fileSize, 0, fd);
+
+ close(fd);
+
+#else /* !USE_MMAP */
+ /* load the image into memory */
+ f = fopen(path, "rb");
+ if (!f)
+ barf("loadObj: can't read `%s'", path);
+
+# if defined(mingw32_HOST_OS)
+ // TODO: We would like to use allocateExec here, but allocateExec
+ // cannot currently allocate blocks large enough.
+ 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
+ // if the total size of the headers is not a multiple of the
+ // desired alignment. This is fine for .o files that only serve
+ // as input for the static linker, but it's not fine for us,
+ // 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 image on purpose so
+ // that the actual sections end up aligned again.
+ misalignment = machoGetMisalignment(f);
+ image = stgMallocBytes(fileSize + misalignment, "loadObj(image)");
+ image += misalignment;
+# else
+ image = stgMallocBytes(fileSize, "loadObj(image)");
+# endif
+
+ {
+ int n;
+ 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, NULL
+#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: start\n"));
+
+# if defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
+ r = ocAllocateSymbolExtras_MachO ( oc );
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_MachO failed\n"));
+ return r;
+ }
+# elif defined(OBJFORMAT_ELF) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
+ r = ocAllocateSymbolExtras_ELF ( oc );
+ if (!r) {
+ IF_DEBUG(linker, debugBelch("loadOc: ocAllocateSymbolExtras_ELF failed\n"));
+ return r;
+ }
+#endif
+
+ /* verify the in-memory image */
+# if defined(OBJFORMAT_ELF)
+ r = ocVerifyImage_ELF ( oc );