1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
{-# LANGUAGE NamedFieldPuns #-}
{-
This funny module was reduced from a failing build of stage2 using
the new code generator and the linear register allocator, with this bug:
"inplace/bin/ghc-stage1" -fPIC -dynamic -H32m -O -Wall -H64m -O0 -package-name ghc-7.1.20110414 -hide-all-packages -i -icompiler/basicTypes -icompiler/cmm -icompiler/codeGen -icompiler/coreSyn -icompiler/deSugar -icompiler/ghci -icompiler/hsSyn -icompiler/iface -icompiler/llvmGen -icompiler/main -icompiler/nativeGen -icompiler/parser -icompiler/prelude -icompiler/profiling -icompiler/rename -icompiler/simplCore -icompiler/simplStg -icompiler/specialise -icompiler/stgSyn -icompiler/stranal -icompiler/typecheck -icompiler/types -icompiler/utils -icompiler/vectorise -icompiler/stage2/build -icompiler/stage2/build/autogen -Icompiler/stage2/build -Icompiler/stage2/build/autogen -Icompiler/../libffi/build/include -Icompiler/stage2 -Icompiler/../libraries/base/cbits -Icompiler/../libraries/base/include -Icompiler/. -Icompiler/parser -Icompiler/utils -optP-DGHCI -optP-include -optPcompiler/stage2/build/autogen/cabal_macros.h -package Cabal-1.11.0 -package array-0.3.0.2 -package base-4.3.1.0 -package bin-package-db-0.0.0.0 -package bytestring-0.9.1.10 -package containers-0.4.0.0 -package directory-1.1.0.0 -package filepath-1.2.0.0 -package hoopl-3.8.7.0 -package hpc-0.5.0.6 -package old-time-1.0.0.6 -package process-1.0.1.4 -package template-haskell-2.5.0.0 -package unix-2.4.1.0 -Wall -fno-warn-name-shadowing -fno-warn-orphans -XHaskell98 -XNondecreasingIndentation -XCPP -XMagicHash -XUnboxedTuples -XPatternGuards -XForeignFunctionInterface -XEmptyDataDecls -XTypeSynonymInstances -XMultiParamTypeClasses -XFlexibleInstances -XRank2Types -XScopedTypeVariables -XDeriveDataTypeable -DGHCI_TABLES_NEXT_TO_CODE -DSTAGE=2 -O2 -O -DGHC_DEFAULT_NEW_CODEGEN -no-user-package-conf -rtsopts -odir compiler/stage2/build -hidir compiler/stage2/build -stubdir compiler/stage2/build -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -c compiler/main/DriverPipeline.hs -o compiler/stage2/build/DriverPipeline.dyn_o -fforce-recomp -dno-debug-output -fno-warn-unused-binds
ghc-stage1: panic! (the 'impossible' happened)
(GHC version 7.1.20110414 for x86_64-unknown-linux):
Cannot patch JMP_TBL
This panic only appears to show up on x86-64 and with -fPIC. I wasn't
able to get the produced optimized C-- to crash the linear register
allocator. To see the bug, you need some extra patches for the new code
generator, in particular, this set (which can be acquired from the
jmp_tbl_bug tag at <https://github.com/ezyang/ghc>):
commit 7b275c93df7944f0a9b51034cf1f64e3e70582a5
Author: Edward Z. Yang <ezyang@mit.edu>
Date: Thu Apr 14 21:20:21 2011 +0100
Give manifestSP better information about the actual SP location.
This patch fixes silliness where the SP pointer is continually
bumped up and down.
Signed-off-by: Edward Z. Yang <ezyang@mit.edu>
commit 5b5add4246d3997670ae995f7d2a028db92fff95
Author: Edward Z. Yang <ezyang@mit.edu>
Date: Wed Apr 13 11:16:36 2011 +0100
Generalized assignment rewriting pass.
This assignment rewriting pass subsumes the previous reload
sinking pass, and also performs basic inlining.
Signed-off-by: Edward Z. Yang <ezyang@mit.edu>
The ostensible cause is that the linear register allocator is getting
really unlucky and needs to insert a fixup block after precisely one
jump in a jump table, because the block it jumps to was processed
already. As you can see, actually getting the linear register allocator
into this funk is /very/ difficult.
-}
module DriverPipeline (compileFile) where
import Control.Exception
data Phase
= Unlit ()
| Ccpp
| Cc
| Cobjc
| HCc
| SplitAs
| As
| LlvmOpt
| LlvmLlc
| LlvmMangle
| MergeStub
| StopLn
deriving (Show)
data PipeState = PipeState {
stop_phase :: Phase,
src_basename :: String,
output_spec :: (),
hsc_env :: Maybe String,
maybe_loc :: Maybe String
}
newtype CompPipeline a = P { unP :: PipeState -> IO (PipeState, a) }
instance Monad CompPipeline where
return a = P $ \state -> return (state, a)
P m >>= k = P $ \state -> do (state',a) <- m state
unP (k a) state'
eqPhase :: Phase -> Phase -> Bool
eqPhase (Unlit _) (Unlit _) = True
eqPhase Ccpp Ccpp = True
eqPhase Cc Cc = True
eqPhase HCc HCc = True
eqPhase SplitAs SplitAs = True
eqPhase As As = True
eqPhase LlvmOpt LlvmOpt = True
eqPhase LlvmLlc LlvmLlc = True
eqPhase LlvmMangle LlvmMangle = True
eqPhase MergeStub MergeStub = True
eqPhase StopLn StopLn = True
eqPhase _ _ = False
compileFile start_phase state = do
unP (pipeLoop start_phase) state
getOutputFilename undefined undefined undefined undefined undefined undefined
pipeLoop phase = do
dflags@PipeState{stop_phase} <- getPipeState
io $ evaluate (phase `eqPhase` stop_phase)
runPhase phase dflags
pipeLoop phase
getOutputFilename :: Phase -> () -> String -> Maybe String -> Phase -> Maybe String -> IO String
getOutputFilename p o b md p' ml
| p' `eqPhase` p, () <- o = undefined
| Just l <- ml = return l
| Just d <- md = return $ d ++ b
| otherwise = undefined
runPhase p _ | p `eqPhase` Cc || p `eqPhase` Ccpp || p `eqPhase` HCc || p `eqPhase` Cobjc = undefined
runPhase LlvmMangle _ = undefined
runPhase SplitAs _ = undefined
runPhase LlvmOpt _ = undefined
runPhase LlvmLlc dflags = phaseOutputFilename >> io (evaluate dflags) >> return undefined
runPhase MergeStub _ = phaseOutputFilename >> undefined
runPhase other _ = io (evaluate (show other)) >> undefined
phaseOutputFilename :: CompPipeline ()
phaseOutputFilename = do
PipeState{stop_phase, src_basename, output_spec, maybe_loc, hsc_env} <- getPipeState
io $ getOutputFilename stop_phase output_spec src_basename hsc_env StopLn maybe_loc
getPipeState = P $ \state -> return (state, state)
io m = P $ \state -> do a <- m; return (state, ())
|
