Commit ea94a66d authored by dreixel's avatar dreixel
Browse files

Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics

Fixed conflicts:
	compiler/iface/IfaceSyn.lhs
	compiler/typecheck/TcSMonad.lhs
parents ffabe3ac 51fd4a1d
......@@ -45,7 +45,7 @@ endif
include mk/custom-settings.mk
# No need to update makefiles for these targets:
REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framework-pkg clean clean_% distclean maintainer-clean show help install-docs test fulltest,$(MAKECMDGOALS))
REALGOALS=$(filter-out binary-dist binary-dist-prep bootstrapping-files framework-pkg clean clean_% distclean maintainer-clean show help test fulltest,$(MAKECMDGOALS))
# configure touches certain files even if they haven't changed. This
# can mean a lot of unnecessary recompilation after a re-configure, so
......@@ -102,12 +102,6 @@ framework-pkg:
$(MAKE) -C distrib/MacOS $@
endif
# install-docs is a historical target that isn't supported in GHC 6.12. See #3662.
install-docs:
@echo "The install-docs target is not supported in GHC 6.12.1 and later."
@echo "'make install' now installs everything, including documentation."
@exit 1
# If the user says 'make A B', then we don't want to invoke two
# instances of the rule above in parallel:
.NOTPARALLEL:
......
......@@ -1031,18 +1031,6 @@ AC_SUBST([FopCmd])
])# FP_PROG_FOP
# FP_PROG_HSTAGS
# ----------------
# Sets the output variable HstagsCmd to the full Haskell tags program path.
# HstagsCmd is empty if no such program could be found.
AC_DEFUN([FP_PROG_HSTAGS],
[AC_PATH_PROG([HstagsCmd], [hasktags])
if test -z "$HstagsCmd"; then
AC_MSG_WARN([cannot find hasktags in your PATH, you will not be able to build the tags])
fi
])# FP_PROG_HSTAGS
# FP_PROG_GHC_PKG
# ----------------
# Try to find a ghc-pkg matching the ghc mentioned in the environment variable
......
......@@ -137,8 +137,7 @@ data Var
-- Identical to the Unique in the name,
-- cached here for speed
varType :: Kind, -- ^ The type or kind of the 'Var' in question
isCoercionVar :: Bool
}
isCoercionVar :: Bool }
| TcTyVar { -- Used only during type inference
-- Used for kind variables during
......
......@@ -110,8 +110,7 @@ type EqnSet = UniqSet EqnNo
check :: [EquationInfo] -> ([ExhaustivePat], [EquationInfo])
-- Second result is the shadowed equations
-- if there are view patterns, just give up - don't know what the function is
check qs = pprTrace "check" (ppr tidy_qs) $
(untidy_warns, shadowed_eqns)
check qs = (untidy_warns, shadowed_eqns)
where
tidy_qs = map tidy_eqn qs
(warns, used_nos) = check' ([1..] `zip` tidy_qs)
......
This diff is collapsed.
......@@ -122,34 +122,25 @@ pprInfoTable env count lbl stat
then Outputable.panic "LlvmCodeGen.Ppr: invalid info table!"
else (pprLlvmData ([ldata'], ltypes), llvmUsed)
-- | We generate labels for info tables by converting them to the same label
-- as for the entry code but adding this string as a suffix.
iTableSuf :: String
iTableSuf = "_itable"
-- | Create an appropriate section declaration for subsection <n> of text
-- WARNING: This technique could fail as gas documentation says it only
-- supports up to 8192 subsections per section. Inspection of the source
-- code and some test programs seem to suggest it supports more than this
-- so we are hoping it does.
-- | Create a specially crafted section declaration that encodes the order this
-- section should be in the final object code.
--
-- The LlvmMangler.llvmFixupAsm pass over the assembly produced by LLVM uses
-- this section declaration to do its processing.
mkLayoutSection :: Int -> LMSection
mkLayoutSection n
-- On OSX we can't use the GNU Assembler, we must use the OSX assembler, which
-- doesn't support subsections. So we post process the assembly code, this
-- section specifier will be replaced with '.text' by the mangler.
= Just (fsLit $ infoSection ++ show n
#if darwin_TARGET_OS
)
#else
++ "#")
#endif
= Just (fsLit $ infoSection ++ show n)
-- | The section we are putting info tables and their entry code into
-- | The section we are putting info tables and their entry code into, should
-- be unique since we process the assembly pattern matching this.
infoSection :: String
#if darwin_TARGET_OS
infoSection = "__STRIP,__me"
#else
infoSection = ".text; .text "
#endif
infoSection = "X98A__STRIP,__me"
{-# OPTIONS -fno-warn-unused-binds #-}
-- -----------------------------------------------------------------------------
-- | GHC LLVM Mangler
--
-- This script processes the assembly produced by LLVM, rearranging the code
-- so that an info table appears before its corresponding function. We also
-- use it to fix up the stack alignment, which needs to be 16 byte aligned
-- but always ends up off by 4 bytes because GHC sets it to the 'wrong'
-- starting value in the RTS.
-- so that an info table appears before its corresponding function.
--
-- We only need this for Mac OS X, other targets don't use it.
-- On OSX we also use it to fix up the stack alignment, which needs to be 16
-- byte aligned but always ends up off by word bytes because GHC sets it to
-- the 'wrong' starting value in the RTS.
--
module LlvmMangler ( llvmFixupAsm ) where
#include "HsVersions.h"
import LlvmCodeGen.Ppr ( infoSection )
import Control.Exception
import qualified Data.ByteString.Char8 as B
import Data.Char
......@@ -19,18 +23,25 @@ import qualified Data.IntMap as I
import System.IO
-- Magic Strings
infoSec, newInfoSec, newLine, spInst, jmpInst :: B.ByteString
infoSec = B.pack "\t.section\t__STRIP,__me"
secStmt, infoSec, newInfoSec, newLine, spInst, jmpInst :: B.ByteString
secStmt = B.pack "\t.section\t"
infoSec = B.pack infoSection
newInfoSec = B.pack "\n\t.text"
newLine = B.pack "\n"
spInst = B.pack ", %esp\n"
jmpInst = B.pack "\n\tjmp"
infoLen, spFix, labelStart :: Int
infoLen = B.length infoSec
spFix = 4
infoLen, labelStart, spFix :: Int
infoLen = B.length infoSec
labelStart = B.length jmpInst
#if x86_64_TARGET_ARCH
spInst = B.pack ", %rsp\n"
spFix = 8
#else
spInst = B.pack ", %esp\n"
spFix = 4
#endif
-- Search Predicates
eolPred, dollarPred, commaPred :: Char -> Bool
eolPred = ((==) '\n')
......@@ -50,25 +61,30 @@ llvmFixupAsm f1 f2 = do
{- |
Here we process the assembly file one function and data
defenition at a time. When a function is encountered that
definition at a time. When a function is encountered that
should have a info table we store it in a map. Otherwise
we print it. When an info table is found we retrieve its
function from the map and print them both.
For all functions we fix up the stack alignment. We also
fix up the section defenition for functions and info tables.
fix up the section definition for functions and info tables.
-}
fixTables :: Handle -> Handle -> I.IntMap B.ByteString -> IO ()
fixTables r w m = do
f <- getFun r B.empty
if B.null f
then return ()
else let fun = fixupStack f B.empty
(a,b) = B.breakSubstring infoSec fun
(x,c) = B.break eolPred b
fun' = a `B.append` newInfoSec `B.append` c
n = readInt $ B.drop infoLen x
(bs, m') | B.null b = ([fun], m)
else let fun = fixupStack f B.empty
(a,b) = B.breakSubstring infoSec fun
(a',s) = B.breakEnd eolPred a
-- We search for the section header in two parts as it makes
-- us portable across OS types and LLVM version types since
-- section names are wrapped differently.
secHdr = secStmt `B.isPrefixOf` s
(x,c) = B.break eolPred b
fun' = a' `B.append` newInfoSec `B.append` c
n = readInt $ B.takeWhile isDigit $ B.drop infoLen x
(bs, m') | B.null b || not secHdr = ([fun], m)
| even n = ([], I.insert n fun' m)
| otherwise = case I.lookup (n+1) m of
Just xf' -> ([fun',xf'], m)
......@@ -88,7 +104,7 @@ getFun r f = do
Mac OS X requires that the stack be 16 byte aligned when making a function
call (only really required though when making a call that will pass through
the dynamic linker). The alignment isn't correctly generated by LLVM as
LLVM rightly assumes that the stack wil be aligned to 16n + 12 on entry
LLVM rightly assumes that the stack will be aligned to 16n + 12 on entry
(since the function call was 16 byte aligned and the return address should
have been pushed, so sub 4). GHC though since it always uses jumps keeps
the stack 16 byte aligned on both function calls and function entry.
......@@ -96,6 +112,11 @@ getFun r f = do
We correct the alignment here.
-}
fixupStack :: B.ByteString -> B.ByteString -> B.ByteString
#if !darwin_TARGET_OS
fixupStack = const
#else
fixupStack f f' | B.null f' =
let -- fixup sub op
(a, c) = B.breakSubstring spInst f
......@@ -124,10 +145,11 @@ fixupStack f f' =
then fixupStack b $ f' `B.append` a `B.append` l
else fixupStack b $ f' `B.append` a' `B.append` num `B.append`
x `B.append` l
#endif
-- | read an int or error
-- | Read an int or error
readInt :: B.ByteString -> Int
readInt str | B.all isDigit str = (read . B.unpack) str
| otherwise = error $ "LLvmMangler Cannot read" ++ show str
++ "as it's not an Int"
| otherwise = error $ "LLvmMangler Cannot read " ++ show str
++ " as it's not an Int"
......@@ -143,11 +143,7 @@ nextPhase (Hsc _) = HCc
nextPhase SplitMangle = As
nextPhase As = SplitAs
nextPhase LlvmOpt = LlvmLlc
#if darwin_TARGET_OS
nextPhase LlvmLlc = LlvmMangle
#else
nextPhase LlvmLlc = As
#endif
nextPhase LlvmMangle = As
nextPhase SplitAs = MergeStub
nextPhase Ccpp = As
......
......@@ -1307,22 +1307,18 @@ runPhase LlvmOpt input_fn dflags
-- fix up some pretty big deficiencies in the code we generate
llvmOpts = ["-mem2reg", "-O1", "-O2"]
-----------------------------------------------------------------------------
-- LlvmLlc phase
runPhase LlvmLlc input_fn dflags
= do
let lc_opts = getOpts dflags opt_lc
let opt_lvl = max 0 (min 2 $ optLevel dflags)
let nphase = if cTargetOS == OSX
then LlvmMangle
else As
let rmodel | opt_PIC = "pic"
opt_lvl = max 0 (min 2 $ optLevel dflags)
rmodel | opt_PIC = "pic"
| not opt_Static = "dynamic-no-pic"
| otherwise = "static"
output_fn <- phaseOutputFilename nphase
output_fn <- phaseOutputFilename LlvmMangle
io $ SysTools.runLlvmLlc dflags
([ SysTools.Option (llvmOpts !! opt_lvl),
......@@ -1331,13 +1327,13 @@ runPhase LlvmLlc input_fn dflags
SysTools.Option "-o", SysTools.FileOption "" output_fn]
++ map SysTools.Option lc_opts)
return (nphase, output_fn)
return (LlvmMangle, output_fn)
where
-- Bug in LLVM at O3 on OSX.
llvmOpts = if cTargetOS == OSX
then ["-O1", "-O2", "-O2"]
else ["-O1", "-O2", "-O3"]
-----------------------------------------------------------------------------
-- LlvmMangle phase
......
......@@ -1105,12 +1105,13 @@ parseDynamicFlags_ dflags0 args pkg_flags = do
when (not (null errs)) $ ghcError $ errorsToGhcException errs
let (pic_warns, dflags2)
| not (cTargetArch == X86_64 && cTargetOS == Linux) &&
| not (cTargetArch == X86_64 && (cTargetOS == Linux || cTargetOS == OSX)) &&
(not opt_Static || opt_PIC) &&
hscTarget dflags1 == HscLlvm
= ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -"
++ "dynamic on this platform;\n"
++ " using " ++ showHscTargetFlag defaultObjectTarget ++ " instead"],
= ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and "
++ "-dynamic on this platform;\n"
++ " using "
++ showHscTargetFlag defaultObjectTarget ++ " instead"],
dflags1{ hscTarget = defaultObjectTarget })
| otherwise = ([], dflags1)
......
......@@ -15,11 +15,11 @@ module GhcMonad (
reflectGhc, reifyGhc,
getSessionDynFlags,
liftIO,
Session(..), withSession, modifySession, withTempSession,
Session(..), withSession, modifySession, withTempSession,
-- ** Warnings
logWarnings, printException, printExceptionAndWarnings,
WarnErrLogger, defaultWarnErrLogger
WarnErrLogger, defaultWarnErrLogger
) where
import MonadUtils
......
......@@ -238,7 +238,7 @@ initSysTools mbMinusB
ld_prog = gcc_prog
ld_args = gcc_args
-- figure out llvm location. (TODO: Acutally implement).
-- We just assume on command line
; let lc_prog = "llc"
lo_prog = "opt"
......
......@@ -841,9 +841,24 @@ rnParallelStmts ctxt segs thing_inside
lookupStmtName :: HsStmtContext Name -> Name -> RnM (HsExpr Name, FreeVars)
-- Like lookupSyntaxName, but ListComp/PArrComp are never rebindable
lookupStmtName ListComp n = return (HsVar n, emptyFVs)
lookupStmtName PArrComp n = return (HsVar n, emptyFVs)
lookupStmtName _ n = lookupSyntaxName n
-- Neither is ArrowExpr, which has its own desugarer in DsArrows
lookupStmtName ctxt n
= case ctxt of
ListComp -> not_rebindable
PArrComp -> not_rebindable
ArrowExpr -> not_rebindable
PatGuard {} -> not_rebindable
DoExpr -> rebindable
MDoExpr -> rebindable
MonadComp -> rebindable
GhciStmt -> rebindable -- I suppose?
ParStmtCtxt c -> lookupStmtName c n -- Look inside to
TransStmtCtxt c -> lookupStmtName c n -- the parent context
where
rebindable = lookupSyntaxName n
not_rebindable = return (HsVar n, emptyFVs)
\end{code}
Note [Renaming parallel Stmts]
......
......@@ -102,6 +102,7 @@ import FastString
import HsBinds -- for TcEvBinds stuff
import Id
import StaticFlags( opt_PprStyle_Debug )
import TcRnTypes
#ifdef DEBUG
import Control.Monad( when )
......
......@@ -632,8 +632,6 @@ FP_CHECK_DOCBOOK_DTD
FP_DOCBOOK_XSL
FP_PROG_DBLATEX
FP_PROG_HSTAGS
dnl ** check for ghc-pkg command
FP_PROG_GHC_PKG
......
......@@ -177,7 +177,6 @@ fi
%{_prefix}/bin/ghci
%{_prefix}/bin/ghci-%{version}
%{_prefix}/bin/ghcprof
%{_prefix}/bin/hasktags
%{_prefix}/bin/hp2ps
%{_prefix}/bin/hpc
%{_prefix}/bin/hsc2hs-ghc
......
......@@ -774,8 +774,6 @@ ALEX_VERSION = @AlexVersion@
#
SRC_ALEX_OPTS = -g
HSTAGS = @HstagsCmd@
# Should we build haddock docs?
HADDOCK_DOCS = YES
# And HsColour the sources?
......
......@@ -60,7 +60,7 @@ endif
WITH_BOOTSTRAPPING_COMPILER = installPackage ghc-pkg hsc2hs hpc
WITH_STAGE2 = installPackage ghc-pkg hasktags runghc hpc pwd haddock
WITH_STAGE2 = installPackage ghc-pkg runghc hpc pwd haddock
ifneq "$(NO_INSTALL_HSC2HS)" "YES"
WITH_STAGE2 += hsc2hs
endif
......
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