Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
ea16a2e5
Commit
ea16a2e5
authored
Jun 20, 2006
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Generate a new unique for each label
parent
b5bf1f9b
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
29 additions
and
17 deletions
+29
-17
compiler/cmm/CmmParse.y
compiler/cmm/CmmParse.y
+29
-17
No files found.
compiler/cmm/CmmParse.y
View file @
ea16a2e5
...
...
@@ -253,7 +253,8 @@ names :: { [FastString] }
stmt :: { ExtCode }
: ';' { nopEC }
| block_id ':' { code (labelC $1) }
| NAME ':'
{ do l <- newLabel $1; code (labelC l) }
| lreg '=' expr ';'
{ do reg <- $1; e <- $3; stmtEC (CmmAssign reg e) }
...
...
@@ -274,8 +275,8 @@ stmt :: { ExtCode }
{% stmtMacro $1 $3 }
| 'switch' maybe_range expr '{' arms default '}'
{ doSwitch $2 $3 $5 $6 }
| 'goto'
block_id
';'
{ stmtEC (CmmBranch
$2
) }
| 'goto'
NAME
';'
{
do l <- lookupLabel $2;
stmtEC (CmmBranch
l
) }
| 'jump' expr {-maybe_actuals-} ';'
{ do e <- $2; stmtEC (CmmJump e []) }
| 'if' bool_expr '{' body '}' else
...
...
@@ -403,13 +404,6 @@ lreg :: { ExtFCode CmmReg }
other -> pprPanic "CmmParse:" (ftext $1 <> text " not a register") }
| GLOBALREG { return (CmmGlobal $1) }
block_id :: { BlockId }
: NAME { BlockId (newTagUnique (getUnique $1) 'L') }
-- TODO: ugh. The unique of a FastString has a null
-- tag, so we have to put our own tag on. We should
-- really make a new unique for every label, and keep
-- them in an environment.
type :: { MachRep }
: 'bits8' { I8 }
| typenot8 { $1 }
...
...
@@ -623,8 +617,9 @@ stmtMacros = listToUFM [
-- to collect declarations as we parse the proc, and feed the environment
-- back in circularly (to avoid a two-pass algorithm).
type Decls = [(FastString,CmmExpr)]
type Env = UniqFM CmmExpr
data Named = Var CmmExpr | Label BlockId
type Decls = [(FastString,Named)]
type Env = UniqFM Named
newtype ExtFCode a = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
...
...
@@ -649,13 +644,30 @@ getEnv :: ExtFCode Env
getEnv = EC $ \e s -> return (s, e)
addVarDecl :: FastString -> CmmExpr -> ExtCode
addVarDecl var expr = EC $ \e s -> return ((var,expr):s, ())
addVarDecl var expr = EC $ \e s -> return ((var, Var expr):s, ())
addLabel :: FastString -> BlockId -> ExtCode
addLabel name block_id = EC $ \e s -> return ((name, Label block_id):s, ())
newLocal :: MachRep -> FastString -> ExtCode
newLocal ty name = do
u <- code newUnique
addVarDecl name (CmmReg (CmmLocal (LocalReg u ty)))
newLabel :: FastString -> ExtFCode BlockId
newLabel name = do
u <- code newUnique
addLabel name (BlockId u)
return (BlockId u)
lookupLabel :: FastString -> ExtFCode BlockId
lookupLabel name = do
env <- getEnv
return $
case lookupUFM env name of
Just (Label l) -> l
_other -> BlockId (newTagUnique (getUnique name) 'L')
-- Unknown names are treated as if they had been 'import'ed.
-- This saves us a lot of bother in the RTS sources, at the expense of
-- deferring some errors to link time.
...
...
@@ -664,8 +676,8 @@ lookupName name = do
env <- getEnv
return $
case lookupUFM env name of
Nothing -> CmmLit (CmmLabel (mkRtsCodeLabelFS name))
Just e -> e
Just (Var e) -> e
_other -> CmmLit (CmmLabel (mkRtsCodeLabelFS name))
-- Lifting FCode computations into the ExtFCode monad:
code :: FCode a -> ExtFCode a
...
...
@@ -865,9 +877,9 @@ doSwitch mb_range scrut arms deflt
initEnv :: Env
initEnv = listToUFM [
( FSLIT("SIZEOF_StgHeader"),
CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep) ),
Var (
CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep)
)
),
( FSLIT("SIZEOF_StgInfoTable"),
CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) )
Var (
CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) )
)
]
parseCmmFile :: DynFlags -> HomeModules -> FilePath -> IO (Maybe Cmm)
...
...
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