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