X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.lhs;h=e0377b801f43afda9114d83ffd914a9be3aa241d;hb=56af76cc6a264621bfd18071f21e6a608e691e47;hp=8d82ae30f6fe896e9bb890c16d97e57f69551752;hpb=0d1a15fd5f3396ae711483b446c4b982083e5c87;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index 8d82ae3..e0377b8 100644
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -121,7 +121,7 @@ intersectionRegSets (MkRegSet xs1) (MkRegSet xs2)
 
 %************************************************************************
 %*									*
-\subsection{@RegUsage@ type; @noUsage@, @endUsage@, @regUsage@ functions}
+\subsection{@RegUsage@ type; @noUsage@ and @regUsage@ functions}
 %*									*
 %************************************************************************
 
@@ -236,6 +236,7 @@ regUsage instr = case instr of
     ADD    sz src dst	-> usageRM src dst
     SUB    sz src dst	-> usageRM src dst
     IMUL   sz src dst	-> usageRM src dst
+    IMUL64    sd1 sd2   -> mkRU [sd1,sd2] [sd1,sd2]
     MUL    sz src dst	-> usageRM src dst
     IQUOT  sz src dst	-> usageRM src dst
     IREM   sz src dst	-> usageRM src dst
@@ -258,7 +259,8 @@ regUsage instr = case instr of
     SETCC  cond op	-> mkRU [] (def_W op)
     JXX    cond lbl	-> mkRU [] []
     JMP    dsts op	-> mkRU (use_R op) []
-    CALL   imm		-> mkRU [] callClobberedRegs
+    CALL   (Left imm)	-> mkRU [] callClobberedRegs
+    CALL   (Right reg)	-> mkRU [reg] callClobberedRegs
     CLTD		-> mkRU [eax] [edx]
     NOP			-> mkRU [] []
 
@@ -340,6 +342,9 @@ regUsage instr = case instr of
     ST    sz reg addr  	-> usage (reg : regAddr addr, [])
     ADD   x cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
     SUB   x cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    UMUL    cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    SMUL    cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
+    RDY   rd            -> usage ([], [rd])
     AND   b r1 ar r2  	-> usage (r1 : regRI ar, [r2])
     ANDN  b r1 ar r2 	-> usage (r1 : regRI ar, [r2])
     OR    b r1 ar r2   	-> usage (r1 : regRI ar, [r2])
@@ -364,8 +369,10 @@ regUsage instr = case instr of
     -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
     JMP   dst addr 	-> usage (regAddr addr, [])
 
-    CALL  _ n True   	-> noUsage
-    CALL  _ n False  	-> usage (argRegs n, callClobberedRegs)
+    CALL  (Left imm)  n True  -> noUsage
+    CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
+    CALL  (Right reg) n True  -> usage ([reg], [])
+    CALL  (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
 
     _ 	    	    	-> noUsage
   where
@@ -379,6 +386,54 @@ regUsage instr = case instr of
     regRI  _	= []
 
 #endif {- sparc_TARGET_ARCH -}
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#if powerpc_TARGET_ARCH
+
+regUsage instr = case instr of
+    LD    sz reg addr  	-> usage (regAddr addr, [reg])
+    ST    sz reg addr  	-> usage (reg : regAddr addr, [])
+    STU    sz reg addr  -> usage (reg : regAddr addr, [])
+    LIS   reg imm	-> usage ([], [reg])
+    LI    reg imm	-> usage ([], [reg])
+    MR	  reg1 reg2     -> usage ([reg2], [reg1])
+    CMP   sz reg ri	-> usage (reg : regRI ri,[])
+    CMPL  sz reg ri	-> usage (reg : regRI ri,[])
+    BCC	  cond lbl	-> noUsage
+    MTCTR reg		-> usage ([reg],[])
+    BCTR  dsts		-> noUsage
+    BL    imm params	-> usage (params, callClobberedRegs)
+    BCTRL params	-> usage (params, callClobberedRegs)
+    ADD	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    SUBF  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
+    MULLW reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    DIVW  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
+    DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
+    AND	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    OR	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    XOR	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
+    NEG	  reg1 reg2	-> usage ([reg2], [reg1])
+    NOT	  reg1 reg2	-> usage ([reg2], [reg1])
+    SLW	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    SRW	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    SRAW  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
+    FADD  sz r1 r2 r3   -> usage ([r2,r3], [r1])
+    FSUB  sz r1 r2 r3   -> usage ([r2,r3], [r1])
+    FMUL  sz r1 r2 r3   -> usage ([r2,r3], [r1])
+    FDIV  sz r1 r2 r3   -> usage ([r2,r3], [r1])
+    FNEG  r1 r2		-> usage ([r2], [r1])
+    FCMP  r1 r2		-> usage ([r1,r2], [])
+    FCTIWZ r1 r2	-> usage ([r2], [r1])
+    _ 	    	    	-> noUsage
+  where
+    usage (src, dst) = RU (regSetFromList (filter interesting src))
+    	    	    	  (regSetFromList (filter interesting dst))
+    regAddr (AddrRegReg r1 r2) = [r1, r2]
+    regAddr (AddrRegImm r1 _)  = [r1]
+
+    regRI (RIReg r) = [r]
+    regRI  _	= []
+#endif {- powerpc_TARGET_ARCH -}
 \end{code}
 
 
@@ -456,6 +511,10 @@ findReservedRegs instrs
     in
         possibilities
 #endif
+#if powerpc_TARGET_ARCH
+  = [[NCG_SpillTmp_I1, NCG_SpillTmp_I2, 
+      NCG_SpillTmp_D1, NCG_SpillTmp_D2]]
+#endif
 \end{code}
 
 %************************************************************************
@@ -545,6 +604,17 @@ insnFuture insn
     boring -> Next
 
 #endif {- sparc_TARGET_ARCH -}
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#if powerpc_TARGET_ARCH
+    BCC ALWAYS clbl | isAsmTemp clbl -> Branch clbl
+		    | otherwise -> NoFuture
+    BCC _ clbl 	    | isAsmTemp clbl -> NextOrBranch clbl
+    BCC _ _ -> panic "insnFuture: conditional jump to non-local label"
+    
+    BCTR (DestInfo dsts) -> MultiFuture dsts
+    BCTR NoDestInfo -> NoFuture
+    boring	-> Next
+#endif {- powerpc_TARGET_ARCH -}
 \end{code}
 
 %************************************************************************
@@ -627,6 +697,7 @@ patchRegs instr env = case instr of
     ADD  sz src dst	-> patch2 (ADD  sz) src dst
     SUB  sz src dst	-> patch2 (SUB  sz) src dst
     IMUL sz src dst 	-> patch2 (IMUL sz) src dst
+    IMUL64  sd1 sd2     -> IMUL64 (env sd1) (env sd2)
     MUL sz src dst 	-> patch2 (MUL sz) src dst
     IQUOT sz src dst 	-> patch2 (IQUOT sz) src dst
     IREM sz src dst 	-> patch2 (IREM sz) src dst
@@ -674,6 +745,9 @@ patchRegs instr env = case instr of
     GCOS sz src dst	-> GCOS sz (env src) (env dst)
     GTAN sz src dst	-> GTAN sz (env src) (env dst)
 
+    CALL (Left imm)	-> instr
+    CALL (Right reg)	-> CALL (Right (env reg))
+
     COMMENT _		-> instr
     SEGMENT _ 		-> instr
     LABEL _		-> instr
@@ -681,7 +755,6 @@ patchRegs instr env = case instr of
     DATA _ _		-> instr
     DELTA _ 		-> instr
     JXX _ _		-> instr
-    CALL _		-> instr
     CLTD		-> instr
     _			-> pprPanic "patchRegs(x86)" empty
 
@@ -712,6 +785,9 @@ patchRegs instr env = case instr of
     ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
     ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
     SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
+    UMUL    cc r1 ar r2	-> UMUL cc (env r1) (fixRI ar) (env r2)
+    SMUL    cc r1 ar r2	-> SMUL cc (env r1) (fixRI ar) (env r2)
+    RDY   rd            -> RDY (env rd)
     AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
     ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
     OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
@@ -733,6 +809,8 @@ patchRegs instr env = case instr of
     FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
     FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
     JMP   dsts addr     -> JMP dsts (fixAddr addr)
+    CALL  (Left i) n t  -> CALL (Left i) n t
+    CALL  (Right r) n t -> CALL (Right (env r)) n t
     _ -> instr
   where
     fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
@@ -742,6 +820,52 @@ patchRegs instr env = case instr of
     fixRI other	= other
 
 #endif {- sparc_TARGET_ARCH -}
+-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#if powerpc_TARGET_ARCH
+
+patchRegs instr env = case instr of
+    LD    sz reg addr   -> LD sz (env reg) (fixAddr addr)
+    ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
+    STU    sz reg addr  -> STU sz (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	  sz reg ri	-> CMP sz (env reg) (fixRI ri)
+    CMPL  sz reg ri	-> CMPL sz (env reg) (fixRI ri)
+    BCC	  cond lbl	-> BCC cond lbl
+    MTCTR reg		-> MTCTR (env reg)
+    BCTR  dsts		-> BCTR dsts
+    BL    imm argRegs	-> BL imm argRegs	-- argument regs
+    BCTRL argRegs	-> BCTRL argRegs 	-- cannot be remapped
+    ADD	  reg1 reg2 ri	-> ADD (env reg1) (env reg2) (fixRI ri)
+    SUBF  reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
+    MULLW reg1 reg2 ri	-> MULLW (env reg1) (env reg2) (fixRI ri)
+    DIVW  reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
+    DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
+    AND	  reg1 reg2 ri	-> AND (env reg1) (env reg2) (fixRI ri)
+    OR 	  reg1 reg2 ri	-> OR  (env reg1) (env reg2) (fixRI ri)
+    XOR	  reg1 reg2 ri	-> XOR (env reg1) (env reg2) (fixRI ri)
+    XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
+    NEG	  reg1 reg2	-> NEG (env reg1) (env reg2)
+    NOT	  reg1 reg2	-> NOT (env reg1) (env reg2)
+    SLW	  reg1 reg2 ri	-> SLW (env reg1) (env reg2) (fixRI ri)
+    SRW	  reg1 reg2 ri	-> SRW (env reg1) (env reg2) (fixRI ri)
+    SRAW  reg1 reg2 ri	-> SRAW (env reg1) (env reg2) (fixRI ri)
+    FADD  sz r1 r2 r3   -> FADD sz (env r1) (env r2) (env r3)
+    FSUB  sz r1 r2 r3   -> FSUB sz (env r1) (env r2) (env r3)
+    FMUL  sz r1 r2 r3   -> FMUL sz (env r1) (env r2) (env r3)
+    FDIV  sz r1 r2 r3   -> FDIV sz (env r1) (env r2) (env r3)
+    FNEG  r1 r2		-> FNEG (env r1) (env r2)
+    FCMP  r1 r2		-> FCMP (env r1) (env r2)
+    FCTIWZ r1 r2	-> FCTIWZ (env r1) (env r2)
+    _ -> instr
+  where
+    fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
+    fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
+
+    fixRI (RIReg r) = RIReg (env r)
+    fixRI other	= other
+#endif {- powerpc_TARGET_ARCH -}
 \end{code}
 
 %************************************************************************
@@ -758,7 +882,7 @@ location.  Leave 8 words (ie, 64 bytes for a 64-bit arch) of slop.
 
 \begin{code}
 spillSlotSize :: Int
-spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, )))
+spillSlotSize = IF_ARCH_alpha( 8, IF_ARCH_sparc( 8, IF_ARCH_i386( 12, IF_ARCH_powerpc( 8, ))))
 
 maxSpillSlots :: Int
 maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
@@ -793,19 +917,25 @@ spillReg vreg_to_slot_map delta dyn vreg
 
 	{-I386: spill above stack pointer leaving 3 words/spill-}
 	,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
-                        in case regClass vreg of
-                              RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w))
-                              _         -> GST F80 dyn (spRel off_w) -- RcFloat/RcDouble
+                        in case regClass vreg of {
+                              RcInteger -> MOV L (OpReg dyn) (OpAddr (spRel off_w));
+                              _         -> GST F80 dyn (spRel off_w)} {- RcFloat/RcDouble -}
 
 	{-SPARC: spill below frame pointer leaving 2 words/spill-}
 	,IF_ARCH_sparc( 
-                        let off_w = 1 + (off `div` 4)
-                            sz = case regClass vreg of
-                                    RcInteger -> W
-                                    RcFloat   -> F
-                                    RcDouble  -> DF
+                        let{off_w = 1 + (off `div` 4);
+                            sz = case regClass vreg of {
+                                    RcInteger -> W;
+                                    RcFloat   -> F;
+                                    RcDouble  -> DF}}
                         in ST sz dyn (fpRel (- off_w))
-        ,)))
+        ,IF_ARCH_powerpc(
+			let{sz = case regClass vreg of {
+                                    RcInteger -> W;
+                                    RcFloat   -> F;
+                                    RcDouble  -> DF}}
+			in ST sz dyn (AddrRegImm sp (ImmInt (off-delta)))
+	,))))
 
    
 loadReg vreg_to_slot_map delta vreg dyn
@@ -816,16 +946,22 @@ loadReg vreg_to_slot_map delta vreg dyn
 	 IF_ARCH_alpha( LD  sz dyn (spRel (- (off `div` 8)))
 
 	,IF_ARCH_i386 ( let off_w = (off-delta) `div` 4
-                        in case regClass vreg of
-                              RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn)
-                              _         -> GLD F80 (spRel off_w) dyn -- RcFloat/RcDouble
+                        in case regClass vreg of {
+                              RcInteger -> MOV L (OpAddr (spRel off_w)) (OpReg dyn);
+                              _         -> GLD F80 (spRel off_w) dyn} {- RcFloat/RcDouble -}
 
 	,IF_ARCH_sparc( 
-                        let off_w = 1 + (off `div` 4)
-                            sz = case regClass vreg of
-                                   RcInteger -> W
-                                   RcFloat   -> F
-                                   RcDouble  -> DF
+                        let{off_w = 1 + (off `div` 4);
+                            sz = case regClass vreg of {
+                                   RcInteger -> W;
+                                   RcFloat   -> F;
+                                   RcDouble  -> DF}}
                         in LD sz (fpRel (- off_w)) dyn
-        ,)))
+        ,IF_ARCH_powerpc(
+			let{sz = case regClass vreg of {
+                                    RcInteger -> W;
+                                    RcFloat   -> F;
+                                    RcDouble  -> DF}}
+			in LD sz dyn (AddrRegImm sp (ImmInt (off-delta)))
+	,))))
 \end{code}