1{-# LANGUAGE CPP #-} 2 3-- ---------------------------------------------------------------------------- 4-- | Pretty print helpers for the LLVM Code generator. 5-- 6module LlvmCodeGen.Ppr ( 7 pprLlvmCmmDecl, pprLlvmData, infoSection 8 ) where 9 10#include "HsVersions.h" 11 12import GhcPrelude 13 14import Llvm 15import LlvmCodeGen.Base 16import LlvmCodeGen.Data 17 18import CLabel 19import Cmm 20 21import FastString 22import Outputable 23import Unique 24 25-- ---------------------------------------------------------------------------- 26-- * Top level 27-- 28 29-- | Pretty print LLVM data code 30pprLlvmData :: LlvmData -> SDoc 31pprLlvmData (globals, types) = 32 let ppLlvmTys (LMAlias a) = ppLlvmAlias a 33 ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f 34 ppLlvmTys _other = empty 35 36 types' = vcat $ map ppLlvmTys types 37 globals' = ppLlvmGlobals globals 38 in types' $+$ globals' 39 40 41-- | Pretty print LLVM code 42pprLlvmCmmDecl :: LlvmCmmDecl -> LlvmM (SDoc, [LlvmVar]) 43pprLlvmCmmDecl (CmmData _ lmdata) 44 = return (vcat $ map pprLlvmData lmdata, []) 45 46pprLlvmCmmDecl (CmmProc mb_info entry_lbl live (ListGraph blks)) 47 = do let lbl = case mb_info of 48 Nothing -> entry_lbl 49 Just (Statics info_lbl _) -> info_lbl 50 link = if externallyVisibleCLabel lbl 51 then ExternallyVisible 52 else Internal 53 lmblocks = map (\(BasicBlock id stmts) -> 54 LlvmBlock (getUnique id) stmts) blks 55 56 funDec <- llvmFunSig live lbl link 57 dflags <- getDynFlags 58 let buildArg = fsLit . showSDoc dflags . ppPlainName 59 funArgs = map buildArg (llvmFunArgs dflags live) 60 funSect = llvmFunSection dflags (decName funDec) 61 62 -- generate the info table 63 prefix <- case mb_info of 64 Nothing -> return Nothing 65 Just (Statics _ statics) -> do 66 infoStatics <- mapM genData statics 67 let infoTy = LMStruct $ map getStatType infoStatics 68 return $ Just $ LMStaticStruc infoStatics infoTy 69 70 71 let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect 72 prefix lmblocks 73 name = decName $ funcDecl fun 74 defName = llvmDefLabel name 75 funcDecl' = (funcDecl fun) { decName = defName } 76 fun' = fun { funcDecl = funcDecl' } 77 funTy = LMFunction funcDecl' 78 funVar = LMGlobalVar name 79 (LMPointer funTy) 80 link 81 Nothing 82 Nothing 83 Alias 84 defVar = LMGlobalVar defName 85 (LMPointer funTy) 86 (funcLinkage funcDecl') 87 (funcSect fun) 88 (funcAlign funcDecl') 89 Alias 90 alias = LMGlobal funVar 91 (Just $ LMBitc (LMStaticPointer defVar) 92 i8Ptr) 93 94 return (ppLlvmGlobal alias $+$ ppLlvmFunction fun', []) 95 96 97-- | The section we are putting info tables and their entry code into, should 98-- be unique since we process the assembly pattern matching this. 99infoSection :: String 100infoSection = "X98A__STRIP,__me" 101