X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FRegAllocInfo.hs;h=98c4e2dfe061310d19ec1cfc1481f1c1e819e5c7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=da2727b387af21c2e39fbf727251e1fad9d494da;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/RegAllocInfo.hs b/ghc/compiler/nativeGen/RegAllocInfo.hs index da2727b..98c4e2d 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.hs +++ b/ghc/compiler/nativeGen/RegAllocInfo.hs @@ -14,19 +14,20 @@ module RegAllocInfo ( regUsage, patchRegs, jumpDests, + patchJump, isRegRegMove, maxSpillSlots, mkSpillInstr, mkLoadInstr, + mkRegRegMoveInstr, + mkBranchInstr ) where #include "HsVersions.h" import Cmm ( BlockId ) -#if powerpc_TARGET_ARCH || i386_TARGET_ARCH -import MachOp ( MachRep(..) ) -#endif +import MachOp ( MachRep(..), wordRep ) import MachInstrs import MachRegs import Outputable @@ -138,7 +139,7 @@ regUsage instr = case instr of #endif /* alpha_TARGET_ARCH */ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH regUsage instr = case instr of MOV sz src dst -> usageRW src dst @@ -149,7 +150,7 @@ regUsage instr = case instr of ADC 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] + IMUL2 sz src -> mkRU (eax:use_R src) [eax,edx] MUL sz src dst -> usageRM src dst DIV sz op -> mkRU (eax:edx:use_R op) [eax,edx] IDIV sz op -> mkRU (eax:edx:use_R op) [eax,edx] @@ -161,24 +162,25 @@ regUsage instr = case instr of SHL sz imm dst -> usageRM imm dst SAR sz imm dst -> usageRM imm dst SHR sz imm dst -> usageRM imm dst - BT sz imm src -> mkRU (use_R src) [] + BT sz imm src -> mkRUR (use_R src) - PUSH sz op -> mkRU (use_R op) [] + PUSH sz op -> mkRUR (use_R op) POP sz op -> mkRU [] (def_W op) - TEST sz src dst -> mkRU (use_R src ++ use_R dst) [] - CMP sz src dst -> mkRU (use_R src ++ use_R dst) [] + TEST sz src dst -> mkRUR (use_R src ++ use_R dst) + CMP sz src dst -> mkRUR (use_R src ++ use_R dst) SETCC cond op -> mkRU [] (def_W op) JXX cond lbl -> mkRU [] [] - JMP op -> mkRU (use_R op) [] - JMP_TBL op ids -> mkRU (use_R op) [] - CALL (Left imm) -> mkRU [] callClobberedRegs - CALL (Right reg) -> mkRU [reg] callClobberedRegs - CLTD -> mkRU [eax] [edx] + JMP op -> mkRUR (use_R op) + JMP_TBL op ids -> mkRUR (use_R op) + CALL (Left imm) params -> mkRU params callClobberedRegs + CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs + CLTD sz -> mkRU [eax] [edx] NOP -> mkRU [] [] +#if i386_TARGET_ARCH GMOV src dst -> mkRU [src] [dst] GLD sz src dst -> mkRU (use_EA src) [dst] - GST sz src dst -> mkRU (src : use_EA dst) [] + GST sz src dst -> mkRUR (src : use_EA dst) GLDZ dst -> mkRU [] [dst] GLD1 dst -> mkRU [] [dst] @@ -194,13 +196,27 @@ regUsage instr = case instr of GMUL sz s1 s2 dst -> mkRU [s1,s2] [dst] GDIV sz s1 s2 dst -> mkRU [s1,s2] [dst] - GCMP sz src1 src2 -> mkRU [src1,src2] [] + GCMP sz src1 src2 -> mkRUR [src1,src2] GABS sz src dst -> mkRU [src] [dst] GNEG sz src dst -> mkRU [src] [dst] GSQRT sz src dst -> mkRU [src] [dst] GSIN sz src dst -> mkRU [src] [dst] GCOS sz src dst -> mkRU [src] [dst] GTAN sz src dst -> mkRU [src] [dst] +#endif + +#if x86_64_TARGET_ARCH + CVTSS2SD src dst -> mkRU [src] [dst] + CVTSD2SS src dst -> mkRU [src] [dst] + CVTSS2SI src dst -> mkRU (use_R src) [dst] + CVTSD2SI src dst -> mkRU (use_R src) [dst] + CVTSI2SS src dst -> mkRU (use_R src) [dst] + CVTSI2SD src dst -> mkRU (use_R src) [dst] + FDIV sz src dst -> usageRM src dst +#endif + + FETCHGOT reg -> mkRU [] [reg] + FETCHPC reg -> mkRU [] [reg] COMMENT _ -> noUsage DELTA _ -> noUsage @@ -208,20 +224,26 @@ regUsage instr = case instr of _other -> panic "regUsage: unrecognised instr" where +#if x86_64_TARGET_ARCH + -- call parameters: include %eax, because it is used + -- to pass the number of SSE reg arguments to varargs fns. + params = eax : allArgRegs ++ allFPArgRegs +#endif + -- 2 operand form; first operand Read; second Written usageRW :: Operand -> Operand -> RegUsage usageRW op (OpReg reg) = mkRU (use_R op) [reg] - usageRW op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) [] + usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) -- 2 operand form; first operand Read; second Modified usageRM :: Operand -> Operand -> RegUsage usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg] - usageRM op (OpAddr ea) = mkRU (use_R op ++ use_EA ea) [] + usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea) -- 1 operand form; operand Modified usageM :: Operand -> RegUsage usageM (OpReg reg) = mkRU [reg] [reg] - usageM (OpAddr ea) = mkRU (use_EA ea) [] + usageM (OpAddr ea) = mkRUR (use_EA ea) -- Registers defd when an operand is written. def_W (OpReg reg) = [reg] @@ -233,16 +255,22 @@ regUsage instr = case instr of use_R (OpAddr ea) = use_EA ea -- Registers used to compute an effective address. - use_EA (ImmAddr _ _) = [] - use_EA (AddrBaseIndex Nothing Nothing _) = [] - use_EA (AddrBaseIndex (Just b) Nothing _) = [b] - use_EA (AddrBaseIndex Nothing (Just (i,_)) _) = [i] - use_EA (AddrBaseIndex (Just b) (Just (i,_)) _) = [b,i] - - mkRU src dst = RU (filter interesting src) - (filter interesting dst) - -#endif /* i386_TARGET_ARCH */ + use_EA (ImmAddr _ _) = [] + use_EA (AddrBaseIndex base index _) = + use_base base $! use_index index + where use_base (EABaseReg r) x = r : x + use_base _ x = x + use_index EAIndexNone = [] + use_index (EAIndex i _) = [i] + + mkRUR src = src' `seq` RU src' [] + where src' = filter interesting src + + mkRU src dst = src' `seq` dst' `seq` RU src' dst' + where src' = filter interesting src + dst' = filter interesting dst + +#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if sparc_TARGET_ARCH @@ -276,7 +304,7 @@ regUsage instr = case instr of FxTOy s1 s2 r1 r2 -> usage ([r1], [r2]) -- We assume that all local jumps will be BI/BF. JMP must be out-of-line. - JMP dst addr -> usage (regAddr addr, []) + JMP addr -> usage (regAddr addr, []) CALL (Left imm) n True -> noUsage CALL (Left imm) n False -> usage (argRegs n, callClobberedRegs) @@ -285,8 +313,8 @@ regUsage instr = case instr of _ -> noUsage where - usage (src, dst) = RU (regSetFromList (filter interesting src)) - (regSetFromList (filter interesting dst)) + usage (src, dst) = RU (filter interesting src) + (filter interesting dst) regAddr (AddrRegReg r1 r2) = [r1, r2] regAddr (AddrRegImm r1 _) = [r1] @@ -344,6 +372,8 @@ regUsage instr = case instr of FCTIWZ r1 r2 -> usage ([r2], [r1]) FRSP r1 r2 -> usage ([r2], [r1]) MFCR reg -> usage ([], [reg]) + MFLR reg -> usage ([], [reg]) + FETCHPC reg -> usage ([], [reg]) _ -> noUsage where usage (src, dst) = RU (filter interesting src) @@ -366,7 +396,7 @@ regUsage instr = case instr of jumpDests :: Instr -> [BlockId] -> [BlockId] jumpDests insn acc = case insn of -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH JXX _ id -> id : acc JMP_TBL _ ids -> ids ++ acc #elif powerpc_TARGET_ARCH @@ -375,6 +405,18 @@ jumpDests insn acc #endif _other -> acc +patchJump :: Instr -> BlockId -> BlockId -> Instr + +patchJump insn old new + = case insn of +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH + JXX cc id | id == old -> JXX cc new + JMP_TBL op ids -> error "Cannot patch JMP_TBL" +#elif powerpc_TARGET_ARCH + BCC cc id | id == old -> BCC cc new + BCTR targets -> error "Cannot patch BCTR" +#endif + _other -> insn -- ----------------------------------------------------------------------------- -- 'patchRegs' function @@ -441,7 +483,7 @@ patchRegs instr env = case instr of #endif /* alpha_TARGET_ARCH */ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH patchRegs instr env = case instr of MOV sz src dst -> patch2 (MOV sz) src dst @@ -452,7 +494,7 @@ patchRegs instr env = case instr of ADC sz src dst -> patch2 (ADC 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) + IMUL2 sz src -> patch1 (IMUL2 sz) src MUL sz src dst -> patch2 (MUL sz) src dst IDIV sz op -> patch1 (IDIV sz) op DIV sz op -> patch1 (DIV sz) op @@ -473,6 +515,7 @@ patchRegs instr env = case instr of JMP op -> patch1 JMP op JMP_TBL op ids -> patch1 JMP_TBL op $ ids +#if i386_TARGET_ARCH GMOV src dst -> GMOV (env src) (env dst) GLD sz src dst -> GLD sz (lookupAddr src) (env dst) GST sz src dst -> GST sz (env src) (lookupAddr dst) @@ -498,15 +541,29 @@ patchRegs instr env = case instr of GSIN sz src dst -> GSIN sz (env src) (env dst) GCOS sz src dst -> GCOS sz (env src) (env dst) GTAN sz src dst -> GTAN sz (env src) (env dst) +#endif - CALL (Left imm) -> instr - CALL (Right reg) -> CALL (Right (env reg)) - +#if x86_64_TARGET_ARCH + CVTSS2SD src dst -> CVTSS2SD (env src) (env dst) + CVTSD2SS src dst -> CVTSD2SS (env src) (env dst) + CVTSS2SI src dst -> CVTSS2SI (patchOp src) (env dst) + CVTSD2SI src dst -> CVTSD2SI (patchOp src) (env dst) + CVTSI2SS src dst -> CVTSI2SS (patchOp src) (env dst) + CVTSI2SD src dst -> CVTSI2SD (patchOp src) (env dst) + FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) +#endif + + CALL (Left imm) _ -> instr + CALL (Right reg) p -> CALL (Right (env reg)) p + + FETCHGOT reg -> FETCHGOT (env reg) + FETCHPC reg -> FETCHPC (env reg) + NOP -> instr COMMENT _ -> instr DELTA _ -> instr JXX _ _ -> instr - CLTD -> instr + CLTD _ -> instr _other -> panic "patchRegs: unrecognised instr" @@ -514,21 +571,22 @@ patchRegs instr env = case instr of patch1 insn op = insn $! patchOp op patch2 insn src dst = (insn $! patchOp src) $! patchOp dst - patchOp (OpReg reg) = OpReg (env reg) + patchOp (OpReg reg) = OpReg $! env reg patchOp (OpImm imm) = OpImm imm - patchOp (OpAddr ea) = OpAddr (lookupAddr ea) + patchOp (OpAddr ea) = OpAddr $! lookupAddr ea lookupAddr (ImmAddr imm off) = ImmAddr imm off lookupAddr (AddrBaseIndex base index disp) - = AddrBaseIndex (lookupBase base) (lookupIndex index) disp + = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp where - lookupBase Nothing = Nothing - lookupBase (Just r) = Just (env r) + lookupBase EABaseNone = EABaseNone + lookupBase EABaseRip = EABaseRip + lookupBase (EABaseReg r) = EABaseReg (env r) - lookupIndex Nothing = Nothing - lookupIndex (Just (r,i)) = Just (env r, i) + lookupIndex EAIndexNone = EAIndexNone + lookupIndex (EAIndex r i) = EAIndex (env r) i -#endif /* i386_TARGET_ARCH */ +#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH*/ -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #if sparc_TARGET_ARCH @@ -560,7 +618,7 @@ patchRegs instr env = case instr of FSQRT s r1 r2 -> FSQRT s (env r1) (env r2) 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) + JMP addr -> JMP (fixAddr addr) CALL (Left i) n t -> CALL (Left i) n t CALL (Right r) n t -> CALL (Right (env r)) n t _ -> instr @@ -621,6 +679,8 @@ patchRegs instr env = case instr of FCTIWZ r1 r2 -> FCTIWZ (env r1) (env r2) FRSP r1 r2 -> FRSP (env r1) (env r2) MFCR reg -> MFCR (env reg) + MFLR reg -> MFLR (env reg) + FETCHPC reg -> FETCHPC (env reg) _ -> instr where fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2) @@ -637,7 +697,7 @@ patchRegs instr env = case instr of -- by assigning the src and dest temporaries to the same real register. isRegRegMove :: Instr -> Maybe (Reg,Reg) -#ifdef i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -- TMP: isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2) #elif powerpc_TARGET_ARCH @@ -670,14 +730,22 @@ mkSpillInstr reg delta slot RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w)) _ -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -} #endif +#ifdef x86_64_TARGET_ARCH + let off_w = (off-delta) `div` 8 + in case regClass reg of + RcInteger -> MOV I64 (OpReg reg) (OpAddr (spRel off_w)) + RcDouble -> MOV F64 (OpReg reg) (OpAddr (spRel off_w)) + -- ToDo: will it work to always spill as a double? + -- does that cause a stall if the data was a float? +#endif #ifdef sparc_TARGET_ARCH {-SPARC: spill below frame pointer leaving 2 words/spill-} 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)) + sz = case regClass reg of { + RcInteger -> I32; + RcFloat -> F32; + RcDouble -> F64}} + in ST sz reg (fpRel (- off_w)) #endif #ifdef powerpc_TARGET_ARCH let sz = case regClass reg of @@ -697,30 +765,72 @@ mkLoadInstr reg delta slot let off = spillSlotToOffset slot in -#ifdef alpha_TARGET_ARCH +#if alpha_TARGET_ARCH LD sz dyn (spRel (- (off `div` 8))) #endif -#ifdef i386_TARGET_ARCH +#if i386_TARGET_ARCH let off_w = (off-delta) `div` 4 in case regClass reg of { RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg); _ -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -} #endif -#ifdef sparc_TARGET_ARCH +#if x86_64_TARGET_ARCH + let off_w = (off-delta) `div` 8 + in case regClass reg of + RcInteger -> MOV I64 (OpAddr (spRel off_w)) (OpReg reg) + _ -> MOV F64 (OpAddr (spRel off_w)) (OpReg reg) +#endif +#if sparc_TARGET_ARCH 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 + sz = case regClass reg of { + RcInteger -> I32; + RcFloat -> F32; + RcDouble -> F64}} + in LD sz (fpRel (- off_w)) reg #endif -#ifdef powerpc_TARGET_ARCH +#if powerpc_TARGET_ARCH let sz = case regClass reg of RcInteger -> I32 RcDouble -> F64 in LD sz reg (AddrRegImm sp (ImmInt (off-delta))) #endif +mkRegRegMoveInstr + :: Reg + -> Reg + -> Instr +mkRegRegMoveInstr src dst +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH + = case regClass src of + RcInteger -> MOV wordRep (OpReg src) (OpReg dst) +#if i386_TARGET_ARCH + RcDouble -> GMOV src dst +#else + RcDouble -> MOV F64 (OpReg src) (OpReg dst) +#endif +#elif powerpc_TARGET_ARCH + = MR dst src +#endif + +mkBranchInstr + :: BlockId + -> [Instr] +#if alpha_TARGET_ARCH +mkBranchInstr id = [BR id] +#endif + +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH +mkBranchInstr id = [JXX ALWAYS id] +#endif + +#if sparc_TARGET_ARCH +mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP] +#endif + +#if powerpc_TARGET_ARCH +mkBranchInstr id = [BCC ALWAYS id] +#endif + spillSlotSize :: Int spillSlotSize = IF_ARCH_i386(12, 8)