compiler/nativeGen/PprMach.hs

   1 {-# OPTIONS -w #-}
   2 -- The above warning supression flag is a temporary kludge.
   3 -- While working on this module you are encouraged to remove it and fix
   4 -- any warnings in the module. See
   5 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
   6 -- for details
   7
   8 -----------------------------------------------------------------------------
   9 --
  10 -- Pretty-printing assembly language
  11 --
  12 -- (c) The University of Glasgow 1993-2005
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 -- We start with the @pprXXX@s with some cross-platform commonality
  17 -- (e.g., 'pprReg'); we conclude with the no-commonality monster,
  18 -- 'pprInstr'.
  19
  20 #include "nativeGen/NCG.h"
  21
  22 module PprMach (
  23         pprNatCmmTop, pprBasicBlock, pprSectionHeader, pprData,
  24         pprInstr, pprSize, pprUserReg, pprImm
  25   ) where
  26
  27 #include "HsVersions.h"
  28
  29 import PprBase
  30
  31 import BlockId
  32 import Cmm
  33 import Regs             -- may differ per-platform
  34 import Instrs
  35 import Regs
  36
  37 import CLabel           ( CLabel, pprCLabel, externallyVisibleCLabel,
  38                           labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
  39 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  40 import CLabel       ( mkDeadStripPreventer )
  41 #endif
  42
  43 import Panic            ( panic )
  44 import Unique           ( pprUnique )
  45 import Pretty
  46 import FastString
  47 import qualified Outputable
  48 import Outputable       ( Outputable, pprPanic, ppr, docToSDoc)
  49
  50 import Data.Array.ST
  51 import Data.Word        ( Word8 )
  52 import Control.Monad.ST
  53 import Data.Char        ( chr, ord )
  54 import Data.Maybe       ( isJust )
  55
  56
  57 #if   alpha_TARGET_ARCH
  58 import Alpha.Ppr
  59 #elif powerpc_TARGET_ARCH
  60 import PPC.Ppr
  61 #elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
  62 import X86.Ppr
  63 #elif sparc_TARGET_ARCH
  64 import SPARC.Ppr
  65 #else
  66 #error "Regs: not defined for this architecture"
  67 #endif
  68
  69
  70
  71 -- -----------------------------------------------------------------------------
  72 -- Printing this stuff out
  73
  74 pprNatCmmTop :: NatCmmTop -> Doc
  75 pprNatCmmTop (CmmData section dats) =
  76   pprSectionHeader section $$ vcat (map pprData dats)
  77
  78  -- special case for split markers:
  79 pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
  80
  81 pprNatCmmTop (CmmProc info lbl params (ListGraph blocks)) =
  82   pprSectionHeader Text $$
  83   (if null info then -- blocks guaranteed not null, so label needed
  84        pprLabel lbl
  85    else
  86 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  87             pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
  88                 <> char ':' $$
  89 #endif
  90        vcat (map pprData info) $$
  91        pprLabel (entryLblToInfoLbl lbl)
  92   ) $$
  93   vcat (map pprBasicBlock blocks)
  94      -- above: Even the first block gets a label, because with branch-chain
  95      -- elimination, it might be the target of a goto.
  96 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
  97         -- If we are using the .subsections_via_symbols directive
  98         -- (available on recent versions of Darwin),
  99         -- we have to make sure that there is some kind of reference
 100         -- from the entry code to a label on the _top_ of of the info table,
 101         -- so that the linker will not think it is unreferenced and dead-strip
 102         -- it. That's why the label is called a DeadStripPreventer (_dsp).
 103   $$ if not (null info)
 104                     then text "\t.long "
 105                       <+> pprCLabel_asm (entryLblToInfoLbl lbl)
 106                       <+> char '-'
 107                       <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
 108                     else empty
 109 #endif
 110
 111
 112 pprBasicBlock :: NatBasicBlock -> Doc
 113 pprBasicBlock (BasicBlock (BlockId id) instrs) =
 114   pprLabel (mkAsmTempLabel id) $$
 115   vcat (map pprInstr instrs)
 116
 117
 118 pprData :: CmmStatic -> Doc
 119 pprData (CmmAlign bytes)         = pprAlign bytes
 120 pprData (CmmDataLabel lbl)       = pprLabel lbl
 121 pprData (CmmString str)          = pprASCII str
 122 pprData (CmmUninitialised bytes) = ptext (sLit s) <> int bytes
 123     where s =
 124 #if defined(solaris2_TARGET_OS)
 125               ".skip "
 126 #else
 127               ".space "
 128 #endif
 129 pprData (CmmStaticLit lit)       = pprDataItem lit
 130
 131 pprGloblDecl :: CLabel -> Doc
 132 pprGloblDecl lbl
 133   | not (externallyVisibleCLabel lbl) = empty
 134   | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
 135                                     (sLit ".globl ")) <>
 136                 pprCLabel_asm lbl
 137
 138 pprTypeAndSizeDecl :: CLabel -> Doc
 139 pprTypeAndSizeDecl lbl
 140 #if linux_TARGET_OS
 141   | not (externallyVisibleCLabel lbl) = empty
 142   | otherwise = ptext (sLit ".type ") <>
 143                 pprCLabel_asm lbl <> ptext (sLit ", @object")
 144 #else
 145   = empty
 146 #endif
 147
 148 pprLabel :: CLabel -> Doc
 149 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
 150
 151
 152 pprASCII str
 153   = vcat (map do1 str) $$ do1 0
 154     where
 155        do1 :: Word8 -> Doc
 156        do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
 157
 158 pprAlign bytes =
 159         IF_ARCH_alpha(ptext (sLit ".align ") <> int pow2,
 160         IF_ARCH_i386(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
 161         IF_ARCH_x86_64(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
 162         IF_ARCH_sparc(ptext (sLit ".align ") <> int bytes,
 163         IF_ARCH_powerpc(ptext (sLit ".align ") <> int pow2,)))))
 164   where
 165         pow2 = log2 bytes
 166
 167         log2 :: Int -> Int  -- cache the common ones
 168         log2 1 = 0
 169         log2 2 = 1
 170         log2 4 = 2
 171         log2 8 = 3
 172         log2 n = 1 + log2 (n `quot` 2)
 173
 174
 175 -- -----------------------------------------------------------------------------
 176 -- pprInstr: print an 'Instr'
 177
 178 instance Outputable Instr where
 179     ppr  instr  = Outputable.docToSDoc $ pprInstr instr
 180
 181
 182
 183