Commit 6bdac1c3 authored by ian@well-typed.com's avatar ian@well-typed.com

Make nativeCodeGen return the rest of its UniqSupply

parent d842dffa
......@@ -83,7 +83,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
; return stubs_exist
}
doOutput :: String -> (Handle -> IO ()) -> IO ()
doOutput :: String -> (Handle -> IO a) -> IO a
doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
\end{code}
......@@ -144,9 +144,10 @@ outputAsm dflags filenm cmm_stream
| cGhcWithNativeCodeGen == "YES"
= do ncg_uniqs <- mkSplitUniqSupply 'n'
{-# SCC "OutputAsm" #-} doOutput filenm $
_ <- {-# SCC "OutputAsm" #-} doOutput filenm $
\f -> {-# SCC "NativeCodeGen" #-}
nativeCodeGen dflags f ncg_uniqs cmm_stream
return ()
| otherwise
= panic "This compiler was built without a native code generator"
......
......@@ -151,10 +151,11 @@ data NcgImpl statics instr jumpDest = NcgImpl {
}
--------------------
nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> Stream IO RawCmmGroup () -> IO ()
nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> Stream IO RawCmmGroup ()
-> IO UniqSupply
nativeCodeGen dflags h us cmms
= let platform = targetPlatform dflags
nCG' :: (Outputable statics, Outputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO ()
nCG' :: (Outputable statics, Outputable instr, Instruction instr) => NcgImpl statics instr jumpDest -> IO UniqSupply
nCG' ncgImpl = nativeCodeGen' dflags ncgImpl h us cmms
x86NcgImpl = NcgImpl {
cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen
......@@ -239,7 +240,7 @@ noAllocMoreStack amount _
nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
=> DynFlags
-> NcgImpl statics instr jumpDest
-> Handle -> UniqSupply -> Stream IO RawCmmGroup () -> IO ()
-> Handle -> UniqSupply -> Stream IO RawCmmGroup () -> IO UniqSupply
nativeCodeGen' dflags ncgImpl h us cmms
= do
let platform = targetPlatform dflags
......@@ -248,7 +249,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
-- Pretty if it weren't for the fact that we do lots of little
-- printDocs here (in order to do codegen in constant space).
bufh <- newBufHandle h
(imports, prof) <- cmmNativeGenStream dflags ncgImpl bufh us split_cmms [] [] 0
(imports, prof, us') <- cmmNativeGenStream dflags ncgImpl bufh us split_cmms [] [] 0
bFlush bufh
let (native, colorStats, linearStats)
......@@ -293,7 +294,7 @@ nativeCodeGen' dflags ncgImpl h us cmms
$ withPprStyleDoc dflags (mkCodeStyle AsmStyle)
$ makeImportsDoc dflags (concat imports)
return ()
return us'
where add_split tops
| gopt Opt_SplitObjs dflags = split_marker : tops
......@@ -316,13 +317,14 @@ cmmNativeGenStream :: (Outputable statics, Outputable instr, Instruction instr)
-> IO ( [[CLabel]],
[([NatCmmDecl statics instr],
Maybe [Color.RegAllocStats statics instr],
Maybe [Linear.RegAllocStats])] )
Maybe [Linear.RegAllocStats])],
UniqSupply )
cmmNativeGenStream dflags ncgImpl h us cmm_stream impAcc profAcc count
= do
r <- Stream.runStream cmm_stream
case r of
Left () -> return (reverse impAcc, reverse profAcc)
Left () -> return (reverse impAcc, reverse profAcc, us)
Right (cmms, cmm_stream') -> do
(impAcc,profAcc,us') <- cmmNativeGens dflags ncgImpl h us cmms
impAcc profAcc count
......
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