Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
c96022cb
Commit
c96022cb
authored
Jan 13, 2012
by
Simon Peyton Jones
Browse files
Merge branch 'master' of
http://darcs.haskell.org/ghc
parents
a30c2df5
cea63079
Changes
9
Expand all
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
c96022cb
...
...
@@ -125,6 +125,8 @@ _darcs/
/docs/users_guide/ug-book.xml
/docs/users_guide/ug-ent.xml
/docs/users_guide/users_guide.xml
/docs/users_guide/users_guide.pdf
/docs/users_guide/users_guide.ps
/docs/users_guide/users_guide/
/docs/users_guide/what_glasgow_exts_does.gen.xml
/driver/ghc/dist/
...
...
@@ -182,6 +184,7 @@ _darcs/
/libraries/time/
/libraries/*/dist-boot/
/libraries/*/dist-install/
/libraries/dist-haddock/
/mk/are-validating.mk
/mk/build.mk
/mk/config.h
...
...
compiler/llvmGen/LlvmCodeGen.hs
View file @
c96022cb
...
...
@@ -37,7 +37,7 @@ llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO ()
llvmCodeGen
dflags
h
us
cmms
=
let
cmm
=
concat
cmms
(
cdata
,
env
)
=
{-# SCC "llvm_split" #-}
foldr
split
(
[]
,
initLlvmEnv
(
targetPlatform
dflags
)
)
cmm
foldr
split
(
[]
,
initLlvmEnv
dflags
)
cmm
split
(
CmmData
s
d'
)
(
d
,
e
)
=
((
s
,
d'
)
:
d
,
e
)
split
(
CmmProc
i
l
_
)
(
d
,
e
)
=
let
lbl
=
strCLabel_llvm
env
$
case
i
of
...
...
compiler/llvmGen/LlvmCodeGen/Base.hs
View file @
c96022cb
...
...
@@ -13,7 +13,7 @@ module LlvmCodeGen.Base (
LlvmEnv
,
initLlvmEnv
,
clearVars
,
varLookup
,
varInsert
,
funLookup
,
funInsert
,
getLlvmVer
,
setLlvmVer
,
getLlvmPlatform
,
ghcInternalFunctions
,
getDflags
,
ghcInternalFunctions
,
cmmToLlvmType
,
widthToLlvmFloat
,
widthToLlvmInt
,
llvmFunTy
,
llvmFunSig
,
llvmStdFunAttrs
,
llvmFunAlign
,
llvmInfAlign
,
...
...
@@ -32,6 +32,7 @@ import CLabel
import
CgUtils
(
activeStgRegs
)
import
Config
import
Constants
import
DynFlags
import
FastString
import
OldCmm
import
qualified
Outputable
as
Outp
...
...
@@ -150,12 +151,13 @@ defaultLlvmVersion = 28
--
-- two maps, one for functions and one for local vars.
newtype
LlvmEnv
=
LlvmEnv
(
LlvmEnvMap
,
LlvmEnvMap
,
LlvmVersion
,
Platform
)
newtype
LlvmEnv
=
LlvmEnv
(
LlvmEnvMap
,
LlvmEnvMap
,
LlvmVersion
,
DynFlags
)
type
LlvmEnvMap
=
UniqFM
LlvmType
-- | Get initial Llvm environment.
initLlvmEnv
::
Platform
->
LlvmEnv
initLlvmEnv
platform
=
LlvmEnv
(
initFuncs
,
emptyUFM
,
defaultLlvmVersion
,
platform
)
initLlvmEnv
::
DynFlags
->
LlvmEnv
initLlvmEnv
dflags
=
LlvmEnv
(
initFuncs
,
emptyUFM
,
defaultLlvmVersion
,
dflags
)
where
initFuncs
=
listToUFM
$
[
(
n
,
LMFunction
ty
)
|
(
n
,
ty
)
<-
ghcInternalFunctions
]
-- | Here we pre-initialise some functions that are used internally by GHC
...
...
@@ -211,7 +213,11 @@ setLlvmVer n (LlvmEnv (e1, e2, _, p)) = LlvmEnv (e1, e2, n, p)
-- | Get the platform we are generating code for
getLlvmPlatform
::
LlvmEnv
->
Platform
getLlvmPlatform
(
LlvmEnv
(
_
,
_
,
_
,
p
))
=
p
getLlvmPlatform
(
LlvmEnv
(
_
,
_
,
_
,
d
))
=
targetPlatform
d
-- | Get the DynFlags for this compilation pass
getDflags
::
LlvmEnv
->
DynFlags
getDflags
(
LlvmEnv
(
_
,
_
,
_
,
d
))
=
d
-- ----------------------------------------------------------------------------
-- * Label handling
...
...
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @
c96022cb
...
...
@@ -16,13 +16,14 @@ import CgUtils ( activeStgRegs, callerSaves )
import
CLabel
import
OldCmm
import
qualified
OldPprCmm
as
PprCmm
import
OrdList
import
DynFlags
import
FastString
import
ForeignCall
import
Outputable
hiding
(
panic
,
pprPanic
)
import
qualified
Outputable
import
Platform
import
OrdList
import
UniqSupply
import
Unique
import
Util
...
...
@@ -475,7 +476,7 @@ genJump :: LlvmEnv -> CmmExpr -> Maybe [GlobalReg] -> UniqSM StmtData
-- Call to known function
genJump
env
(
CmmLit
(
CmmLabel
lbl
))
live
=
do
(
env'
,
vf
,
stmts
,
top
)
<-
getHsFunc
env
lbl
(
stgRegs
,
stgStmts
)
<-
funEpilogue
live
(
stgRegs
,
stgStmts
)
<-
funEpilogue
env
live
let
s1
=
Expr
$
Call
TailCall
vf
stgRegs
llvmStdFunAttrs
let
s2
=
Return
Nothing
return
(
env'
,
stmts
`
appOL
`
stgStmts
`
snocOL
`
s1
`
snocOL
`
s2
,
top
)
...
...
@@ -494,7 +495,7 @@ genJump env expr live = do
++
show
(
ty
)
++
")"
(
v1
,
s1
)
<-
doExpr
(
pLift
fty
)
$
Cast
cast
vf
(
pLift
fty
)
(
stgRegs
,
stgStmts
)
<-
funEpilogue
live
(
stgRegs
,
stgStmts
)
<-
funEpilogue
env
live
let
s2
=
Expr
$
Call
TailCall
v1
stgRegs
llvmStdFunAttrs
let
s3
=
Return
Nothing
return
(
env'
,
stmts
`
snocOL
`
s1
`
appOL
`
stgStmts
`
snocOL
`
s2
`
snocOL
`
s3
,
...
...
@@ -550,7 +551,7 @@ genStore env addr@(CmmMachOp (MO_Sub _) [
=
genStore_fast
env
addr
r
(
negate
$
fromInteger
n
)
val
-- generic case
genStore
env
addr
val
=
genStore_slow
env
addr
val
[
top
]
genStore
env
addr
val
=
genStore_slow
env
addr
val
[
other
]
-- | CmmStore operation
-- This is a special case for storing to a global register pointer
...
...
@@ -1032,7 +1033,7 @@ genLoad env e@(CmmMachOp (MO_Sub _) [
=
genLoad_fast
env
e
r
(
negate
$
fromInteger
n
)
ty
-- generic case
genLoad
env
e
ty
=
genLoad_slow
env
e
ty
[
top
]
genLoad
env
e
ty
=
genLoad_slow
env
e
ty
[
other
]
-- | Handle CmmLoad expression.
-- This is a special case for loading from a global register pointer
...
...
@@ -1200,29 +1201,33 @@ funPrologue = concat $ map getReg activeStgRegs
-- | Function epilogue. Load STG variables to use as argument for call.
funEpilogue
::
Maybe
[
GlobalReg
]
->
UniqSM
([
LlvmVar
],
LlvmStatements
)
funEpilogue
Nothing
=
do
-- STG Liveness optimisation done here.
funEpilogue
::
LlvmEnv
->
Maybe
[
GlobalReg
]
->
UniqSM
([
LlvmVar
],
LlvmStatements
)
-- Have information and liveness optimisation is enabled
funEpilogue
env
(
Just
live
)
|
dopt
Opt_RegLiveness
(
getDflags
env
)
=
do
loads
<-
mapM
loadExpr
activeStgRegs
let
(
vars
,
stmts
)
=
unzip
loads
return
(
vars
,
concatOL
stmts
)
where
loadExpr
r
=
do
loadExpr
r
|
r
`
elem
`
alwaysLive
||
r
`
elem
`
live
=
do
let
reg
=
lmGlobalRegVar
r
(
v
,
s
)
<-
doExpr
(
pLower
$
getVarType
reg
)
$
Load
reg
return
(
v
,
unitOL
s
)
loadExpr
r
=
do
let
ty
=
(
pLower
.
getVarType
$
lmGlobalRegVar
r
)
return
(
LMLitVar
$
LMUndefLit
ty
,
unitOL
Nop
)
funEpilogue
(
Just
live
)
=
do
-- don't do liveness optimisation
funEpilogue
_
_
=
do
loads
<-
mapM
loadExpr
activeStgRegs
let
(
vars
,
stmts
)
=
unzip
loads
return
(
vars
,
concatOL
stmts
)
where
loadExpr
r
|
r
`
elem
`
alwaysLive
||
r
`
elem
`
live
=
do
loadExpr
r
=
do
let
reg
=
lmGlobalRegVar
r
(
v
,
s
)
<-
doExpr
(
pLower
$
getVarType
reg
)
$
Load
reg
return
(
v
,
unitOL
s
)
loadExpr
r
=
do
let
ty
=
(
pLower
.
getVarType
$
lmGlobalRegVar
r
)
return
(
LMLitVar
$
LMUndefLit
ty
,
unitOL
Nop
)
-- | A serries of statements to trash all the STG registers.
...
...
compiler/llvmGen/LlvmCodeGen/Regs.hs
View file @
c96022cb
...
...
@@ -4,7 +4,7 @@
module
LlvmCodeGen.Regs
(
lmGlobalRegArg
,
lmGlobalRegVar
,
alwaysLive
,
stgTBAA
,
top
,
base
,
stack
,
heap
,
rx
,
tbaa
,
getTBAA
stgTBAA
,
top
,
base
,
stack
,
heap
,
rx
,
other
,
tbaa
,
getTBAA
)
where
#
include
"HsVersions.h"
...
...
@@ -70,23 +70,30 @@ stgTBAA
,
MetaUnamed
heapN
[
MetaStr
(
fsLit
"heap"
),
MetaNode
topN
]
,
MetaUnamed
rxN
[
MetaStr
(
fsLit
"rx"
),
MetaNode
heapN
]
,
MetaUnamed
baseN
[
MetaStr
(
fsLit
"base"
),
MetaNode
topN
]
-- FIX: Not 100% sure about 'others' place. Might need to be under 'heap'.
-- OR I think the big thing is Sp is never aliased, so might want
-- to change the hieracy to have Sp on its own branch that is never
-- aliased (e.g never use top as a TBAA node).
,
MetaUnamed
otherN
[
MetaStr
(
fsLit
"other"
),
MetaNode
topN
]
]
-- | Id values
topN
,
stackN
,
heapN
,
rxN
,
baseN
::
LlvmMetaUnamed
topN
,
stackN
,
heapN
,
rxN
,
baseN
,
otherN
::
LlvmMetaUnamed
topN
=
LMMetaUnamed
0
stackN
=
LMMetaUnamed
1
heapN
=
LMMetaUnamed
2
rxN
=
LMMetaUnamed
3
baseN
=
LMMetaUnamed
4
otherN
=
LMMetaUnamed
5
-- | The various TBAA types
top
,
heap
,
stack
,
rx
,
base
::
MetaData
top
,
heap
,
stack
,
rx
,
base
,
other
::
MetaData
top
=
(
tbaa
,
topN
)
heap
=
(
tbaa
,
heapN
)
stack
=
(
tbaa
,
stackN
)
rx
=
(
tbaa
,
rxN
)
base
=
(
tbaa
,
baseN
)
other
=
(
tbaa
,
otherN
)
-- | The TBAA metadata identifier
tbaa
::
LMString
...
...
compiler/main/DriverPipeline.hs
View file @
c96022cb
...
...
@@ -1306,15 +1306,18 @@ runPhase SplitAs _input_fn dflags
runPhase
LlvmOpt
input_fn
dflags
=
do
let
lo_opts
=
getOpts
dflags
opt_lo
let
opt_lvl
=
max
0
(
min
2
$
optLevel
dflags
)
-- don't specify anything if user has specified commands. We do this for
-- opt but not llc since opt is very specifically for optimisation passes
-- only, so if the user is passing us extra options we assume they know
-- what they are doing and don't get in the way.
let
optFlag
=
if
null
lo_opts
then
[
SysTools
.
Option
(
llvmOpts
!!
opt_lvl
)]
else
[]
let
lo_opts
=
getOpts
dflags
opt_lo
opt_lvl
=
max
0
(
min
2
$
optLevel
dflags
)
-- don't specify anything if user has specified commands. We do this
-- for opt but not llc since opt is very specifically for optimisation
-- passes only, so if the user is passing us extra options we assume
-- they know what they are doing and don't get in the way.
optFlag
=
if
null
lo_opts
then
[
SysTools
.
Option
(
llvmOpts
!!
opt_lvl
)]
else
[]
tbaa
|
dopt
Opt_LlvmTBAA
dflags
=
"--enable-tbaa=true"
|
otherwise
=
"--enable-tbaa=false"
output_fn
<-
phaseOutputFilename
LlvmLlc
...
...
@@ -1323,6 +1326,7 @@ runPhase LlvmOpt input_fn dflags
SysTools
.
Option
"-o"
,
SysTools
.
FileOption
""
output_fn
]
++
optFlag
++
[
SysTools
.
Option
tbaa
]
++
map
SysTools
.
Option
lo_opts
)
return
(
LlvmLlc
,
output_fn
)
...
...
@@ -1341,6 +1345,8 @@ runPhase LlvmLlc input_fn dflags
rmodel
|
opt_PIC
=
"pic"
|
not
opt_Static
=
"dynamic-no-pic"
|
otherwise
=
"static"
tbaa
|
dopt
Opt_LlvmTBAA
dflags
=
"--enable-tbaa=true"
|
otherwise
=
"--enable-tbaa=false"
-- hidden debugging flag '-dno-llvm-mangler' to skip mangling
let
next_phase
=
case
dopt
Opt_NoLlvmMangler
dflags
of
...
...
@@ -1356,6 +1362,7 @@ runPhase LlvmLlc input_fn dflags
SysTools
.
FileOption
""
input_fn
,
SysTools
.
Option
"-o"
,
SysTools
.
FileOption
""
output_fn
]
++
map
SysTools
.
Option
lc_opts
++
[
SysTools
.
Option
tbaa
]
++
map
SysTools
.
Option
fpOpts
)
return
(
next_phase
,
output_fn
)
...
...
@@ -1373,7 +1380,7 @@ runPhase LlvmLlc input_fn dflags
else
if
(
elem
VFPv3D16
ext
)
then
[
"-mattr=+v7,+vfp3,+d16"
]
else
[]
_
->
[]
_
->
[]
-----------------------------------------------------------------------------
-- LlvmMangle phase
...
...
compiler/main/DynFlags.hs
View file @
c96022cb
...
...
@@ -250,6 +250,8 @@ data DynFlag
|
Opt_RegsGraph
-- do graph coloring register allocation
|
Opt_RegsIterative
-- do iterative coalescing graph coloring register allocation
|
Opt_PedanticBottoms
-- Be picky about how we treat bottom
|
Opt_LlvmTBAA
-- Use LLVM TBAA infastructure for improving AA
|
Opt_RegLiveness
-- Use the STG Reg liveness information
-- Interface files
|
Opt_IgnoreInterfacePragmas
...
...
@@ -1823,6 +1825,8 @@ fFlags = [
(
"vectorise"
,
Opt_Vectorise
,
nop
),
(
"regs-graph"
,
Opt_RegsGraph
,
nop
),
(
"regs-iterative"
,
Opt_RegsIterative
,
nop
),
(
"llvm-tbaa"
,
Opt_LlvmTBAA
,
nop
),
(
"reg-liveness"
,
Opt_RegLiveness
,
nop
),
(
"gen-manifest"
,
Opt_GenManifest
,
nop
),
(
"embed-manifest"
,
Opt_EmbedManifest
,
nop
),
(
"ext-core"
,
Opt_EmitExternalCore
,
nop
),
...
...
@@ -2071,6 +2075,8 @@ optLevelFlags
,
([
2
],
Opt_LiberateCase
)
,
([
2
],
Opt_SpecConstr
)
,
([
2
],
Opt_RegsGraph
)
,
([
0
,
1
,
2
],
Opt_LlvmTBAA
)
,
([
0
,
1
,
2
],
Opt_RegLiveness
)
-- , ([2], Opt_StaticArgumentTransformation)
-- Max writes: I think it's probably best not to enable SAT with -O2 for the
...
...
docs/users_guide/flags.xml
View file @
c96022cb
This diff is collapsed.
Click to expand it.
ghc.mk
View file @
c96022cb
...
...
@@ -1037,20 +1037,29 @@ publish-docs:
#
# Directory in which we're going to build the src dist
#
SRC_DIST_NAME
=
ghc-
$(ProjectVersion)
SRC_DIST_DIR
=
$(SRC_DIST_NAME)
SRC_DIST_ROOT
=
sdistprep
SRC_DIST_BASE_NAME
=
ghc-
$(ProjectVersion)
SRC_DIST_GHC_NAME
=
ghc-
$(ProjectVersion)
SRC_DIST_GHC_ROOT
=
$(SRC_DIST_ROOT)
/ghc
SRC_DIST_GHC_DIR
=
$(SRC_DIST_GHC_ROOT)
/
$(SRC_DIST_BASE_NAME)
SRC_DIST_GHC_TARBALL
=
$(SRC_DIST_ROOT)
/
$(SRC_DIST_GHC_NAME)
-src
.tar.bz2
SRC_DIST_TESTSUITE_NAME
=
testsuite-ghc-
$(ProjectVersion)
SRC_DIST_TESTSUITE_ROOT
=
$(SRC_DIST_ROOT)
/testsuite-ghc
SRC_DIST_TESTSUITE_DIR
=
$(SRC_DIST_TESTSUITE_ROOT)
/
$(SRC_DIST_BASE_NAME)
SRC_DIST_TESTSUITE_TARBALL
=
$(SRC_DIST_ROOT)
/
$(SRC_DIST_TESTSUITE_NAME)
-src
.tar.bz2
#
# Files to include in source distributions
#
SRC_DIST_DIRS
=
mk rules docs distrib bindisttest libffi includes utils docs rts compiler ghc driver libraries ghc-tarballs
SRC_DIST_FILES
+=
\
configure.ac config.guess config.sub configure
\
aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh
\
ghc.spec.in ghc.spec settings.in VERSION
\
boot boot-pkgs packages ghc.mk
SRC_DIST_TARBALL
=
$(SRC_DIST_NAME)
-src
.tar.bz2
SRC_DIST_GHC_DIRS
=
mk rules docs distrib bindisttest libffi includes
\
utils docs rts compiler ghc driver libraries ghc-tarballs
SRC_DIST_GHC_FILES
+=
\
configure.ac config.guess config.sub configure
\
aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh
\
ghc.spec.in ghc.spec settings.in VERSION
\
boot boot-pkgs packages ghc.mk
VERSION
:
echo
$(ProjectVersion)
>
VERSION
...
...
@@ -1058,50 +1067,66 @@ VERSION :
sdist
:
VERSION
# Use:
# $(call sdist_file,compiler,stage2,cmm,Foo/Bar,CmmLex,x)
# $(call sdist_
ghc_
file,compiler,stage2,cmm,Foo/Bar,CmmLex,x)
# to copy the generated file that replaces compiler/cmm/Foo/Bar/CmmLex.x, where
# "stage2" is the dist dir.
define
sdist_file
"$(CP)"
$1/$2/build/$4/$5.hs
$(SRC_DIST_DIR)/$1/$3/$4
mv
$(SRC_DIST_DIR)/$1/$3/$4/$5.$6
$(SRC_DIST_DIR)/$1/$3/$4/$5.$6.source
define
sdist_
ghc_
file
"$(CP)"
$1/$2/build/$4/$5.hs
$(SRC_DIST_
GHC_
DIR)/$1/$3/$4
mv
$(SRC_DIST_
GHC_
DIR)/$1/$3/$4/$5.$6
$(SRC_DIST_
GHC_
DIR)/$1/$3/$4/$5.$6.source
endef
.PHONY
:
sdist-prep
sdist-prep
:
$(
call
removeTrees,
$(SRC_DIST_DIR)
)
$(
call
removeFiles,
$(SRC_DIST_TARBALL)
)
mkdir
$(SRC_DIST_DIR)
cd
$(SRC_DIST_DIR)
&&
for
i
in
$(SRC_DIST_DIRS)
;
do
mkdir
$$
i
;
(
cd
$$
i
&&
lndir
$(TOP)
/
$$
i
)
;
done
cd
$(SRC_DIST_DIR)
&&
for
i
in
$(SRC_DIST_FILES)
;
do
$(LN_S)
$(TOP)
/
$$
i .
;
done
cd
$(SRC_DIST_DIR)
&&
$(MAKE)
distclean
$(
call
removeTrees,
$(SRC_DIST_DIR)
/libraries/tarballs/
)
$(
call
removeTrees,
$(SRC_DIST_DIR)
/libraries/stamp/
)
$(
call
sdist_file,compiler,stage2,cmm,,CmmLex,x
)
$(
call
sdist_file,compiler,stage2,cmm,,CmmParse,y
)
$(
call
sdist_file,compiler,stage2,parser,,Lexer,x
)
$(
call
sdist_file,compiler,stage2,parser,,Parser,y.pp
)
$(
call
sdist_file,compiler,stage2,parser,,ParserCore,y
)
$(
call
sdist_file,utils/hpc,dist-install,,,HpcParser,y
)
$(
call
sdist_file,utils/genprimopcode,dist,,,Lexer,x
)
$(
call
sdist_file,utils/genprimopcode,dist,,,Parser,y
)
$(
call
sdist_file,utils/haddock,dist,src,Haddock,Lex,x
)
$(
call
sdist_file,utils/haddock,dist,src,Haddock,Parse,y
)
cd
$(SRC_DIST_DIR)
&&
$(
call
removeTrees,compiler/stage[123] mk/build.mk
)
cd
$(SRC_DIST_DIR)
&&
"
$(FIND)
"
$(SRC_DIST_DIRS)
\(
-name
.git
-o
-name
"autom4te*"
-o
-name
"*~"
-o
-name
"
\#
*"
-o
-name
".
\#
*"
-o
-name
"log"
-o
-name
"*-SAVE"
-o
-name
"*.orig"
-o
-name
"*.rej"
\)
-print
|
"
$(XARGS)
"
$(XARGS_OPTS)
"
$(RM)
"
$(RM_OPTS_REC)
.PHONY
:
sdist-ghc-prep
sdist-ghc-prep
:
$(
call
removeTrees,
$(SRC_DIST_GHC_ROOT)
)
$(
call
removeFiles,
$(SRC_DIST_GHC_TARBALL)
)
-
mkdir
$(SRC_DIST_ROOT)
mkdir
$(SRC_DIST_GHC_ROOT)
mkdir
$(SRC_DIST_GHC_DIR)
cd
$(SRC_DIST_GHC_DIR)
&&
for
i
in
$(SRC_DIST_GHC_DIRS)
;
do
mkdir
$$
i
;
(
cd
$$
i
&&
lndir
$(TOP)
/
$$
i
)
;
done
cd
$(SRC_DIST_GHC_DIR)
&&
for
i
in
$(SRC_DIST_GHC_FILES)
;
do
$(LN_S)
$(TOP)
/
$$
i .
;
done
cd
$(SRC_DIST_GHC_DIR)
&&
$(MAKE)
distclean
$(
call
removeTrees,
$(SRC_DIST_GHC_DIR)
/libraries/tarballs/
)
$(
call
removeTrees,
$(SRC_DIST_GHC_DIR)
/libraries/stamp/
)
$(
call
removeTrees,
$(SRC_DIST_GHC_DIR)
/compiler/stage[123]
)
$(
call
removeFiles,
$(SRC_DIST_GHC_DIR)
/mk/build.mk
)
$(
call
sdist_ghc_file,compiler,stage2,cmm,,CmmLex,x
)
$(
call
sdist_ghc_file,compiler,stage2,cmm,,CmmParse,y
)
$(
call
sdist_ghc_file,compiler,stage2,parser,,Lexer,x
)
$(
call
sdist_ghc_file,compiler,stage2,parser,,Parser,y.pp
)
$(
call
sdist_ghc_file,compiler,stage2,parser,,ParserCore,y
)
$(
call
sdist_ghc_file,utils/hpc,dist-install,,,HpcParser,y
)
$(
call
sdist_ghc_file,utils/genprimopcode,dist,,,Lexer,x
)
$(
call
sdist_ghc_file,utils/genprimopcode,dist,,,Parser,y
)
$(
call
sdist_ghc_file,utils/haddock,dist,src,Haddock,Lex,x
)
$(
call
sdist_ghc_file,utils/haddock,dist,src,Haddock,Parse,y
)
cd
$(SRC_DIST_GHC_DIR)
&&
"
$(FIND)
"
$(SRC_DIST_GHC_DIRS)
\(
-name
.git
-o
-name
"autom4te*"
-o
-name
"*~"
-o
-name
"
\#
*"
-o
-name
".
\#
*"
-o
-name
"log"
-o
-name
"*-SAVE"
-o
-name
"*.orig"
-o
-name
"*.rej"
\)
-print
|
"
$(XARGS)
"
$(XARGS_OPTS)
"
$(RM)
"
$(RM_OPTS_REC)
.PHONY
:
sdist-testsuite-prep
sdist-testsuite-prep
:
$(
call
removeTrees,
$(SRC_DIST_TESTSUITE_ROOT)
)
$(
call
removeFiles,
$(SRC_DIST_TESTSUITE_TARBALL)
)
-
mkdir
$(SRC_DIST_ROOT)
mkdir
$(SRC_DIST_TESTSUITE_ROOT)
mkdir
$(SRC_DIST_TESTSUITE_DIR)
mkdir
$(SRC_DIST_TESTSUITE_DIR)
/testsuite
cd
$(SRC_DIST_TESTSUITE_DIR)
/testsuite
&&
lndir
$(TOP)
/testsuite
$(
call
removeTrees,
$(SRC_DIST_TESTSUITE_DIR)
/testsuite/.git
)
.PHONY
:
sdist
sdist
:
sdist-prep
"
$(TAR_CMD)
"
chf -
$(SRC_DIST_NAME)
2>src_log | bzip2
>
$(TOP)
/
$(SRC_DIST_TARBALL)
sdist
:
sdist-ghc-prep sdist-testsuite-prep
cd
$(SRC_DIST_GHC_ROOT)
&&
"
$(TAR_CMD)
"
chf -
$(SRC_DIST_BASE_NAME)
2> src_ghc_log | bzip2
>
$(TOP)
/
$(SRC_DIST_GHC_TARBALL)
cd
$(SRC_DIST_TESTSUITE_ROOT)
&&
"
$(TAR_CMD)
"
chf -
$(SRC_DIST_BASE_NAME)
2> src_ghc_log | bzip2
>
$(TOP)
/
$(SRC_DIST_TESTSUITE_TARBALL)
sdist-manifest
:
$(SRC_DIST_TARBALL)
tar
tjf
$(SRC_DIST_TARBALL)
|
sed
"s|^ghc-
$(ProjectVersion)
/||"
|
sort
>
sdist-manifest
sdist-manifest
:
$(SRC_DIST_
GHC_
TARBALL)
tar
tjf
$(SRC_DIST_
GHC_
TARBALL)
|
sed
"s|^ghc-
$(ProjectVersion)
/||"
|
sort
>
sdist-manifest
# Upload the distribution(s)
# Retrying is to work around buggy firewalls that corrupt large file transfers
# over SSH.
ifneq
"$(PublishLocation)" ""
publish-sdist
:
$(
call
try10Times,
$(PublishCp)
$(SRC_DIST_TARBALL)
$(PublishLocation)
/dist
)
$(
call
try10Times,
$(PublishCp)
$(SRC_DIST_GHC_TARBALL)
$(PublishLocation)
/dist
)
$(
call
try10Times,
$(PublishCp)
$(SRC_DIST_TESTSUITE_TARBALL)
$(PublishLocation)
/dist
)
endif
ifeq
"$(BootingFromHc)" "YES"
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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