diff options
Diffstat (limited to 'compiler/llvmGen/LlvmCodeGen.hs')
| -rw-r--r-- | compiler/llvmGen/LlvmCodeGen.hs | 133 |
1 files changed, 46 insertions, 87 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index c4848c90b1..1b1fd96514 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -35,80 +35,54 @@ import System.IO llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO () llvmCodeGen dflags h us cmms = do - let cmm = concat $ map (\(Cmm top) -> top) cmms - bufh <- newBufHandle h Prt.bufLeftRender bufh $ pprLlvmHeader - env <- cmmDataLlvmGens dflags bufh cmm - cmmProcLlvmGens dflags bufh us env cmm 1 [] + env' <- cmmDataLlvmGens dflags bufh env cdata [] + cmmProcLlvmGens dflags bufh us env' cmm 1 [] bFlush bufh return () + where + cmm = concat $ map (\(Cmm top) -> top) cmms + + (cdata,env) = foldr split ([],initLlvmEnv) cmm + + split (CmmData _ d' ) (d,e) = (d':d,e) + split (CmmProc i l _ _) (d,e) = + let lbl = strCLabel_llvm $ if not (null i) + then entryLblToInfoLbl l + else l + env' = funInsert lbl llvmFunTy e + in (d,env') -- ----------------------------------------------------------------------------- -- | Do llvm code generation on all these cmms data sections. -- -cmmDataLlvmGens - :: DynFlags - -> BufHandle - -> [RawCmmTop] - -> IO ( LlvmEnv ) - -cmmDataLlvmGens _ _ [] - = return ( initLlvmEnv ) - -cmmDataLlvmGens dflags h cmm = - let exData (CmmData s d) = [(s,d)] - exData _ = [] - - exProclbl (CmmProc i l _ _) - | not (null i) = [strCLabel_llvm $ entryLblToInfoLbl l] - exProclbl (CmmProc _ l _ _) | otherwise = [strCLabel_llvm l] - exProclbl _ = [] - - cproc = concat $ map exProclbl cmm - cdata = concat $ map exData cmm - env = foldl (\e l -> funInsert l llvmFunTy e) initLlvmEnv cproc - in cmmDataLlvmGens' dflags h env cdata [] - -cmmDataLlvmGens' - :: DynFlags - -> BufHandle - -> LlvmEnv - -> [(Section, [CmmStatic])] - -> [LlvmUnresData] - -> IO ( LlvmEnv ) - -cmmDataLlvmGens' dflags h env [] lmdata - = do - let (env', lmdata') = resolveLlvmDatas dflags env lmdata [] - let lmdoc = Prt.vcat $ map (pprLlvmData dflags) lmdata' +cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]] + -> [LlvmUnresData] -> IO ( LlvmEnv ) +cmmDataLlvmGens dflags h env [] lmdata + = let (env', lmdata') = resolveLlvmDatas env lmdata [] + lmdoc = Prt.vcat $ map pprLlvmData lmdata' + in do dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc lmdoc - Prt.bufLeftRender h lmdoc return env' -cmmDataLlvmGens' dflags h env (cmm:cmms) lmdata - = do - let lmdata'@(l, ty, _) = genLlvmData dflags cmm - let env' = funInsert (strCLabel_llvm l) ty env - cmmDataLlvmGens' dflags h env' cmms (lmdata ++ [lmdata']) +cmmDataLlvmGens dflags h env (cmm:cmms) lmdata + = let lmdata'@(l, ty, _) = genLlvmData cmm + env' = funInsert (strCLabel_llvm l) ty env + in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata']) -- ----------------------------------------------------------------------------- -- | Do llvm code generation on all these cmms procs. -- -cmmProcLlvmGens - :: DynFlags - -> BufHandle - -> UniqSupply - -> LlvmEnv - -> [RawCmmTop] +cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop] -> Int -- ^ count, used for generating unique subsections -> [LlvmVar] -- ^ info tables that need to be marked as 'used' -> IO () @@ -116,34 +90,28 @@ cmmProcLlvmGens cmmProcLlvmGens _ _ _ _ [] _ [] = return () -cmmProcLlvmGens dflags h _ _ [] _ ivars - = do - let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr - let ty = (LMArray (length ivars) i8Ptr) - let usedArray = LMStaticArray (map cast ivars) ty - let lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending - (Just $ fsLit "llvm.metadata") Nothing, Just usedArray) - Prt.bufLeftRender h $ pprLlvmData dflags ([lmUsed], []) +cmmProcLlvmGens _ h _ _ [] _ ivars + = let cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr + ty = (LMArray (length ivars) i8Ptr) + usedArray = LMStaticArray (map cast ivars) ty + lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending + (Just $ fsLit "llvm.metadata") Nothing, Just usedArray) + in do + Prt.bufLeftRender h $ pprLlvmData ([lmUsed], []) cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars = do - (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm + (us', env', llvm) <- cmmLlvmGen dflags us (clearVars env) cmm - let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop dflags env' count) llvm - Prt.bufLeftRender h $ Prt.vcat docs + let (docs, ivar) = mapAndUnzip (pprLlvmCmmTop env' count) llvm + Prt.bufLeftRender h $ Prt.vcat docs - cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars) + cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars) -- | Complete llvm code generation phase for a single top-level chunk of Cmm. -cmmLlvmGen - :: DynFlags - -> UniqSupply - -> LlvmEnv - -> RawCmmTop -- ^ the cmm to generate code for - -> IO ( UniqSupply, - LlvmEnv, - [LlvmCmmTop] ) -- llvm code +cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop + -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] ) cmmLlvmGen dflags us env cmm = do @@ -154,10 +122,10 @@ cmmLlvmGen dflags us env cmm (pprCmm $ Cmm [fixed_cmm]) -- generate llvm code from cmm - let ((env', llvmBC), usGen) = initUs us $ genLlvmCode dflags env fixed_cmm + let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" - (vcat $ map (docToSDoc . fst . pprLlvmCmmTop dflags env' 0) llvmBC) + (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC) return (usGen, env', llvmBC) @@ -165,18 +133,9 @@ cmmLlvmGen dflags us env cmm -- ----------------------------------------------------------------------------- -- | Instruction selection -- -genLlvmCode - :: DynFlags - -> LlvmEnv - -> RawCmmTop - -> UniqSM (LlvmEnv, [LlvmCmmTop]) - -genLlvmCode _ env (CmmData _ _) - = return (env, []) - -genLlvmCode _ env (CmmProc _ _ _ (ListGraph [])) - = return (env, []) - -genLlvmCode _ env cp@(CmmProc _ _ _ _) - = genLlvmProc env cp +genLlvmCode :: LlvmEnv -> RawCmmTop + -> UniqSM (LlvmEnv, [LlvmCmmTop]) +genLlvmCode env (CmmData _ _ ) = return (env, []) +genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, []) +genLlvmCode env cp@(CmmProc _ _ _ _ ) = genLlvmProc env cp |