Skip to content

GitLab

Commit b8384ce5 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Implement archive loading for ghci

parent a2254812
Hide whitespace changes
Inline Side-by-side
compiler/ghc.mk
View file @ b8384ce5
......@@ -135,6 +135,12 @@ ifeq "$(RelocatableBuild)" "YES"
@echo 'cRelocatableBuild = True' >> $@
else
@echo 'cRelocatableBuild = False' >> $@
endif
@echo 'cUseArchivesForGhci :: Bool' >> $@
ifeq "$(UseArchivesForGhci)" "YES"
@echo 'cUseArchivesForGhci = True' >> $@
else
@echo 'cUseArchivesForGhci = False' >> $@
endif
@echo 'cLibFFI :: Bool' >> $@
ifeq "$(UseLibFFIForAdjustors)" "YES"
......
compiler/ghci/Linker.lhs
View file @ b8384ce5
......@@ -53,7 +53,7 @@ import qualified Maybes
import UniqSet
import Constants
import FastString
import Config ( cProjectVersion )
import Config
-- Standard libraries
import Control.Monad
......@@ -429,8 +429,13 @@ preloadLib dflags lib_paths framework_paths lib_spec
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
......@@ -468,6 +473,10 @@ preloadLib dflags lib_paths framework_paths lib_spec
= 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}
......@@ -929,6 +938,8 @@ data LibrarySpec
-- 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"
......@@ -957,6 +968,7 @@ partOfGHCi
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
......@@ -1039,6 +1051,7 @@ linkPackage dflags pkg
-- 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) ++ " ... ")
......@@ -1060,6 +1073,7 @@ linkPackage dflags 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
......@@ -1094,10 +1108,22 @@ locateOneObj dirs lib
| 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),
......@@ -1112,6 +1138,7 @@ locateOneObj dirs lib
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
......
compiler/ghci/ObjLink.lhs
View file @ b8384ce5
......@@ -12,6 +12,7 @@ Primarily, this module consists of an interface to the C-land dynamic linker.
module ObjLink (
initObjLinker, -- :: IO ()
loadDLL, -- :: String -> IO (Maybe String)
loadArchive, -- :: String -> IO ()
loadObj, -- :: String -> IO ()
unloadObj, -- :: String -> IO ()
insertSymbol, -- :: String -> String -> Ptr a -> IO ()
......@@ -65,6 +66,12 @@ loadDLL str = do
else do str <- peekCString maybe_errmsg
return (Just str)
loadArchive :: String -> IO ()
loadArchive str = do
withCString str $ \c_str -> do
r <- c_loadArchive c_str
when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))
loadObj :: String -> IO ()
loadObj str = do
withCString str $ \c_str -> do
......@@ -90,6 +97,7 @@ foreign import ccall unsafe "addDLL" c_addDLL :: CString -> IO CString
foreign import ccall unsafe "initLinker" initObjLinker :: IO ()
foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()
foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
foreign import ccall unsafe "loadArchive" c_loadArchive :: CString -> IO Int
foreign import ccall unsafe "loadObj" c_loadObj :: CString -> IO Int
foreign import ccall unsafe "unloadObj" c_unloadObj :: CString -> IO Int
foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int
......
ghc.mk
View file @ b8384ce5
......@@ -739,7 +739,9 @@ $(foreach pkg,$(BOOT_PKGS),$(eval libraries/$(pkg)_dist-boot_HC_OPTS += $$(GhcBo
GHCI_LIBS = $(foreach lib,$(PACKAGES),$(libraries/$(lib)_dist-install_GHCI_LIB)) \
$(compiler_stage2_GHCI_LIB)
ifeq "$(UseArchivesForGhci)" "NO"
ghc/stage2/build/tmp/$(ghc_stage2_PROG) : $(GHCI_LIBS)
endif
endif
......
includes/rts/Linker.h
View file @ b8384ce5
......@@ -32,6 +32,9 @@ HsInt unloadObj( char *path );
/* add an obj (populate the global symbol table, but don't resolve yet) */
HsInt loadObj( char *path );
/* add an arch (populate the global symbol table, but don't resolve yet) */
HsInt loadArchive( char *path );
/* resolve all the currently unlinked objects in memory */
HsInt resolveObjs( void );
......
mk/config.mk.in
View file @ b8384ce5
......@@ -190,6 +190,8 @@ else
UseLibFFIForAdjustors=YES
endif
UseArchivesForGhci = NO
# On Windows we normally want to make a relocatable bindist, to we
# ignore flags like libdir
ifeq "$(Windows)" "YES"
......
rts/Linker.c
View file @ b8384ce5
......@@ -33,10 +33,8 @@
#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>
......@@ -120,6 +118,15 @@ static /*Str*/HashTable *stablehash;
/* 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 );
......@@ -798,6 +805,7 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_isCurrentThreadBoundzh) \
SymI_HasProto(stg_isEmptyMVarzh) \
SymI_HasProto(stg_killThreadzh) \
SymI_HasProto(loadArchive) \
SymI_HasProto(loadObj) \
SymI_HasProto(insertStableSymbol) \
SymI_HasProto(insertSymbol) \
......@@ -1599,6 +1607,167 @@ mmap_again:
}
#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)
*
......@@ -1608,6 +1777,8 @@ HsInt
loadObj( char *path )
{
ObjectCode* oc;
char *image;
int fileSize;
struct stat st;
int r;
#ifdef USE_MMAP
......@@ -1616,6 +1787,7 @@ loadObj( char *path )
FILE *f;
#endif
IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
initLinker();
/* debugBelch("loadObj %s\n", path ); */
......@@ -1642,37 +1814,13 @@ loadObj( char *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. */
......@@ -1685,7 +1833,7 @@ loadObj( char *path )
if (fd == -1)
barf("loadObj: can't open `%s'", path);
oc->image = mmapForLinker(oc->fileSize, 0, fd);
image = mmapForLinker(fileSize, 0, fd);
close(fd);
......@@ -1698,7 +1846,7 @@ loadObj( char *path )
# 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
......@@ -1708,24 +1856,39 @@ loadObj( char *path )
// 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) {
......
rts/ghc.mk
View file @ b8384ce5
......@@ -246,6 +246,10 @@ ifeq "$(UseLibFFIForAdjustors)" "YES"
rts_CC_OPTS += -DUSE_LIBFFI_FOR_ADJUSTORS
endif
ifeq "$(UseArchivesForGhci)" "YES"
rts_CC_OPTS += -DUSE_ARCHIVES_FOR_GHCI
endif
# Mac OS X: make sure we compile for the right OS version
rts_CC_OPTS += $(MACOSX_DEPLOYMENT_CC_OPTS)
rts_HC_OPTS += $(addprefix -optc, $(MACOSX_DEPLOYMENT_CC_OPTS))
......
rules/build-package-way.mk
View file @ b8384ce5
......@@ -103,13 +103,17 @@ ifeq "$3" "v"
$1_$2_GHCI_LIB = $1/$2/build/HS$$($1_PACKAGE)-$$($1_$2_VERSION).$$($3_osuf)
# Don't put bootstrapping packages in the bindist
ifneq "$4" "0"
ifeq "$$(UseArchivesForGhci)" "NO"
BINDIST_LIBS += $$($1_$2_GHCI_LIB)
endif
endif
$$($1_$2_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS)
"$$(LD)" -r -o $$@ $$(EXTRA_LD_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) `$$($1_$2_$3_MKSTUBOBJS)` $$($1_$2_EXTRA_OBJS)
ifeq "$$(UseArchivesForGhci)" "NO"
$(call all-target,$1_$2,$$($1_$2_GHCI_LIB))
endif
endif
endef
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment