update to current master againwip/T13904

1 files changed, 42 insertions, 29 deletions

diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index eb179c5a99..8eb5e8fa8d 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -23,6 +23,8 @@ module PPC.Instr (
 
 where
 
+import GhcPrelude
+
 import PPC.Regs
 import PPC.Cond
 import Instruction
@@ -75,19 +77,19 @@ instance Instruction Instr where
         mkStackDeallocInstr     = ppc_mkStackDeallocInstr
 
 
-ppc_mkStackAllocInstr :: Platform -> Int -> Instr
+ppc_mkStackAllocInstr :: Platform -> Int -> [Instr]
 ppc_mkStackAllocInstr platform amount
   = ppc_mkStackAllocInstr' platform (-amount)
 
-ppc_mkStackDeallocInstr :: Platform -> Int -> Instr
+ppc_mkStackDeallocInstr :: Platform -> Int -> [Instr]
 ppc_mkStackDeallocInstr platform amount
   = ppc_mkStackAllocInstr' platform amount
 
-ppc_mkStackAllocInstr' :: Platform -> Int -> Instr
+ppc_mkStackAllocInstr' :: Platform -> Int -> [Instr]
 ppc_mkStackAllocInstr' platform amount
   = case platformArch platform of
-    ArchPPC      -> UPDATE_SP II32 (ImmInt amount)
-    ArchPPC_64 _ -> UPDATE_SP II64 (ImmInt amount)
+    ArchPPC      -> [UPDATE_SP II32 (ImmInt amount)]
+    ArchPPC_64 _ -> [UPDATE_SP II64 (ImmInt amount)]
     _            -> panic $ "ppc_mkStackAllocInstr' "
                             ++ show (platformArch platform)
 
@@ -124,7 +126,7 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do
 
         insert_stack_insns (BasicBlock id insns)
             | Just new_blockid <- mapLookup id new_blockmap
-                = [ BasicBlock id [alloc, BCC ALWAYS new_blockid]
+                = [ BasicBlock id $ alloc ++ [BCC ALWAYS new_blockid Nothing]
                   , BasicBlock new_blockid block'
                   ]
             | otherwise
@@ -137,11 +139,11 @@ allocMoreStack platform slots (CmmProc info lbl live (ListGraph code)) = do
             -- "labeled-goto" we use JMP, and for "computed-goto" we
             -- use MTCTR followed by BCTR. See 'PPC.CodeGen.genJump'.
             = case insn of
-                JMP _           -> dealloc : insn : r
-                BCTR [] Nothing -> dealloc : insn : r
+                JMP _           -> dealloc ++ (insn : r)
+                BCTR [] Nothing -> dealloc ++ (insn : r)
                 BCTR ids label  -> BCTR (map (fmap retarget) ids) label : r
-                BCCFAR cond b   -> BCCFAR cond (retarget b) : r
-                BCC    cond b   -> BCC    cond (retarget b) : r
+                BCCFAR cond b p -> BCCFAR cond (retarget b) p : r
+                BCC    cond b p -> BCC    cond (retarget b) p : r
                 _               -> insn : r
             -- BL and BCTRL are call-like instructions rather than
             -- jumps, and are used only for C calls.
@@ -190,10 +192,12 @@ data Instr
     -- Loads and stores.
     | LD      Format Reg AddrMode   -- Load format, dst, src
     | LDFAR   Format Reg AddrMode   -- Load format, dst, src 32 bit offset
+    | LDR     Format Reg AddrMode   -- Load and reserve format, dst, src
     | LA      Format Reg AddrMode   -- Load arithmetic format, dst, src
     | ST      Format Reg AddrMode   -- Store format, src, dst
     | STFAR   Format Reg AddrMode   -- Store format, src, dst 32 bit offset
     | STU     Format Reg AddrMode   -- Store with Update format, src, dst
+    | STC     Format Reg AddrMode   -- Store conditional format, src, dst
     | LIS     Reg Imm               -- Load Immediate Shifted dst, src
     | LI      Reg Imm               -- Load Immediate dst, src
     | MR      Reg Reg               -- Move Register dst, src -- also for fmr
@@ -201,8 +205,12 @@ data Instr
     | CMP     Format Reg RI         -- format, src1, src2
     | CMPL    Format Reg RI         -- format, src1, src2
 
-    | BCC     Cond BlockId
-    | BCCFAR  Cond BlockId
+    | BCC     Cond BlockId (Maybe Bool) -- cond, block, hint
+    | BCCFAR  Cond BlockId (Maybe Bool) -- cond, block, hint
+                                    --   hint:
+                                    --    Just True:  branch likely taken
+                                    --    Just False: branch likely not taken
+                                    --    Nothing:    no hint
     | JMP     CLabel                -- same as branch,
                                     -- but with CLabel instead of block ID
     | MTCTR   Reg
@@ -232,6 +240,7 @@ data Instr
     | DIV     Format Bool Reg Reg Reg
     | AND     Reg Reg RI            -- dst, src1, src2
     | ANDC    Reg Reg Reg           -- AND with complement, dst = src1 & ~ src2
+    | NAND    Reg Reg Reg           -- dst, src1, src2
     | OR      Reg Reg RI            -- dst, src1, src2
     | ORIS    Reg Reg Imm           -- OR Immediate Shifted dst, src1, src2
     | XOR     Reg Reg RI            -- dst, src1, src2
@@ -272,6 +281,8 @@ data Instr
     | MFLR    Reg               -- move from link register
     | FETCHPC Reg               -- pseudo-instruction:
                                 -- bcl to next insn, mflr reg
+    | HWSYNC                    -- heavy weight sync
+    | ISYNC                     -- instruction synchronize
     | LWSYNC                    -- memory barrier
     | NOP                       -- no operation, PowerPC 64 bit
                                 -- needs this as place holder to
@@ -290,17 +301,19 @@ ppc_regUsageOfInstr platform instr
  = case instr of
     LD      _ reg addr       -> usage (regAddr addr, [reg])
     LDFAR   _ reg addr       -> usage (regAddr addr, [reg])
+    LDR     _ reg addr       -> usage (regAddr addr, [reg])
     LA      _ reg addr       -> usage (regAddr addr, [reg])
     ST      _ reg addr       -> usage (reg : regAddr addr, [])
     STFAR   _ reg addr       -> usage (reg : regAddr addr, [])
     STU     _ reg addr       -> usage (reg : regAddr addr, [])
+    STC     _ reg addr       -> usage (reg : regAddr addr, [])
     LIS     reg _            -> usage ([], [reg])
     LI      reg _            -> usage ([], [reg])
     MR      reg1 reg2        -> usage ([reg2], [reg1])
     CMP     _ reg ri         -> usage (reg : regRI ri,[])
     CMPL    _ reg ri         -> usage (reg : regRI ri,[])
-    BCC     _ _              -> noUsage
-    BCCFAR  _ _              -> noUsage
+    BCC     _ _ _            -> noUsage
+    BCCFAR  _ _ _            -> noUsage
     MTCTR   reg              -> usage ([reg],[])
     BCTR    _ _              -> noUsage
     BL      _ params         -> usage (params, callClobberedRegs platform)
@@ -325,6 +338,7 @@ ppc_regUsageOfInstr platform instr
 
     AND     reg1 reg2 ri    -> usage (reg2 : regRI ri, [reg1])
     ANDC    reg1 reg2 reg3  -> usage ([reg2,reg3], [reg1])
+    NAND    reg1 reg2 reg3  -> usage ([reg2,reg3], [reg1])
     OR      reg1 reg2 ri    -> usage (reg2 : regRI ri, [reg1])
     ORIS    reg1 reg2 _     -> usage ([reg2], [reg1])
     XOR     reg1 reg2 ri    -> usage (reg2 : regRI ri, [reg1])
@@ -380,17 +394,19 @@ ppc_patchRegsOfInstr instr env
  = case instr of
     LD      fmt reg addr    -> LD fmt (env reg) (fixAddr addr)
     LDFAR   fmt reg addr    -> LDFAR fmt (env reg) (fixAddr addr)
+    LDR     fmt reg addr    -> LDR fmt (env reg) (fixAddr addr)
     LA      fmt reg addr    -> LA fmt (env reg) (fixAddr addr)
     ST      fmt reg addr    -> ST fmt (env reg) (fixAddr addr)
     STFAR   fmt reg addr    -> STFAR fmt (env reg) (fixAddr addr)
     STU     fmt reg addr    -> STU fmt (env reg) (fixAddr addr)
+    STC     fmt reg addr    -> STC fmt (env reg) (fixAddr addr)
     LIS     reg imm         -> LIS (env reg) imm
     LI      reg imm         -> LI (env reg) imm
     MR      reg1 reg2       -> MR (env reg1) (env reg2)
     CMP     fmt reg ri      -> CMP fmt (env reg) (fixRI ri)
     CMPL    fmt reg ri      -> CMPL fmt (env reg) (fixRI ri)
-    BCC     cond lbl        -> BCC cond lbl
-    BCCFAR  cond lbl        -> BCCFAR cond lbl
+    BCC     cond lbl p      -> BCC cond lbl p
+    BCCFAR  cond lbl p      -> BCCFAR cond lbl p
     MTCTR   reg             -> MTCTR (env reg)
     BCTR    targets lbl     -> BCTR targets lbl
     BL      imm argRegs     -> BL imm argRegs    -- argument regs
@@ -417,6 +433,7 @@ ppc_patchRegsOfInstr instr env
 
     AND     reg1 reg2 ri    -> AND (env reg1) (env reg2) (fixRI ri)
     ANDC    reg1 reg2 reg3  -> ANDC (env reg1) (env reg2) (env reg3)
+    NAND    reg1 reg2 reg3  -> NAND (env reg1) (env reg2) (env reg3)
     OR      reg1 reg2 ri    -> OR  (env reg1) (env reg2) (fixRI ri)
     ORIS    reg1 reg2 imm   -> ORIS (env reg1) (env reg2) imm
     XOR     reg1 reg2 ri    -> XOR (env reg1) (env reg2) (fixRI ri)
@@ -480,8 +497,8 @@ ppc_isJumpishInstr instr
 ppc_jumpDestsOfInstr :: Instr -> [BlockId]
 ppc_jumpDestsOfInstr insn
   = case insn of
-        BCC _ id        -> [id]
-        BCCFAR _ id     -> [id]
+        BCC _ id _      -> [id]
+        BCCFAR _ id _   -> [id]
         BCTR targets _  -> [id | Just id <- targets]
         _               -> []
 
@@ -492,8 +509,8 @@ ppc_jumpDestsOfInstr insn
 ppc_patchJumpInstr :: Instr -> (BlockId -> BlockId) -> Instr
 ppc_patchJumpInstr insn patchF
   = case insn of
-        BCC cc id       -> BCC cc (patchF id)
-        BCCFAR cc id    -> BCCFAR cc (patchF id)
+        BCC cc id p     -> BCC cc (patchF id) p
+        BCCFAR cc id p  -> BCCFAR cc (patchF id) p
         BCTR ids lbl    -> BCTR (map (fmap patchF) ids) lbl
         _               -> insn
 
@@ -631,16 +648,12 @@ ppc_mkRegRegMoveInstr src dst
 
 
 -- | Make an unconditional jump instruction.
--- For architectures with branch delay slots, its ok to put
--- a NOP after the jump. Don't fill the delay slot with an
--- instruction that references regs or you'll confuse the
--- linear allocator.
 ppc_mkJumpInstr
     :: BlockId
     -> [Instr]
 
 ppc_mkJumpInstr id
-    = [BCC ALWAYS id]
+    = [BCC ALWAYS id Nothing]
 
 
 -- | Take the source and destination from this reg -> reg move instruction
@@ -669,12 +682,12 @@ makeFarBranches info_env blocks
         handleBlock addr (BasicBlock id instrs)
                 = BasicBlock id (zipWith makeFar [addr..] instrs)
 
-        makeFar _ (BCC ALWAYS tgt) = BCC ALWAYS tgt
-        makeFar addr (BCC cond tgt)
+        makeFar _ (BCC ALWAYS tgt _) = BCC ALWAYS tgt Nothing
+        makeFar addr (BCC cond tgt p)
             | abs (addr - targetAddr) >= nearLimit
-            = BCCFAR cond tgt
+            = BCCFAR cond tgt p
             | otherwise
-            = BCC cond tgt
+            = BCC cond tgt p
             where Just targetAddr = lookupUFM blockAddressMap tgt
         makeFar _ other            = other