import UniqSet
import Constants
import FastString
-import Config ( cProjectVersion )
+import Config
-- Standard libraries
import Control.Monad
Object static_ish
-> do b <- preload_static lib_paths static_ish
maybePutStrLn dflags (if b then "done"
- else "not found")
-
+ else "not found")
+
+ Archive static_ish
+ -> do b <- preload_static_archive lib_paths static_ish
+ maybePutStrLn dflags (if b then "done"
+ else "not found")
+
DLL dll_unadorned
-> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
case maybe_errstr of
= do b <- doesFileExist name
if not b then return False
else loadObj name >> return True
+ preload_static_archive _paths name
+ = do b <- doesFileExist name
+ if not b then return False
+ else loadArchive name >> return True
\end{code}
-- file in all the directories specified in
-- v_Library_paths before giving up.
+ | Archive FilePath -- Full path name of a .a file, including trailing .a
+
| DLL String -- "Unadorned" name of a .DLL/.so
-- e.g. On unix "qt" denotes "libqt.so"
-- On WinDoze "burble" denotes "burble.DLL"
showLS :: LibrarySpec -> String
showLS (Object nm) = "(static) " ++ nm
+showLS (Archive nm) = "(static archive) " ++ nm
showLS (DLL nm) = "(dynamic) " ++ nm
showLS (DLLPath nm) = "(dynamic) " ++ nm
showLS (Framework nm) = "(framework) " ++ nm
-- Complication: all the .so's must be loaded before any of the .o's.
let dlls = [ dll | DLL dll <- classifieds ]
objs = [ obj | Object obj <- classifieds ]
+ archs = [ arch | Archive arch <- classifieds ]
maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ")
-- Ordering isn't important here, because we do one final link
-- step to resolve everything.
mapM_ loadObj objs
+ mapM_ loadArchive archs
maybePutStr dflags "linking ... "
ok <- resolveObjs
| not isDynamicGhcLib
-- When the GHC package was not compiled as dynamic library
-- (=DYNAMIC not set), we search for .o libraries.
- = do { mb_obj_path <- findFile mk_obj_path dirs
- ; case mb_obj_path of
- Just obj_path -> return (Object obj_path)
- Nothing -> return (DLL lib) }
+ = do mb_libSpec <- if cUseArchivesForGhci
+ then do mb_arch_path <- findFile mk_arch_path dirs
+ case mb_arch_path of
+ Just arch_path ->
+ return (Just (Archive arch_path))
+ Nothing ->
+ return Nothing
+ else do mb_obj_path <- findFile mk_obj_path dirs
+ case mb_obj_path of
+ Just obj_path ->
+ return (Just (Object obj_path))
+ Nothing ->
+ return Nothing
+ case mb_libSpec of
+ Just ls -> return ls
+ Nothing -> return (DLL lib)
| otherwise
-- When the GHC package was compiled as dynamic library (=DYNAMIC set),
Nothing -> return (DLL lib) }} -- We assume
where
mk_obj_path dir = dir </> (lib <.> "o")
+ mk_arch_path dir = dir </> ("lib" ++ lib <.> "a")
dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
mk_dyn_lib_path dir = dir </> mkSOName dyn_lib_name
#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 );
SymI_HasProto(stg_isCurrentThreadBoundzh) \
SymI_HasProto(stg_isEmptyMVarzh) \
SymI_HasProto(stg_killThreadzh) \
+ SymI_HasProto(loadArchive) \
SymI_HasProto(loadObj) \
SymI_HasProto(insertStableSymbol) \
SymI_HasProto(insertSymbol) \
}
#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;
+ char tmp[16];
+ int isObject;
+
+ 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 ( tmp, 1, 16, f );
+ if (n != 16) {
+ if (feof(f)) {
+ break;
+ }
+ else {
+ barf("loadArchive: Failed reading file name from `%s'", path);
+ }
+ }
+ /* Ignore special files */
+ if ((0 == strncmp(tmp, "/ ", 16)) ||
+ (0 == strncmp(tmp, "// ", 16))) {
+ isObject = 0;
+ }
+ else {
+ isObject = 1;
+ }
+ 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]);
+
+ 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)) {
+ return 0;
+ }
+ }
+ else {
+ n = fseek(f, imageSize, SEEK_CUR);
+ if (n != 0)
+ barf("loadArchive: error whilst seeking to %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);
+
+ 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 defined(OBJFORMAT_MACHO) && (defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH))
r = ocAllocateSymbolExtras_MachO ( oc );
if (!r) {
projects / ghc-hetmet.git / commitdiff