Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
b8384ce5
Commit
b8384ce5
authored
Sep 20, 2010
by
Ian Lynagh
Browse files
Implement archive loading for ghci
parent
a2254812
Changes
9
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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment