Second

13 files changed, 462 insertions, 153 deletions

diff --git a/BuildIR.hs b/BuildIR.hs
index 28cbf5e..3d7b6c2 100644
--- a/BuildIR.hs
+++ b/BuildIR.hs
@@ -258,21 +258,20 @@ convertExpression (EBin bo e1 e2 _) nextnext = do
     switchBlock bl3
     ref <- genTemp (sizeof $ fromJust $ retTypeBO bo (fromJust $ typeof e1) (fromJust $ typeof e2))
     case bo of
-        BOAdd -> addIns $ IAri AAdd ref1 ref2
-        BOSub -> addIns $ IAri ASub ref1 ref2
-        BOMul -> addIns $ IAri AMul ref1 ref2
-        BODiv -> addIns $ IAri ADiv ref1 ref2
-        BOMod -> addIns $ IAri AMod ref1 ref2
-        BOEq -> addIns $ IAri AEq ref1 ref2
-        BONeq -> addIns $ IAri ANeq ref1 ref2
-        BOGt -> addIns $ IAri AGt ref1 ref2
-        BOLt -> addIns $ IAri ALt ref1 ref2
-        BOGeq -> addIns $ IAri AGeq ref1 ref2
-        BOLeq -> addIns $ IAri ALeq ref1 ref2
+        BOAdd -> addIns $ IAri AAdd ref ref1 ref2
+        BOSub -> addIns $ IAri ASub ref ref1 ref2
+        BOMul -> addIns $ IAri AMul ref ref1 ref2
+        BODiv -> addIns $ IAri ADiv ref ref1 ref2
+        BOMod -> addIns $ IAri AMod ref ref1 ref2
+        BOEq -> addIns $ IAri AEq ref ref1 ref2
+        BONeq -> addIns $ IAri ANeq ref ref1 ref2
+        BOGt -> addIns $ IAri AGt ref ref1 ref2
+        BOLt -> addIns $ IAri ALt ref ref1 ref2
+        BOGeq -> addIns $ IAri AGeq ref ref1 ref2
+        BOLeq -> addIns $ IAri ALeq ref ref1 ref2
         BOPow -> error $ "Pow operator not implemented"
         BOAnd -> undefined
         BOOr -> undefined
-    addIns $ IMov ref ref1
     setTerm $ IJmp nextnext
     return ref
 convertExpression (EUn UONot e mt) nextnext =
@@ -287,11 +286,14 @@ convertExpression (ESubscript arr sub t) nextnext = do
     bl3 <- newBlockNoSwitch
     subref <- convertExpression sub bl3
     switchBlock bl3
-    addIns $ IAri AMul subref (Constant (refSize subref) (fromIntegral elemsz))
-    addIns $ IAri AAdd subref (Constant (refSize subref) (fromIntegral $ sizeof TInt))
-    addIns $ IAri AAdd arrref subref
+    offref <- genTemp (refSize subref)
+    off8ref <- genTemp (refSize subref)
+    elemptr <- genTemp (refSize arrref)
+    addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral elemsz))
+    addIns $ IAri AAdd off8ref offref (Constant (refSize subref) (fromIntegral $ sizeof TInt))
+    addIns $ IAri AAdd elemptr arrref off8ref
     ref <- genTemp elemsz
-    addIns $ ILoad ref arrref
+    addIns $ ILoad ref elemptr
     setTerm $ IJmp nextnext
     return ref
 convertExpression (ECast dt e) nextnext = do
@@ -314,9 +316,11 @@ convertExpression (ENew t sze) nextnext = do
     szref <- convertExpression sze bl2
     switchBlock bl2
     ref <- genTemp (sizeof $ TArr t Nothing)
-    addIns $ IAri AMul szref (Constant (sizeof TInt) (fromIntegral $ sizeof t))
-    addIns $ IAri AAdd szref (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
-    addIns $ ICallr ref "_builtin_malloc" [szref]
+    argref' <- genTemp (sizeof TInt)
+    argref <- genTemp (sizeof TInt)
+    addIns $ IAri AMul argref' szref (Constant (sizeof TInt) (fromIntegral $ sizeof t))
+    addIns $ IAri AAdd argref argref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
+    addIns $ ICallr ref "_builtin_malloc" [argref]
     setTerm $ IJmp nextnext
     return ref
 
@@ -333,13 +337,16 @@ convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do
     let elemsz = sizeof $ fromJust mrt
     ae2ref <- goLoad ae2
     bl2 <- newBlockNoSwitch
-    offref <- convertExpression expr bl2
+    subref <- convertExpression expr bl2
     switchBlock bl2
+    offref' <- genTemp (sizeof TInt)
+    offref <- genTemp (sizeof TInt)
+    elemptr <- genTemp (sizeof TInt)
     -- TODO: do bounds checking
-    addIns $ IAri AMul offref (Constant (sizeof TInt) (fromIntegral elemsz))
-    addIns $ IAri AAdd offref (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
-    addIns $ IAri AAdd ae2ref offref
-    addIns $ IStore ae2ref valueref
+    addIns $ IAri AMul offref' subref (Constant (sizeof TInt) (fromIntegral elemsz))
+    addIns $ IAri AAdd offref offref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
+    addIns $ IAri AAdd elemptr ae2ref offref
+    addIns $ IStore elemptr valueref
     setTerm $ IJmp nextnext
   where
     goLoad :: AsExpression -> BuildM Ref
@@ -358,10 +365,13 @@ convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do
         bl2 <- newBlockNoSwitch
         eref <- convertExpression expr' bl2
         switchBlock bl2
+        offref' <- genTemp (sizeof TInt)
+        offref <- genTemp (sizeof TInt)
+        elemptr <- genTemp (sizeof TInt)
         -- TODO: do bounds checking
-        addIns $ IAri AMul eref (Constant (sizeof TInt) (fromIntegral elemsz))
-        addIns $ IAri AAdd eref (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
-        addIns $ IAri AAdd ref eref
+        addIns $ IAri AMul offref' eref (Constant (sizeof TInt) (fromIntegral elemsz))
+        addIns $ IAri AAdd offref offref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt))
+        addIns $ IAri AAdd elemptr ref offref
         dstref <- genTemp elemsz
-        addIns $ ILoad dstref ref
+        addIns $ ILoad dstref elemptr
         return dstref
diff --git a/CodeGen.hs b/CodeGen.hs
index d4c9439..774696f 100644
--- a/CodeGen.hs
+++ b/CodeGen.hs
@@ -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]]
diff --git a/Intermediate.hs b/Intermediate.hs
index 5f3a9f2..f97d407 100644
--- a/Intermediate.hs
+++ b/Intermediate.hs
@@ -24,7 +24,7 @@ data IRIns
     = IMov Ref Ref
     | IStore Ref Ref
     | ILoad Ref Ref
-    | IAri ArithType Ref Ref
+    | IAri ArithType Ref Ref Ref  -- destination, operand 1, operand 2
     | ICall Name [Ref]
     | ICallr Ref Name [Ref]
     | IResize Ref Ref
@@ -56,6 +56,10 @@ refSize (Argument sz _) = sz
 refSize (Global sz _) = sz
 refSize (Constant sz _) = sz
 
+isConstant :: Ref -> Bool
+isConstant (Constant _ _) = True
+isConstant _ = False
+
 
 instance Pretty BB where
     prettyI i (BB bid inss term) =
@@ -105,8 +109,8 @@ instance Pretty IRIns where
     prettyI _ (IMov d s) = "mov " ++ pretty d ++ " <- " ++ pretty s
     prettyI _ (IStore d s) = "store *" ++ pretty d ++ " <- " ++ pretty s
     prettyI _ (ILoad d s) = "load " ++ pretty d ++ " <- *" ++ pretty s
-    prettyI _ (IAri at d s) =
-        pretty at ++ " " ++ pretty d ++ ", " ++ pretty s
+    prettyI _ (IAri at d s1 s2) =
+        pretty at ++ " " ++ pretty d ++ " <- " ++ pretty s1 ++ ", " ++ pretty s2
     prettyI _ (ICall n al) =
         "call " ++ n ++ " (" ++ intercalate ", " (map pretty al) ++ ")"
     prettyI _ (ICallr d n al) =
@@ -172,3 +176,27 @@ evaluateCmp ct a b = case ct of
     CLt -> a < b
     CGeq -> a >= b
     CLeq -> a <= b
+
+isCommutative :: ArithType -> Bool
+isCommutative AAdd = True
+isCommutative AMul = True
+isCommutative AAnd = True
+isCommutative AOr = True
+isCommutative AXor = True
+isCommutative AEq = True
+isCommutative ANeq = True
+isCommutative ASub = False
+isCommutative ADiv = False
+isCommutative AMod = False
+isCommutative AGt = False
+isCommutative ALt = False
+isCommutative AGeq = False
+isCommutative ALeq = False
+
+isIMov :: IRIns -> Bool
+isIMov (IMov _ _) = True
+isIMov _ = False
+
+isIAri :: IRIns -> Bool
+isIAri (IAri _ _ _ _) = True
+isIAri _ = False
diff --git a/Main.hs b/Main.hs
index f1307c7..4c0f68d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -35,11 +35,10 @@ main = do
 
     let eres = return source
                  >>= parseProgram <?> "Parse error"
-                 -- >>= return . traceShowId
                  >>= typeCheck <?> "Type error"
                  >>= buildIR <?> "IR building error"
-                 -- >>= return . tracePrettyId
                  >>= optimise <?> "Error while optimising"
+                 >>= return . traceShowId
                  >>= verify <?> "Verify error"
                  >>= return . tracePrettyId
                  >>= codegen <?> "Codegen error"
diff --git a/Optimiser.hs b/Optimiser.hs
index 6e6227c..59396b2 100644
--- a/Optimiser.hs
+++ b/Optimiser.hs
@@ -1,5 +1,6 @@
 module Optimiser(optimise) where
 
+import Data.Either
 import Data.List
 import Data.Maybe
 import qualified Data.Map.Strict as Map
@@ -7,6 +8,7 @@ import Debug.Trace
 
 import Defs
 import Intermediate
+import Pretty
 import ReplaceRefs
 import Utils
 
@@ -16,15 +18,25 @@ type FuncOptimisation = IRFunc -> IRFunc
 
 optimise :: IRProgram -> Error IRProgram
 optimise prog =
-    let master = foldl1 (.) (reverse optimisations) {-. trace "-- OPT PASS --"-}
-        reslist = iterate master prog
-        pairs = zip reslist (tail reslist)
-    in Right $ fst $ fromJust $ find (uncurry (==)) pairs
+    let optlist = [trace "-- OPT PASS --" , \p -> trace (pretty p) p] ++ optimisations
+        reslist = scanl (flip ($)) prog $ cycle optlist
+        passreslist = map fst $ filter (\(_, i) -> i `mod` length optlist == 0) $ zip reslist [0..]
+        applyFinalOpts p = foldl (flip ($)) p finaloptimisations
+    in if True
+        then return $ applyFinalOpts $ 
+                fst $ fromJust $ find (uncurry (==)) $ zip passreslist (tail passreslist)
+        else return $ reslist !! 5
   where
-    optimisations = map funcopt $
-        -- [chainJumps, removeUnusedBlocks]
-        [chainJumps, mergeTerminators, looseJumps, removeUnusedBlocks, identityOps,
-         constantPropagate, removeNops, movPush, evaluateInstructions, evaluateTerminators]
+    optimisations = map funcopt
+        [chainJumps, mergeTerminators, looseJumps,
+         removeUnusedBlocks, removeDuplicateBlocks,
+         identityOps,
+         constantPropagate, movPush,
+         arithPush False, removeUnusedInstructions,
+         evaluateInstructions, evaluateTerminators,
+         flipJccs]
+    finaloptimisations = map funcopt
+        [arithPush True]
 
 
 funcopt :: FuncOptimisation -> Optimisation
@@ -93,6 +105,29 @@ removeUnusedBlocks (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
             IJmp i -> i == bid
             _ -> False
 
+removeDuplicateBlocks :: FuncOptimisation
+removeDuplicateBlocks (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
+  where
+    bbs' = let (bbspre, repls) = foldr foldfunc ([], []) bbs
+           in foldl (\l (from, to) -> replaceBBIds from to l) bbspre repls
+
+    foldfunc bb@(BB bid inss term) (l, repls) =
+        case find (\(BB _ inss' term') -> inss == inss' && term == term') l of
+            Nothing -> (bb : l, repls)
+            Just (BB bid' _ _) -> (l, (bid, bid') : repls)
+
+    replaceBBIds :: Id -> Id -> [BB] -> [BB]
+    replaceBBIds from to = map $ \(BB bid inss term) -> BB bid inss $ case term of
+        IJcc ct r1 r2 i1 i2 -> IJcc ct r1 r2 (trans from to i1) (trans from to i2)
+        IJmp i -> IJmp (trans from to i)
+        IRet -> IRet
+        IRetr r -> IRetr r
+        ITermNone -> undefined
+
+    trans :: (Eq a) => a -> a -> a -> a
+    trans a b c | a == c = b
+                | otherwise = c
+
 identityOps :: FuncOptimisation
 identityOps (IRFunc rt name al bbs sid) = IRFunc rt name al (map go bbs) sid
   where
@@ -100,10 +135,13 @@ identityOps (IRFunc rt name al bbs sid) = IRFunc rt name al (map go bbs) sid
     go (BB bid inss term) = BB bid (catMaybes $ map goI inss) term
 
     goI :: IRIns -> Maybe IRIns
-    goI (IAri AAdd _ (Constant _ 0)) = Nothing
-    goI (IAri ASub _ (Constant _ 0)) = Nothing
-    goI (IAri AMul _ (Constant _ 1)) = Nothing
-    goI (IAri ADiv _ (Constant _ 1)) = Nothing
+    goI (IAri AAdd d s (Constant _ 0)) = Just $ IMov d s
+    goI (IAri AAdd d (Constant _ 0) s) = Just $ IMov d s
+    goI (IAri ASub d s (Constant _ 0)) = Just $ IMov d s
+    goI (IAri AMul d s (Constant _ 1)) = Just $ IMov d s
+    goI (IAri AMul d (Constant _ 1) s) = Just $ IMov d s
+    goI (IAri ADiv d s (Constant _ 1)) = Just $ IMov d s
+    goI (IMov d s) | d == s = Nothing
     goI i = Just i
 
 constantPropagate :: FuncOptimisation
@@ -114,12 +152,7 @@ constantPropagate (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
         let locs = findMutations' bbs ref
             loc = head locs
             ins = insAt bbs loc
-
-            isIMov (IMov _ _) = True
-            isIMov _ = False
-        in {-trace ("Muts of " ++ show ref ++ ": " ++ show locs ++ ": " ++
-                    show (map (insAt bbs) locs)) $-}
-           if length locs == 1 && isIMov ins
+        in if length locs == 1 && isIMov ins
                then Just (loc, ins)
                else Nothing
 
@@ -129,52 +162,173 @@ constantPropagate (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
                     replaceRefsBBList ref value (nopifyInsAt bbs loc)
                 _ -> undefined
 
-removeNops :: FuncOptimisation
-removeNops (IRFunc rt name al bbs sid) =
-    IRFunc rt name al (map go bbs) sid
-  where
-    go (BB bid inss term) = BB bid (filter (not . isNop) inss) term
-    isNop INop = True
-    isNop _ = False
-
 movPush :: FuncOptimisation
-movPush (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
+movPush (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid
+  where
+    goBB :: BB -> BB
+    goBB (BB bid inss term) =
+        let inss' = go inss term
+            term' = if null inss' then term else pushT (last inss) term
+        in BB bid inss' term'
+
+    go :: [IRIns] -> IRTerm -> [IRIns]
+    go [] _ = []
+    go (ins@(IMov d _) : rest) term
+        | isJust (find (== d) (findAllRefsInss rest ++ findAllRefsTerm term)) =
+            push ins rest term
+    go (ins : rest) term = ins : go rest term
+
+    push :: IRIns -> [IRIns] -> IRTerm -> [IRIns]
+    push mov [] _ = [mov]
+    push (IMov d s) l _ | d == s = l
+    push mov@(IMov d s) (ins@(IMov d' s') : rest) term
+        | d' == d = if d' == s' then push mov rest term else push ins rest term
+        | d' == s = mov : push (IMov d' (replaceRef d s s')) rest term
+        | otherwise = IMov d' (replaceRef d s s') : push mov rest term
+    push mov@(IMov d s) (IResize d' s' : rest) term
+        | d' == d = IResize d' (replaceRef d s s') : go rest term
+        | d' == s = mov : IResize d' (replaceRef d s s') : go rest term
+        | otherwise = IResize d' (replaceRef d s s') : push mov rest term
+    push mov@(IMov d s) (ILoad d' s' : rest) term
+        | d' == d = ILoad d' (replaceRef d s s') : go rest term
+        | d' == s = mov : ILoad d' (replaceRef d s s') : go rest term
+        | otherwise = ILoad d' (replaceRef d s s') : push mov rest term
+    push mov@(IMov d s) (IAri at d' s1' s2' : rest) term
+        | d' == d = IAri at d' (replaceRef d s s1') (replaceRef d s s2') : go rest term
+        | d' == s = mov : IAri at d' (replaceRef d s s1') (replaceRef d s s2') : go rest term
+        | otherwise = IAri at d' (replaceRef d s s1') (replaceRef d s s2') : push mov rest term
+    -- I don't trust going past calls because globals might change. Might be able to
+    -- catch that case, but that will go wrong when more stuff gets added.
+    -- push mov@(IMov d s) (ins@(ICallr d' _ _) : rest) term
+    --     | d' == d = mov : ins : go rest term
+    --     | otherwise = replaceRefsIns d s ins : push mov rest term
+    -- push mov@(IMov d s) (ins@(ICall _ _) : rest) term = replaceRefsIns d s ins : push mov rest term
+    push mov@(IMov d s) (ins@(IStore _ _) : rest) term = replaceRefsIns d s ins : push mov rest term
+    push mov (INop : rest) term = push mov rest term
+    push mov l term = mov : go l term
+
+    pushT :: IRIns -> IRTerm -> IRTerm
+    pushT (IMov d s) term = replaceRefsTerm d s term
+    pushT _ term = term
+
+arithPush :: Bool -> FuncOptimisation
+arithPush ariari (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid
   where
-    bbs' = map goBB bbs
-
     goBB :: BB -> BB
-    goBB (BB bid inss term) = BB bid (go inss) term
+    goBB (BB bid inss term) =
+        let (inss', [Right term']) = span isLeft $ go (map Left inss ++ [Right term])
+        in BB bid (map (fromLeft undefined) inss') term'
 
-    go :: [IRIns] -> [IRIns]
+    go :: [Either IRIns IRTerm] -> [Either IRIns IRTerm]
     go [] = []
-    go (ins@(IMov d _) : rest) | isJust (find (== d) (findAllRefsInss rest)) = push ins rest
+    go (Left ari@(IAri _ _ _ _) : rest) = Left ari : go (propagate ari rest)
     go (ins : rest) = ins : go rest
 
-    push :: IRIns -> [IRIns] -> [IRIns]
-    push mov [] = [mov]
-    push mov@(IMov d s) (ins@(IMov d' s') : rest)
-        | d' == d = if s' == d then push mov rest else push ins rest
-        | otherwise = replaceRefsIns d s ins : push mov rest
-    push mov@(IMov d s) (ins@(IResize d' s') : rest)
-        | d' == d = if s' == d then push mov rest else push ins rest
-        | otherwise = replaceRefsIns d s ins : push mov rest
-    push mov@(IMov d s) (ins@(ILoad d' _) : rest)
-        | d' == d = mov : ins : go rest
-        | otherwise = replaceRefsIns d s ins : push mov rest
-    push mov@(IMov d s) (ins@(IAri at d' s') : rest)
-        | d' == d = case (s, s') of
-            (Constant sza a, Constant szb b)
-                | sza == szb -> push (IMov d (Constant sza $ evaluateArith at a b)) rest
-                | otherwise -> error $ "Inconsistent sizes in " ++ show mov ++ "; " ++ show ins
-            _ -> mov : ins : go rest
-        | otherwise = replaceRefsIns d s ins : push mov rest
-    push mov@(IMov d s) (ins@(ICallr d' _ _) : rest)
-        | d' == d = mov : ins : go rest
-        | otherwise = replaceRefsIns d s ins : push mov rest
-    push mov@(IMov d s) (ins@(IStore _ _) : rest) = replaceRefsIns d s ins : push mov rest
-    push mov@(IMov d s) (ins@(ICall _ _) : rest) = replaceRefsIns d s ins : push mov rest
-    push mov (ins@INop : rest) = ins : push mov rest
-    push _ _ = undefined
+    propagate :: IRIns -> [Either IRIns IRTerm] -> [Either IRIns IRTerm]
+    propagate _ [] = []
+    propagate ari@(IAri at d s1 s2) (Left ins@(IMov md ms) : rest)
+        | d == ms = Left (IAri at md s1 s2) : (if d /= md then propagate ari rest else rest)
+        | d /= md && md /= s1 && md /= s2 = Left ins : propagate ari rest
+        | otherwise = Left ins : rest
+    propagate ari@(IAri _ d _ _) (Left ins@(IStore md ms) : rest)
+        | null (intersect [d] [md,ms]) = Left ins : propagate ari rest
+        | otherwise = Left ins : rest
+    propagate ari@(IAri _ d s1 s2) (Left ins@(ILoad md ms) : rest)
+        | null (intersect [d] [md,ms] ++ intersect [s1,s2] [md]) = Left ins : propagate ari rest
+        | otherwise = Left ins : rest
+    propagate ari@(IAri at d s1 s2) (Left ins@(IAri mat md ms1 ms2) : rest)
+        | ariari && d /= md && (at, s1, s2) == (mat, ms1, ms2) = Left (IMov md d) : propagate ari rest
+        | null (intersect [d] [md,ms1,ms2] ++ intersect [s1,s2] [md]) = Left ins : propagate ari rest
+        | otherwise = Left ins : propagate ins rest
+    -- I don't trust going past calls because globals might change. Might be able to
+    -- catch that case, but that will go wrong when more stuff gets added.
+    -- propagate ari@(IAri _ d s1 s2) (Left ins@(ICall _ mal) : rest)
+    --     | null (intersect [d] mal) = Left ins : propagate ari rest
+    --     | otherwise = Left ins : rest
+    -- propagate ari@(IAri _ d s1 s2) (Left ins@(ICallr md _ mal) : rest)
+    --     | null (intersect [d,s1,s2] (md : mal)) = Left ins : propagate ari rest
+    --     | otherwise = Left ins : rest
+    propagate ari@(IAri _ d s1 s2) (Left ins@(IResize md ms) : rest)
+        | null (intersect [d] [md,ms] ++ intersect [s1,s2] [md]) = Left ins : propagate ari rest
+        | otherwise = Left ins : rest
+    propagate ari@(IAri _ _ _ _) (Left INop : rest) = propagate ari rest
+    propagate (IAri at d s1 s2) (Right term@(IJcc ct r1 r2 i1 i2) : rest)
+        | (r1 == d || r2 == d) &&
+          (isConstant r1 || isConstant r2) &&
+          at `elem` [AEq, ANeq, AGt, ALt, AGeq, ALeq] =
+            let ct' = if isConstant r2 then ct else flipCmpType ct
+                conref = if isConstant r2 then r2 else r1
+                (ct'', con) = case (ct', conref) of
+                    (CEq, Constant _ c) -> (CEq, if c `elem` [0, 1] then c else (-1))
+                    (CNeq, Constant _ c) -> (CNeq, if c `elem` [0, 1] then c else (-1))
+                    (CGt, Constant _ c) | c < 0 -> (CNeq, (-1))
+                                        | c == 0 -> (CEq, 1)
+                                        | otherwise -> (CEq, (-1))
+                    (CLt, Constant _ c) | c > 1 -> (CNeq, (-1))
+                                        | c == 1 -> (CEq, 0)
+                                        | otherwise -> (CEq, (-1))
+                    (CGeq, Constant _ c) | c <= 0 -> (CNeq, (-1))
+                                         | c == 1 -> (CEq, 1)
+                                         | otherwise -> (CEq, (-1))
+                    (CLeq, Constant _ c) | c >= 1 -> (CNeq, (-1))
+                                         | c == 0 -> (CEq, 0)
+                                         | otherwise -> (CEq, (-1))
+                    _ -> undefined
+                resterm = case (ct'', con) of
+                    (CEq, 0) -> IJcc (invertCmpType (arithTypeToCmpType at)) s1 s2 i1 i2
+                    (CEq, 1) -> IJcc (arithTypeToCmpType at) s1 s2 i1 i2
+                    (CEq, _) -> IJmp i2
+                    (CNeq, 0) -> IJcc (arithTypeToCmpType at) s1 s2 i1 i2
+                    (CNeq, 1) -> IJcc (invertCmpType (arithTypeToCmpType at)) s1 s2 i1 i2
+                    (CNeq, _) -> IJmp i1
+                    _ -> undefined
+            in Right resterm : rest
+        | otherwise = Right term : rest
+    propagate _ l = l
+
+flipCmpType :: CmpType -> CmpType
+flipCmpType CEq = CEq
+flipCmpType CNeq = CNeq
+flipCmpType CGt = CLt
+flipCmpType CLt = CGt
+flipCmpType CGeq = CLeq
+flipCmpType CLeq = CGeq
+
+invertCmpType :: CmpType -> CmpType
+invertCmpType CEq = CNeq
+invertCmpType CNeq = CEq
+invertCmpType CGt = CLeq
+invertCmpType CLt = CGeq
+invertCmpType CGeq = CLt
+invertCmpType CLeq = CGt
+
+arithTypeToCmpType :: ArithType -> CmpType
+arithTypeToCmpType AEq = CEq
+arithTypeToCmpType ANeq = CNeq
+arithTypeToCmpType AGt = CGt
+arithTypeToCmpType ALt = CLt
+arithTypeToCmpType AGeq = CGeq
+arithTypeToCmpType ALeq = CLeq
+arithTypeToCmpType _ = undefined
+
+removeUnusedInstructions :: FuncOptimisation
+removeUnusedInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid
+  where
+    goBB :: BB -> BB
+    goBB (BB bid inss term) = BB bid (catMaybes $ map goI inss) term
+
+    goI :: IRIns -> Maybe IRIns
+    goI ins@(IMov d _) = pureInstruction d ins
+    goI ins@(IStore _ _) = Just ins
+    goI ins@(ILoad d _) = pureInstruction d ins
+    goI ins@(IAri _ d _ _) = pureInstruction d ins
+    goI ins@(ICall _ _) = Just ins
+    goI ins@(ICallr _ _ _) = Just ins
+    goI ins@(IResize d _) = pureInstruction d ins
+    goI INop = Nothing
+
+    pureInstruction :: Ref -> IRIns -> Maybe IRIns
+    pureInstruction d ins = if length (findMentions' bbs d) == 1 then Nothing else Just ins
 
 evaluateInstructions :: FuncOptimisation
 evaluateInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid
@@ -183,7 +337,10 @@ evaluateInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB b
     goBB (BB bid inss term) = BB bid (map goI inss) term
 
     goI :: IRIns -> IRIns
-    goI (IResize ref (Constant _ v)) = IMov ref $ Constant (refSize ref) $ truncValue (refSize ref) v
+    goI (IAri at ref (Constant _ v1) (Constant _ v2)) =
+        IMov ref $ Constant (refSize ref) $ truncValue (refSize ref) $ evaluateArith at v1 v2
+    goI (IResize ref (Constant _ v)) =
+        IMov ref $ Constant (refSize ref) $ truncValue (refSize ref) v
     goI ins = ins
 
     truncValue :: Size -> Value -> Value
@@ -201,6 +358,16 @@ evaluateTerminators (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid
         | otherwise = IJmp i2
     go term = term
 
+flipJccs :: FuncOptimisation
+flipJccs (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid
+  where
+    goBB :: BB -> BB
+    goBB (BB bid inss term) = BB bid inss (goT term)
+
+    goT :: IRTerm -> IRTerm
+    goT (IJcc ct r1@(Constant _ _) r2 i1 i2) = IJcc (flipCmpType ct) r2 r1 i1 i2
+    goT term = term
+
 
 insAt :: [BB] -> (Int, Int) -> IRIns
 insAt bbs (i, j) =
@@ -217,28 +384,52 @@ findMutations :: BB -> Ref -> [Int]
 findMutations (BB _ inss _) ref =
     catMaybes $ flip map (zip inss [0..]) $ \(ins, idx) -> case ins of
         (IMov r _) | r == ref -> Just idx
-        (IAri _ r _) | r == ref -> Just idx
+        (IAri _ r _ _) | r == ref -> Just idx
         (ICallr r _ _) | r == ref -> Just idx
+        (IResize r _) | r == ref -> Just idx
         _ -> Nothing
 
 findMutations' :: [BB] -> Ref -> [(Int, Int)]
 findMutations' bbs ref =
     [(i, j) | (bb, i) <- zip bbs [0..], j <- findMutations bb ref]
 
+findMentions :: BB -> Ref -> [Int]
+findMentions (BB _ inss term) ref = insres ++ termres
+  where
+    insres = catMaybes $ flip map (zip inss [0..]) $ \(ins, idx) ->
+        if ref `elem` findAllRefsIns ins
+            then Just idx
+            else Nothing
+    termres = if ref `elem` findAllRefsTerm term
+                then [length inss]
+                else []
+
+findMentions' :: [BB] -> Ref -> [(Int, Int)]
+findMentions' bbs ref =
+    [(i, j) | (bb, i) <- zip bbs [0..], j <- findMentions bb ref]
+
 findAllRefs :: BB -> [Ref]
 findAllRefs (BB _ inss _) = findAllRefsInss inss
 
 findAllRefsInss :: [IRIns] -> [Ref]
-findAllRefsInss inss = uniq $ sort $ concatMap go inss
-  where
-    go (IMov a b) = [a, b]
-    go (IStore a b) = [a, b]
-    go (ILoad a b) = [a, b]
-    go (IAri _ a b) = [a, b]
-    go (ICall _ al) = al
-    go (ICallr a _ al) = a : al
-    go (IResize a b) = [a, b]
-    go INop = []
+findAllRefsInss inss = uniq $ sort $ concatMap findAllRefsIns inss
+
+findAllRefsIns :: IRIns -> [Ref]
+findAllRefsIns (IMov a b) = [a, b]
+findAllRefsIns (IStore a b) = [a, b]
+findAllRefsIns (ILoad a b) = [a, b]
+findAllRefsIns (IAri _ a b c) = [a, b, c]
+findAllRefsIns (ICall _ al) = al
+findAllRefsIns (ICallr a _ al) = a : al
+findAllRefsIns (IResize a b) = [a, b]
+findAllRefsIns INop = []
+
+findAllRefsTerm :: IRTerm -> [Ref]
+findAllRefsTerm (IJcc _ a b _ _) = [a, b]
+findAllRefsTerm (IJmp _) = []
+findAllRefsTerm IRet = []
+findAllRefsTerm (IRetr a) = [a]
+findAllRefsTerm ITermNone = undefined
 
 -- findAllRefs' :: [BB] -> [Ref]
 -- findAllRefs' = uniq . sort . concatMap findAllRefs
diff --git a/RegAlloc.hs b/RegAlloc.hs
index d2b1717..3a41aac 100644
--- a/RegAlloc.hs
+++ b/RegAlloc.hs
@@ -42,8 +42,7 @@ regalloc vars' regs aliaspairs =
                                         AllocReg r -> Just r
             in if length (stActive st) == length regs
                    then spillAtInterval st index
-                   else let -- ([regchoice], fr) = splitAt 1 (stFreeRegs st)
-                            (regchoice, fr) = case find (`elem` wantedregs) (stFreeRegs st) of
+                   else let (regchoice, fr) = case find (`elem` wantedregs) (stFreeRegs st) of
                                 Nothing -> (head (stFreeRegs st), tail (stFreeRegs st))
                                 Just wr -> trace ("Pair-allocated " ++ show name ++ " in " ++ show wr) $
                                            (wr, stFreeRegs st \\ [wr])
diff --git a/ReplaceRefs.hs b/ReplaceRefs.hs
index 3ab73c3..821952b 100644
--- a/ReplaceRefs.hs
+++ b/ReplaceRefs.hs
@@ -1,15 +1,18 @@
 module ReplaceRefs
-    (replaceRefsIns, replaceRefsTerm, replaceRefsBB, replaceRefsBBList)
+    (replaceRef, replaceRefsIns, replaceRefsTerm, replaceRefsBB, replaceRefsBBList)
     where
 
 import Intermediate
 
 
+replaceRef :: Ref -> Ref -> Ref -> Ref
+replaceRef = trans
+
 replaceRefsIns :: Ref -> Ref -> IRIns -> IRIns
 replaceRefsIns from to (IMov a b) = IMov (trans from to a) (trans from to b)
 replaceRefsIns from to (IStore a b) = IStore (trans from to a) (trans from to b)
 replaceRefsIns from to (ILoad a b) = ILoad (trans from to a) (trans from to b)
-replaceRefsIns from to (IAri at a b) = IAri at (trans from to a) (trans from to b)
+replaceRefsIns from to (IAri at a b c) = IAri at (trans from to a) (trans from to b) (trans from to c)
 replaceRefsIns from to (ICall n al) = ICall n (map (trans from to) al)
 replaceRefsIns from to (ICallr a n al) = ICallr (trans from to a) n (map (trans from to) al)
 replaceRefsIns from to (IResize a b) = IResize (trans from to a) (trans from to b)
diff --git a/X64.hs b/X64.hs
index a2d63aa..66a9605 100644
--- a/X64.hs
+++ b/X64.hs
@@ -68,7 +68,8 @@ instance XRefSub Imm where
 instance XRefSub RegMem where
     xref x@(XReg _ _) = RegMem x
     xref x@(XMem _ _ _ _ _) = RegMem x
-    xref _ = undefined
+    xref x = RegMem x
+    -- xref _ = undefined
 instance XRefSub RegMemImm where
     xref x = RegMemImm x
 
@@ -266,6 +267,10 @@ xrefSetSize sz (XReg _ r) = XReg sz r
 xrefSetSize sz (XMem _ a b c d) = XMem sz a b c d
 xrefSetSize _ x@(XImm _) = x
 
+isXReg :: XRef -> Bool
+isXReg (XReg _ _) = True
+isXReg _ = False
+
 isXMem :: XRef -> Bool
 isXMem (XMem _ _ _ _ _) = True
 isXMem _ = False
diff --git a/X64Optimiser.hs b/X64Optimiser.hs
new file mode 100644
index 0000000..9cae96d
--- /dev/null
+++ b/X64Optimiser.hs
@@ -0,0 +1,15 @@
+module X64Optimiser(x64Optimise) where
+
+import Defs
+import X64
+
+
+x64Optimise :: Asm -> Error Asm
+x64Optimise (Asm funcs) = return $ Asm [(name, concat $ map goI inss) | (name, inss) <- funcs]
+  where
+    goI :: Ins -> [Ins]
+    goI (MOV (RegMem a) (RegMem b)) | a == b = []
+    goI (MOVi (RegMem a) (Imm (XImm 0))) | isXReg a = [XOR (RegMem a) (RegMemImm a)]
+    goI (MOVi64 (Reg a) (Imm (XImm 0))) = [XOR (RegMem a) (RegMemImm a)]
+    goI (MOVSX (Reg a) (RegMem b)) | a == b = []
+    goI ins = [ins]
diff --git a/bf.lang b/bf.lang
index d9366fb..71a5d8a 100644
--- a/bf.lang
+++ b/bf.lang
@@ -88,6 +88,7 @@ func int main() {
 	int done := 0;
 	while (done != 1) {
 		int c := getc();
+		// putc(char(c));
 		if (c < 0) {
 			done = 1;
 		} else {
diff --git a/chaincond.lang b/chaincond.lang
new file mode 100644
index 0000000..542cae9
--- /dev/null
+++ b/chaincond.lang
@@ -0,0 +1,14 @@
+func int main() {
+	int a := 0;
+	if (a == 0) {
+		a = 1;
+	} else {
+		a = 2;
+	}
+	if (a > 0) {
+		a = 10;
+	} else {
+		a = 20;
+	}
+	return a;
+}
\ No newline at end of file
diff --git a/putstr.lang b/putstr.lang
index b13e2c5..7485d8f 100644
--- a/putstr.lang
+++ b/putstr.lang
@@ -6,7 +6,17 @@ func putstr(char[] str) {
 	}
 }
 
-func int main() {return 0;}
+func int main() {
+	char[] str := new char[100];
+	str[0] = 'k';
+	str[1] = 'a';
+	str[2] = str[1];
+	str[3] = 's';
+	str[4] = '\n';
+	str[5] = '\0';
+	putstr(str);
+	return 0;
+}
 
 
 
@@ -17,24 +27,19 @@ irfunc putstr(char[] str)
     jmp 7
   }}}
   {{{(7)
-    mov t15Q <- t5Q
-    add t15Q, 8Q
-    mov t13Q <- astrQ
-    add t13Q, t15Q
-    load t16B <- *t13Q
-    neq t16B, 0B
-    jne t16B, 0Q -> 9 | 6
+    add t17Q <- t5Q, 8Q
+    add t18Q <- astrQ, t17Q
+    load t19B <- *t18Q
+    neq t22Q <- t19B, 0B
+    jne t22Q, 0Q -> 9 | 6
   }}}
   {{{(9)
-    mov t25Q <- t5Q
-    add t25Q, 8Q
-    mov t23Q <- astrQ
-    add t23Q, t25Q
-    load t26B <- *t23Q
-    call putc (t26B)
-    mov t30Q <- t5Q
-    add t30Q, 1Q
-    mov t5Q <- t30Q
+    add t30Q <- t5Q, 8Q
+    add t31Q <- astrQ, t30Q
+    load t32B <- *t31Q
+    call putc (t32B)
+    add t39Q <- t5Q, 1Q
+    mov t5Q <- t39Q
     jmp 7
   }}}
   {{{(6)
diff --git a/strlen.lang b/strlen.lang
new file mode 100644
index 0000000..27c23a3
--- /dev/null
+++ b/strlen.lang
@@ -0,0 +1,11 @@
+func int strlen(char[] str) {
+	int i := 0;
+	char c := str[i];
+	while (c != '\0') {
+		i = i + 1;
+		c = str[i];
+	}
+	return i;
+}
+
+func int main() {return 0;}