diff options
Diffstat (limited to 'CodeGen.hs')
| -rw-r--r-- | CodeGen.hs | 86 |
1 files changed, 57 insertions, 29 deletions
@@ -20,6 +20,7 @@ import RegAlloc import Utils import X64 (Register(..), CondCode(..), XRef(..), Ins(..), xref) import qualified X64 as X64 +import X64Optimiser data CGState = CGState @@ -61,10 +62,11 @@ setSpillSize sz = modify $ \s -> s {spillSize = sz} codegen :: IRProgram -> Error String codegen (IRProgram vars funcs) = do x64 <- execCGMonad $ mapM_ codegenFunc funcs - -- traceShowM x64 + traceShowM x64 X64.verify x64 varcg <- liftM unlines $ mapM codegenVar vars - return $ [there|prologue.asm|] ++ "\n" ++ X64.stringify x64 ++ + x64opt <- x64Optimise x64 + return $ [there|prologue.asm|] ++ "\n" ++ X64.stringify x64opt ++ "\nsection .data\n" ++ (if length vars > 0 then varcg else "db 0 ; keep dyld happy\n") @@ -96,9 +98,9 @@ codegenFunc (IRFunc _ name al bbs sid) = do AllocReg reg -> Just reg AllocMem -> Nothing - traceShowM temprefsperbb - traceShowM lifespans - -- traceM $ "ALLOCATION: " ++ show allocation + -- traceShowM temprefsperbb + -- traceShowM lifespans + traceM $ "ALLOCATION: " ++ show allocation let nsaves = length usedregs allocationXref = flip Map.mapWithKey allocation $ \ref alloc -> case alloc of @@ -133,6 +135,9 @@ findAliasCandidates = concatMap (\(BB _ inss _) -> concatMap goI inss) where goI :: IRIns -> [(Ref, Ref)] goI (IMov d s) = [(d, s)] + goI (IAri at d s1 s2) + | isCommutative at = [(d, s1), (d, s2)] + | otherwise = [(d, s1)] goI _ = [] findFirstLast :: forall a. (a -> Bool) -> [a] -> Maybe (Int, Int) @@ -174,7 +179,8 @@ mkmov a@(XReg _ _) b@(XMem _ _ _ _ _) = MOV (xref a) (xref b) mkmov a@(XReg _ _) b@(XImm _) = MOVi64 (xref a) (xref b) mkmov a@(XMem _ _ _ _ _) b@(XReg _ _) = MOV (xref a) (xref b) mkmov a@(XMem _ _ _ _ _) b@(XImm v) | v < 2 ^ (32 :: Int) = MOVi (xref a) (xref b) -mkmov a b = error $ "Invalid mkmov: " ++ show a ++ "; " ++ show b +mkmov a b = CALL $ "Invalid mkmov: " ++ show a ++ "; " ++ show b +-- mkmov a b = error $ "Invalid mkmov: " ++ show a ++ "; " ++ show b mkcmp :: XRef -> XRef -> X64.Ins mkcmp a b@(XImm _) = CMPi (xref a) (xref b) @@ -221,45 +227,56 @@ codegenIns m (ILoad d s) = do where dm = mkxref d m sm = mkxref s m sz = fromIntegral $ refSize d -codegenIns m (IAri AMul d s) = do +codegenIns m (IAri AMul d s1 s2) = do let sz = fromIntegral $ refSize d - addIns $ mkmov (XReg sz RAX) (mkxref d m) - addIns $ mkmov (XReg sz RBX) (mkxref s m) + addIns $ mkmov (XReg sz RAX) (mkxref s1 m) + addIns $ mkmov (XReg sz RBX) (mkxref s2 m) addIns $ IMULDA (xref $ XReg sz RBX) addIns $ mkmov (mkxref d m) (XReg sz RAX) -codegenIns m (IAri ADiv d s) = do +codegenIns m (IAri ADiv d s1 s2) = do let sz = fromIntegral $ refSize d addIns $ XOR (xref $ XReg 4 RDX) (xref $ XReg 4 RDX) - addIns $ mkmov (XReg sz RAX) (mkxref d m) - addIns $ mkmov (XReg sz RBX) (mkxref s m) + addIns $ mkmov (XReg sz RAX) (mkxref s1 m) + addIns $ mkmov (XReg sz RBX) (mkxref s2 m) addIns $ IDIVDA (xref $ XReg sz RBX) addIns $ mkmov (mkxref d m) (XReg sz RAX) -codegenIns m (IAri AMod d s) = do +codegenIns m (IAri AMod d s1 s2) = do let sz = fromIntegral $ refSize d addIns $ XOR (xref $ XReg 4 RDX) (xref $ XReg 4 RDX) - addIns $ mkmov (XReg sz RAX) (mkxref d m) - addIns $ mkmov (XReg sz RBX) (mkxref s m) + addIns $ mkmov (XReg sz RAX) (mkxref s1 m) + addIns $ mkmov (XReg sz RBX) (mkxref s2 m) addIns $ IDIVDA (xref $ XReg sz RBX) addIns $ mkmov (mkxref d m) (XReg sz RDX) -codegenIns m (IAri at d s) = case arithTypeToCondCode at of +codegenIns m (IAri at d s1 s2) = case arithTypeToCondCode at of Just cc -> do - arg2 <- if X64.isXMem dm && X64.isXMem sm + arg2 <- if X64.isXMem s1m && X64.isXMem s2m then do - addIns $ mkmov (XReg (fromIntegral $ refSize s) RAX) sm - return $ XReg (fromIntegral $ refSize s) RAX - else return sm - addIns $ mkcmp dm arg2 - addIns $ MOVi (xref dm) (xref $ XImm 0) + addIns $ mkmov (XReg (fromIntegral $ refSize s2) RAX) s2m + return $ XReg (fromIntegral $ refSize s2) RAX + else return s2m + addIns $ mkcmp s1m arg2 addIns $ SETCC cc (xref $ X64.xrefSetSize 1 dm) + addIns $ AND (xref $ X64.xrefSetSize 4 dm) (xref $ XImm 0xff) Nothing -> do - arg2 <- if X64.isXMem dm && X64.isXMem sm + (_, s1m', s2', s2m') <- + if dm == s2m + then if dm == s1m + then return (s1, s1m, s2, s2m) + else if isCommutative at + then return (s2, s2m, s1, s1m) + else throwError "Noncommutative op with d==s2/=s1" + else return (s1, s1m, s2, s2m) + + arg2 <- if X64.isXMem s1m' && X64.isXMem s2m' then do - addIns $ mkmov (XReg (fromIntegral $ refSize s) RAX) sm - return $ XReg (fromIntegral $ refSize s) RAX - else return sm + addIns $ mkmov (XReg (fromIntegral $ refSize s2') RAX) s2m' + return $ XReg (fromIntegral $ refSize s2') RAX + else return s2m' + when (dm /= s1m') $ addIns $ mkmov dm s1m' addIns $ fromJust (arithTypeToIns at) dm arg2 where dm = mkxref d m - sm = mkxref s m + s1m = mkxref s1 m + s2m = mkxref s2 m codegenIns m (ICall n rs) = do forM_ (zip (reverse rs) [1::Int ..]) $ \(r, i) -> let sz = fromIntegral $ refSize r @@ -328,9 +345,17 @@ arithTypeToIns _ = Nothing codegenTerm :: AllocMap -> IRTerm -> CGMonad () codegenTerm m (IJcc ct a b t e) = do - addIns $ mkcmp (mkxref a m) (mkxref b m) + if X64.isXMem am && X64.isXMem bm + then do + addIns $ mkmov (XReg (fromIntegral $ refSize b) RAX) bm + addIns $ mkcmp am (XReg (fromIntegral $ refSize b) RAX) + else do + addIns $ mkcmp am bm addIns $ JCC (cmpTypeToCondCode ct) (".bb" ++ show t) addIns $ JMP (".bb" ++ show e) + where + am = mkxref a m + bm = mkxref b m codegenTerm _ (IJmp i) = addIns $ JMP (".bb" ++ show i) codegenTerm _ IRet = do spillsz <- gets spillSize @@ -363,7 +388,10 @@ collectTempRefs bbs = listRefsIns (IMov a b) = [[LA.Read b], [LA.Write a]] listRefsIns (IStore a b) = [[LA.Read a, LA.Read b]] listRefsIns (ILoad a b) = [[LA.Read b], [LA.Write a]] - listRefsIns (IAri _ a b) = [[LA.Write a, LA.Read b]] + listRefsIns (IAri at a b c) + -- if not commutative, we don't want to have to xchg the operands + | isCommutative at = [[LA.Read b, LA.Read c], [LA.Write a]] + | otherwise = [[LA.Read b], [LA.Read c, LA.Write a]] listRefsIns (ICall _ l) = [map LA.Read l] listRefsIns (ICallr a _ l) = [LA.Write a : map LA.Read l] listRefsIns (IResize a b) = [[LA.Read b], [LA.Write a]] |