never executed always true always false
    1 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    2 
    3 -- | Expand out synthetic instructions into single machine instrs.
    4 module GHC.CmmToAsm.SPARC.CodeGen.Expand (
    5         expandTop
    6 )
    7 
    8 where
    9 
   10 import GHC.Prelude
   11 
   12 import GHC.CmmToAsm.SPARC.Instr
   13 import GHC.CmmToAsm.SPARC.Imm
   14 import GHC.CmmToAsm.SPARC.AddrMode
   15 import GHC.CmmToAsm.SPARC.Regs
   16 import GHC.CmmToAsm.Format
   17 import GHC.CmmToAsm.Types
   18 import GHC.Cmm
   19 
   20 import GHC.Platform.Reg
   21 
   22 import GHC.Utils.Outputable
   23 import GHC.Utils.Panic
   24 import GHC.Data.OrdList
   25 
   26 -- | Expand out synthetic instructions in this top level thing
   27 expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
   28 expandTop top@(CmmData{})
   29         = top
   30 
   31 expandTop (CmmProc info lbl live (ListGraph blocks))
   32         = CmmProc info lbl live (ListGraph $ map expandBlock blocks)
   33 
   34 
   35 -- | Expand out synthetic instructions in this block
   36 expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr
   37 
   38 expandBlock (BasicBlock label instrs)
   39  = let  instrs_ol       = expandBlockInstrs instrs
   40         instrs'         = fromOL instrs_ol
   41    in   BasicBlock label instrs'
   42 
   43 
   44 -- | Expand out some instructions
   45 expandBlockInstrs :: [Instr] -> OrdList Instr
   46 expandBlockInstrs []    = nilOL
   47 
   48 expandBlockInstrs (ii:is)
   49  = let  ii_doubleRegs   = remapRegPair ii
   50         is_misaligned   = expandMisalignedDoubles ii_doubleRegs
   51 
   52    in   is_misaligned `appOL` expandBlockInstrs is
   53 
   54 
   55 
   56 -- | In the SPARC instruction set the FP register pairs that are used
   57 --      to hold 64 bit floats are referred to by just the first reg
   58 --      of the pair. Remap our internal reg pairs to the appropriate reg.
   59 --
   60 --      For example:
   61 --          ldd [%l1], (%f0 | %f1)
   62 --
   63 --      gets mapped to
   64 --          ldd [$l1], %f0
   65 --
   66 remapRegPair :: Instr -> Instr
   67 remapRegPair instr
   68  = let  patchF reg
   69          = case reg of
   70                 RegReal (RealRegSingle _)
   71                         -> reg
   72 
   73                 RegReal (RealRegPair r1 r2)
   74 
   75                         -- sanity checking
   76                         | r1         >= 32
   77                         , r1         <= 63
   78                         , r1 `mod` 2 == 0
   79                         , r2         == r1 + 1
   80                         -> RegReal (RealRegSingle r1)
   81 
   82                         | otherwise
   83                         -> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg)
   84 
   85                 RegVirtual _
   86                         -> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg)
   87 
   88    in   patchRegsOfInstr instr patchF
   89 
   90 
   91 
   92 
   93 -- Expand out 64 bit load/stores into individual instructions to handle
   94 --      possible double alignment problems.
   95 --
   96 --      TODO:   It'd be better to use a scratch reg instead of the add/sub thing.
   97 --              We might be able to do this faster if we use the UA2007 instr set
   98 --              instead of restricting ourselves to SPARC V9.
   99 --
  100 expandMisalignedDoubles :: Instr -> OrdList Instr
  101 expandMisalignedDoubles instr
  102 
  103         -- Translate to:
  104         --    add g1,g2,g1
  105         --    ld  [g1],%fn
  106         --    ld  [g1+4],%f(n+1)
  107         --    sub g1,g2,g1           -- to restore g1
  108         | LD FF64 (AddrRegReg r1 r2) fReg       <- instr
  109         =       toOL    [ ADD False False r1 (RIReg r2) r1
  110                         , LD  FF32  (AddrRegReg r1 g0)          fReg
  111                         , LD  FF32  (AddrRegImm r1 (ImmInt 4))  (fRegHi fReg)
  112                         , SUB False False r1 (RIReg r2) r1 ]
  113 
  114         -- Translate to
  115         --    ld  [addr],%fn
  116         --    ld  [addr+4],%f(n+1)
  117         | LD FF64 addr fReg                     <- instr
  118         = let   Just addr'      = addrOffset addr 4
  119           in    toOL    [ LD  FF32  addr        fReg
  120                         , LD  FF32  addr'       (fRegHi fReg) ]
  121 
  122         -- Translate to:
  123         --    add g1,g2,g1
  124         --    st  %fn,[g1]
  125         --    st  %f(n+1),[g1+4]
  126         --    sub g1,g2,g1           -- to restore g1
  127         | ST FF64 fReg (AddrRegReg r1 r2)       <- instr
  128         =       toOL    [ ADD False False r1 (RIReg r2) r1
  129                         , ST  FF32  fReg           (AddrRegReg r1 g0)
  130                         , ST  FF32  (fRegHi fReg)  (AddrRegImm r1 (ImmInt 4))
  131                         , SUB False False r1 (RIReg r2) r1 ]
  132 
  133         -- Translate to
  134         --    ld  [addr],%fn
  135         --    ld  [addr+4],%f(n+1)
  136         | ST FF64 fReg addr                     <- instr
  137         = let   Just addr'      = addrOffset addr 4
  138           in    toOL    [ ST  FF32  fReg           addr
  139                         , ST  FF32  (fRegHi fReg)  addr'         ]
  140 
  141         -- some other instr
  142         | otherwise
  143         = unitOL instr
  144 
  145 
  146 
  147 -- | The high partner for this float reg.
  148 fRegHi :: Reg -> Reg
  149 fRegHi (RegReal (RealRegSingle r1))
  150         | r1            >= 32
  151         , r1            <= 63
  152         , r1 `mod` 2 == 0
  153         = (RegReal $ RealRegSingle (r1 + 1))
  154 
  155 -- Can't take high partner for non-low reg.
  156 fRegHi reg
  157         = pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg)