linearscan-hoopl 0.6.0.0 → 0.7.0
raw patch · 8 files changed
+454/−120 lines, 8 filesdep −tardisdep ~linearscandep ~linearscan-hoopl
Dependencies removed: tardis
Dependency ranges changed: linearscan, linearscan-hoopl
Files
- LinearScan/Hoopl.hs +23/−22
- LinearScan/Hoopl/DSL.hs +3/−12
- linearscan-hoopl.cabal +4/−6
- test/AsmTest.hs +4/−2
- test/Assembly.hs +19/−25
- test/Generated.hs +6/−4
- test/Main.hs +394/−49
- test/Programs/Exhaustion.hs +1/−0
LinearScan/Hoopl.hs view
@@ -11,9 +11,10 @@ import Control.Applicative import Control.Arrow import Control.Monad.Trans.Class-import Control.Monad.Trans.Tardis+import Control.Monad.Trans.State import Data.Foldable import Data.Functor.Identity+import qualified Data.IntMap as IM import qualified Data.Map as M import Data.Monoid import Debug.Trace@@ -33,10 +34,10 @@ getReferences :: nv e x -> [VarInfo] setRegisters :: [(Int, PhysReg)] -> nv e x -> Env (nr e x) - mkMoveOps :: PhysReg -> PhysReg -> Env [nr O O]- mkSwapOps :: PhysReg -> PhysReg -> Env [nr O O]- mkSaveOps :: PhysReg -> Maybe VarId -> Env [nr O O]- mkRestoreOps :: Maybe VarId -> PhysReg -> Env [nr O O]+ mkMoveOps :: PhysReg -> VarId -> PhysReg -> Env [nr O O]+ mkSwapOps :: PhysReg -> VarId -> PhysReg -> VarId -> Env [nr O O]+ mkSaveOps :: PhysReg -> VarId -> Env [nr O O]+ mkRestoreOps :: VarId -> PhysReg -> Env [nr O O] op1ToString :: nv e x -> String @@ -56,8 +57,8 @@ , splitCriticalEdge = \(BlockCC b m e) (BlockCC next _ _) -> do let lab = entryLabel next- (next:supply, stack) <- getPast- sendFuture (supply, stack)+ (next:supply, stack) <- get+ put (supply, stack) let lab' = unsafeCoerce next return (BlockCC b m (retargetBranch e lab lab'), BlockCC (mkLabelOp lab') BNil (mkJumpOp lab))@@ -86,10 +87,10 @@ NodeOO n -> getReferences n NodeOC n -> getReferences n - , moveOp = \x y -> fmap NodeOO <$> mkMoveOps x y- , swapOp = \x y -> fmap NodeOO <$> mkSwapOps x y- , saveOp = \x y -> fmap NodeOO <$> mkSaveOps x y- , restoreOp = \x y -> fmap NodeOO <$> mkRestoreOps x y+ , moveOp = \x xv y -> fmap NodeOO <$> mkMoveOps x xv y+ , swapOp = \x xv y yv -> fmap NodeOO <$> mkSwapOps x xv y yv+ , saveOp = \x xv -> fmap NodeOO <$> mkSaveOps x xv+ , restoreOp = \yv y -> fmap NodeOO <$> mkRestoreOps yv y , applyAllocs = \node m -> case node of@@ -104,26 +105,26 @@ } allocateHoopl :: (NodeAlloc nv nr, NonLocal nv, NonLocal nr)- => Int -- ^ Number of machine registers- -> Int -- ^ Offset of the spill stack- -> Int -- ^ Size of spilled register in bytes- -> Label -- ^ Label of graph entry block+ => Int -- ^ Number of machine registers+ -> Int -- ^ Offset of the spill stack+ -> Int -- ^ Size of spilled register in bytes+ -> UseVerifier -- ^ Whether to use allocation verifier+ -> Label -- ^ Label of graph entry block -> Graph nv C C -- ^ Program graph- -> Either [String] (Graph nr C C)-allocateHoopl regs offset slotSize entry graph =- newGraph <$> runIdentity (go (1 + length blocks))+ -> Either (String, [String]) (Graph nr C C)+allocateHoopl regs offset slotSize useVerifier entry graph =+ newGraph <$> runIdentity (go (1 + IM.size (unsafeCoerce body))) where newGraph xs = GMany NothingO (newBody xs) NothingO where newBody = Data.Foldable.foldl' (flip addBlock) emptyBody blocks = postorder_dfs_from body entry- where- GMany NothingO body NothingO = graph+ GMany NothingO body NothingO = graph - go n = evalTardisT alloc (mempty, ([n..], newSpillStack offset slotSize))+ go n = evalStateT alloc ([n..], newSpillStack offset slotSize) where- alloc = allocate regs (blockInfo getBlockId) opInfo blocks+ alloc = allocate regs (blockInfo getBlockId) opInfo useVerifier blocks where getBlockId :: Hoopl.Label -> Env Int getBlockId = return . unsafeCoerce
LinearScan/Hoopl/DSL.hs view
@@ -15,7 +15,6 @@ import qualified Control.Monad.Trans.Free as TF import Control.Monad.Trans.Free hiding (FreeF(..), Free) import Control.Monad.Trans.State-import Control.Monad.Trans.Tardis import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Monoid@@ -30,7 +29,7 @@ } deriving (Eq, Show) -type Env = Tardis (M.Map PhysReg VarId) ([Int], SpillStack)+type Env = State ([Int], SpillStack) newSpillStack :: Int -> Int -> SpillStack newSpillStack offset slotSize = SpillStack@@ -41,24 +40,16 @@ getStackSlot :: Maybe VarId -> Env Int getStackSlot vid = do- (supply, stack) <- getPast+ (supply, stack) <- get case M.lookup vid (stackSlots stack) of Just off -> return off Nothing -> do let off = stackPtr stack- sendFuture (supply, stack+ put (supply, stack { stackPtr = off + stackSlotSize stack , stackSlots = M.insert vid off (stackSlots stack) }) return off--setAssignment :: PhysReg -> VarId -> Env ()-setAssignment = (modifyBackwards .) . M.insert--getAssignment :: PhysReg -> Env VarId-getAssignment reg =- fromMaybe (error $ "No assignment for register r" ++ show reg)- . M.lookup reg <$> getFuture -- | The 'Asm' monad lets us create labels by name and refer to them later. type Labels = M.Map String Label
linearscan-hoopl.cabal view
@@ -1,5 +1,5 @@ name: linearscan-hoopl-version: 0.6.0.0+version: 0.7.0 synopsis: Makes it easy to use the linearscan register allocator with Hoopl homepage: http://github.com/jwiegley/linearscan-hoopl license: BSD3@@ -27,8 +27,7 @@ build-depends: base >=4.7 && <5 , hoopl >= 3.10.0.1- , linearscan >= 0.3.0.1- , tardis >= 0.3.0.0+ , linearscan >= 0.7.0.0 , containers , transformers , free@@ -53,11 +52,10 @@ , hspec >= 1.4.4 , hspec-expectations >= 0.3 , hoopl >= 3.10.0.1 && < 3.11- , linearscan >= 0.5.0.0- , linearscan-hoopl >= 0.5.0.0+ , linearscan >= 0.7.0.0+ , linearscan-hoopl >= 0.7.0.0 , containers >= 0.5.5 , transformers >= 0.3.0.0- , tardis >= 0.3.0.0 , lens-family-core , deepseq , QuickCheck
test/AsmTest.hs view
@@ -15,8 +15,10 @@ asmTestLiteral :: Int -> Program (Node IRVar) -> Maybe String -> Expectation asmTestLiteral regs program mexpected = do let (graph, entry) = runSimpleUniqueMonad $ compile "entry" program- case allocateHoopl regs 0 8 entry graph of- Left err -> error $ "Allocation failed: " ++ intercalate "\n" err+ case allocateHoopl regs 0 8 VerifyEnabled entry graph of+ Left (dump, err) ->+ error $ "Allocation failed: " ++ intercalate "\n" err ++ "\n"+ ++ dump Right graph' -> case mexpected of Nothing -> return () Just expected ->
test/Assembly.hs view
@@ -87,10 +87,8 @@ show (LoadConst _c v) = " lc " ++ show v -- ++ " " ++ show c show (Move x1 x2) = " move " ++ show x1 ++ " " ++ show x2 show (Copy x1 x2) = " copy " ++ show x1 ++ " " ++ show x2- show (Save src dst) = " save " ++ show (varReg src) ++ " "- ++ show dst- show (Restore src dst) = " restore " ++ show src ++ " "- ++ show (varReg dst)+ show (Save src dst) = " save " ++ show src ++ " " ++ show dst+ show (Restore src dst) = " restore " ++ show src ++ " " ++ show dst show (Trace str) = " trace " ++ " " ++ show str show (Jump l) = " jump \"" ++ show l ++ "\"" show (Branch _ v t f) = " branch " ++ show v@@ -173,7 +171,7 @@ instance Show a => Show (Assign a PhysReg) where show (Assign v (-1)) = "<<v" ++ show v ++ ">>"- show (Assign v r) = "r" ++ show r ++ "|v" ++ show v+ show (Assign v r) = "(r" ++ show r ++ " v" ++ show v ++ ")" class VarReg a where varReg :: a -> PhysReg@@ -246,32 +244,28 @@ , regRequired = True } - setRegisters m g = do- -- for_ m $ \(v, r) -> setAssignment r v- return $ over variables go g+ setRegisters m g = return $ over variables go g where go :: IRVar -> Assign VarId PhysReg go (PhysicalIV r) = Assign (-1) r go (VirtualIV n) = Assign n (fromMaybe (-1) (Data.List.lookup n m)) - mkMoveOps src dst = do- -- vid <- getAssignment src- let vid = 0- return [Move (Assign vid src) (Assign vid dst)]- mkSwapOps src dst =- liftA2 (++) (mkRestoreOps Nothing dst)- (mkSaveOps src Nothing)+ mkMoveOps sreg svar dreg = do+ return [Move (Assign svar sreg) (Assign svar dreg)] - mkSaveOps src dst = do- off <- getStackSlot dst- vid <- getAssignment src- -- let vid = 0- return [Save (Assign vid src) off]- mkRestoreOps src dst = do- off <- getStackSlot src- -- vid <- getAssignment dst- let vid = 0- return [Restore off (Assign vid dst)]+ mkSwapOps sreg svar dreg dvar = do+ save1 <- mkSaveOps svar sreg+ save2 <- mkMoveOps dreg dvar sreg+ rest <- mkRestoreOps svar dreg+ return $ save1 ++ save2 ++ rest++ mkSaveOps sreg dvar = do+ off <- getStackSlot (Just dvar)+ return [Save (Assign dvar sreg) off]++ mkRestoreOps svar dreg = do+ off <- getStackSlot (Just svar)+ return [Restore off (Assign svar dreg)] op1ToString = show
test/Generated.hs view
@@ -13,6 +13,7 @@ import qualified Data.IntMap as IM import qualified Data.IntSet as IS import Data.List (intercalate, isInfixOf)+import LinearScan (UseVerifier(VerifyDisabled)) import LinearScan.Hoopl import Test.FuzzCheck as F hiding (branch) import Test.Hspec@@ -94,19 +95,20 @@ generatedTests :: SpecWith () generatedTests = it "Handles generated tests" $- (\a -> fuzzCheck' a 10000 (return ())) $ do+ (\a -> fuzzCheck' a 100 (return ())) $ do (graph :: Graph (Node IRVar) C C) <- "create graph" ?> pure <$> rand let GMany _ body _ = graph let entry = unsafeCoerce (head (IS.elems (unsafeCoerce (externalEntryLabels body))))- case allocateHoopl 32 0 8 entry graph of- Left err+ case allocateHoopl 32 0 8 VerifyDisabled entry graph of+ Left (dump, err) | any ("Cannot insert interval onto unhandled list" `isInfixOf`) err -> True `shouldBe` True | otherwise ->- error $ "Allocation failed: " ++ intercalate "\n" err+ error $ "Allocation failed: " ++ intercalate "\n" err ++ "\n"+ ++ dump Right graph' -> do let g = showGraph show graph' _ <- evaluate (length g)
test/Main.hs view
@@ -5,7 +5,7 @@ import AsmTest import Assembly--- import Generated+import Generated import LinearScan.Hoopl.DSL -- import Programs.Blocked import Programs.Exhaustion@@ -27,27 +27,35 @@ it "Near exhaustion program" $ asmTest_ 32 exhaustion1 -- it "Blocked register program" $ asmTest_ 32 regBlocked - -- describe "Generated tests" generatedTests+ describe "Generated tests" generatedTests sanityTests :: SpecWith () sanityTests = do it "Single instruction" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1) add (r0 v0) (r1 v1) (r0 v2) return_ it "Single, repeated instruction" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 add v0 v1 v2 add v0 v1 v2 return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1) add (r0 v0) (r1 v1) (r2 v2) add (r0 v0) (r1 v1) (r2 v2) add (r0 v0) (r1 v1) (r2 v2)@@ -55,12 +63,16 @@ it "Multiple instructions" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 add v0 v1 v3 add v0 v1 v2 return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1) add (r0 v0) (r1 v1) (r2 v2) add (r0 v0) (r1 v1) (r3 v3) add (r0 v0) (r1 v1) (r2 v2)@@ -92,28 +104,33 @@ lc (r3 v4) lc (r4 v6) lc (r5 v7)- save (r5 v0) 0+ save (r5 v7) 0 lc (r5 v9)- save (r5 v0) 8+ save (r5 v9) 8 lc (r5 v10)- save (r5 v0) 16+ save (r5 v10) 16 lc (r5 v12)- save (r5 v0) 24+ save (r5 v12) 24 lc (r5 v13) add (r0 v0) (r1 v1) (r0 v2) add (r2 v3) (r3 v4) (r1 v5)- restore 0 (r3 v0)+ restore 0 (r3 v7) add (r4 v6) (r3 v7) (r2 v8)- save (r0 v0) 32- restore 8 (r4 v0)- restore 16 (r0 v0)+ save (r0 v2) 32+ restore 8 (r4 v9)+ restore 16 (r0 v10) add (r4 v9) (r0 v10) (r3 v11)- restore 24 (r4 v0)+ restore 24 (r4 v12) add (r4 v12) (r5 v13) (r0 v14) return_ it "Single long-lived variable" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1+ lc v4+ lc v7+ lc v10 add v0 v1 v2 add v0 v4 v5 add v0 v7 v8@@ -121,6 +138,11 @@ return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1)+ lc (r2 v4)+ lc (r3 v7)+ lc (r4 v10) add (r0 v0) (r1 v1) (r1 v2) add (r0 v0) (r2 v4) (r2 v5) add (r0 v0) (r3 v7) (r3 v8)@@ -129,6 +151,9 @@ it "Two long-lived variables" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1+ lc v4 add v0 v1 v2 add v0 v4 v5 add v0 v4 v8@@ -136,6 +161,9 @@ return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1)+ lc (r2 v4) add (r0 v0) (r1 v1) (r1 v2) add (r0 v0) (r2 v4) (r3 v5) add (r0 v0) (r2 v4) (r4 v8)@@ -144,6 +172,29 @@ it "One variable with a long interval" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1+ lc v3+ lc v4+ lc v6+ lc v7+ lc v9+ lc v10+ lc v12+ lc v13+ lc v15+ lc v16+ lc v18+ lc v19+ lc v21+ lc v22+ lc v24+ lc v25+ lc v27+ lc v28+ lc v30+ lc v31+ lc v34 add v0 v1 v2 add v3 v4 v5 add v6 v7 v8@@ -159,6 +210,29 @@ return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1)+ lc (r2 v3)+ lc (r3 v4)+ lc (r4 v6)+ lc (r5 v7)+ lc (r6 v9)+ lc (r7 v10)+ lc (r8 v12)+ lc (r9 v13)+ lc (r10 v15)+ lc (r11 v16)+ lc (r12 v18)+ lc (r13 v19)+ lc (r14 v21)+ lc (r15 v22)+ lc (r16 v24)+ lc (r17 v25)+ lc (r18 v27)+ lc (r19 v28)+ lc (r20 v30)+ lc (r21 v31)+ lc (r22 v34) add (r0 v0) (r1 v1) (r1 v2) add (r2 v3) (r3 v4) (r2 v5) add (r4 v6) (r5 v7) (r3 v8)@@ -175,6 +249,26 @@ it "Many variables with long intervals" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1+ lc v3+ lc v4+ lc v6+ lc v7+ lc v9+ lc v10+ lc v12+ lc v13+ lc v15+ lc v16+ lc v18+ lc v19+ lc v21+ lc v22+ lc v24+ lc v25+ lc v27+ lc v28 add v0 v1 v2 add v3 v4 v5 add v6 v7 v8@@ -198,6 +292,26 @@ return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1)+ lc (r2 v3)+ lc (r3 v4)+ lc (r4 v6)+ lc (r5 v7)+ lc (r6 v9)+ lc (r7 v10)+ lc (r8 v12)+ lc (r9 v13)+ lc (r10 v15)+ lc (r11 v16)+ lc (r12 v18)+ lc (r13 v19)+ lc (r14 v21)+ lc (r15 v22)+ lc (r16 v24)+ lc (r17 v25)+ lc (r18 v27)+ lc (r19 v28) add (r0 v0) (r1 v1) (r20 v2) add (r2 v3) (r3 v4) (r21 v5) add (r4 v6) (r5 v7) (r22 v8)@@ -224,6 +338,30 @@ spillTests = do it "No spilling necessary" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1+ lc v3+ lc v4+ lc v6+ lc v7+ lc v9+ lc v10+ lc v12+ lc v13+ lc v15+ lc v16+ lc v18+ lc v19+ lc v21+ lc v22+ lc v24+ lc v25+ lc v27+ lc v28+ lc v30+ lc v31+ lc v33+ lc v34 add v0 v1 v2 add v3 v4 v5 add v6 v7 v8@@ -251,6 +389,30 @@ return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1)+ lc (r2 v3)+ lc (r3 v4)+ lc (r4 v6)+ lc (r5 v7)+ lc (r6 v9)+ lc (r7 v10)+ lc (r8 v12)+ lc (r9 v13)+ lc (r10 v15)+ lc (r11 v16)+ lc (r12 v18)+ lc (r13 v19)+ lc (r14 v21)+ lc (r15 v22)+ lc (r16 v24)+ lc (r17 v25)+ lc (r18 v27)+ lc (r19 v28)+ lc (r20 v30)+ lc (r21 v31)+ lc (r22 v33)+ lc (r23 v34) add (r0 v0) (r1 v1) (r24 v2) add (r2 v3) (r3 v4) (r25 v5) add (r4 v6) (r5 v7) (r26 v8)@@ -259,13 +421,13 @@ add (r10 v15) (r11 v16) (r29 v17) add (r12 v18) (r13 v19) (r30 v20) add (r14 v21) (r15 v22) (r31 v23)- save (r31 v0) 0 -- jww (2015-05-26): These saves are unnecessary+ save (r31 v23) 0 -- jww (2015-05-26): These saves are unnecessary add (r16 v24) (r17 v25) (r31 v26)- save (r31 v0) 8+ save (r31 v26) 8 add (r18 v27) (r19 v28) (r31 v29)- save (r31 v0) 16+ save (r31 v29) 16 add (r20 v30) (r21 v31) (r31 v32)- save (r31 v0) 24+ save (r31 v32) 24 add (r22 v33) (r23 v34) (r31 v35) add (r0 v0) (r1 v1) (r24 v2) add (r2 v3) (r3 v4) (r25 v5)@@ -274,19 +436,41 @@ add (r8 v12) (r9 v13) (r28 v14) add (r10 v15) (r11 v16) (r29 v17) add (r12 v18) (r13 v19) (r30 v20)- restore 0 (r0 v0)+ restore 0 (r0 v23) add (r14 v21) (r15 v22) (r0 v23)- restore 8 (r1 v31)+ restore 8 (r1 v26) add (r16 v24) (r17 v25) (r1 v26)- restore 16 (r2 v0)+ restore 16 (r2 v29) add (r18 v27) (r19 v28) (r2 v29)- restore 24 (r3 v0)+ restore 24 (r3 v32) add (r20 v30) (r21 v31) (r3 v32) add (r22 v33) (r23 v34) (r31 v35) return_ it "Spilling one variable" $ asmTest 32 (label "entry" $ do+ lc v0+ lc v1+ lc v3+ lc v4+ lc v6+ lc v7+ lc v9+ lc v10+ lc v12+ lc v13+ lc v15+ lc v16+ lc v18+ lc v19+ lc v21+ lc v22+ lc v24+ lc v25+ lc v27+ lc v28+ lc v30+ lc v31 add v0 v1 v2 add v3 v4 v5 add v6 v7 v8@@ -312,6 +496,28 @@ return_) $ label "entry" $ do+ lc (r0 v0)+ lc (r1 v1)+ lc (r2 v3)+ lc (r3 v4)+ lc (r4 v6)+ lc (r5 v7)+ lc (r6 v9)+ lc (r7 v10)+ lc (r8 v12)+ lc (r9 v13)+ lc (r10 v15)+ lc (r11 v16)+ lc (r12 v18)+ lc (r13 v19)+ lc (r14 v21)+ lc (r15 v22)+ lc (r16 v24)+ lc (r17 v25)+ lc (r18 v27)+ lc (r19 v28)+ lc (r20 v30)+ lc (r21 v31) add (r0 v0) (r1 v1) (r22 v2) add (r2 v3) (r3 v4) (r23 v5) add (r4 v6) (r5 v7) (r24 v8)@@ -327,7 +533,7 @@ -- v30), we must spill a register because there are not 32 registers. -- So we pick the first register, counting from 0, whose next use -- position is the furthest from this position.- save (r31 v0) 0+ save (r31 v29) 0 add (r20 v30) (r21 v31) (r31 v32) @@ -343,7 +549,7 @@ -- When it comes time to reload v29, we pick the first available -- register.- restore 0 (r0 v0)+ restore 0 (r0 v29) add (r18 v27) (r0 v29) (r19 v28) add (r20 v30) (r31 v32) (r21 v31)@@ -401,13 +607,13 @@ lc (r1 v1) add (r0 v0) (r1 v1) (r2 v2) add (r2 v2) (r1 v1) (r3 v3)- save (r1 v0) 0+ save (r1 v1) 0 add (r3 v3) (r2 v2) (r1 v4) add (r1 v4) (r3 v3) (r0 v5) add (r2 v2) (r3 v3) (r2 v6) add (r1 v4) (r0 v5) (r0 v7) add (r2 v6) (r0 v7) (r0 v8)- restore 0 (r1 v0)+ restore 0 (r1 v1) add (r0 v8) (r1 v1) (r0 v0) return_ @@ -415,10 +621,13 @@ blockTests = do it "Allocates across blocks" $ asmTest 32 (do label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 jump "L2" label "L2" $ do+ lc v3 add v2 v3 v4 add v2 v4 v5 jump "L3"@@ -430,11 +639,14 @@ return_) $ do label "entry" $ do+ lc (r0 v0)+ lc (r1 v1) add (r0 v0) (r1 v1) (r0 v2) jump "L2" label "L2" $ do- add (r0 v2) (r2 v3) (r1 v4)+ lc (r1 v3)+ add (r0 v2) (r1 v3) (r1 v4) add (r0 v2) (r1 v4) (r1 v5) jump "L3" @@ -486,7 +698,7 @@ jump "B4" label "B3" $ do- move (r2 v0) (r0 v0)+ move (r2 v2) (r0 v2) add (r1 v1) (r0 v2) (r2 v3) jump "B4" @@ -496,6 +708,8 @@ it "When resolving moves are not needed" $ asmTest 4 (do label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 branch v2 "B3" "B2" @@ -516,6 +730,8 @@ return_) $ do label "entry" $ do+ lc (r0 v0)+ lc (r1 v1) add (r0 v0) (r1 v1) (r2 v2) branch (r2 v2) "B2" "B3" @@ -591,8 +807,8 @@ move (r0 v5) (r1 v4) save (r3 v21) 32 lc (r3 v19)- save (r2 v18) 48- save (r3 v19) 40+ save (r3 v19) 48+ save (r2 v18) 40 restore 0 (r2 v20) move (r2 v20) (r3 v17) save (r2 v20) 0@@ -628,29 +844,156 @@ return_) $ label "entry" $ do- lc (r0 v0)- lc (r3 v1)- add (r0 v0) (r3 v1) (r2 v2)- add (r2 v2) (r3 v1) (r1 v3)- save (r3 v1) 0- add (r1 v3) (r2 v2) (r3 v4)- save (r2 v2) 8- add (r3 v4) (r1 v3) (r2 v5)- save (r1 v3) 32- save (r3 v4) 24- save (r2 v5) 16+ lc (r3 v0)+ lc (r2 v1)+ add (r3 v0) (r2 v1) (r3 v2)+ add (r3 v2) (r2 v1) (r1 v3)+ add (r1 v3) (r3 v2) (r0 v4)+ save (r3 v2) 0+ add (r0 v4) (r1 v3) (r3 v5)+ save (r2 v1) 32+ save (r1 v3) 24+ save (r0 v4) 16+ save (r3 v5) 8 call 1000- restore 8 (r2 v2)- restore 32 (r3 v3)- add (r2 v2) (r3 v3) (r1 v6)- restore 24 (r3 v4)- restore 16 (r0 v5)- add (r3 v4) (r0 v5) (r2 v7)- add (r1 v6) (r2 v7) (r0 v8)- restore 0 (r1 v1)+ restore 0 (r1 v2)+ restore 24 (r2 v3)+ add (r1 v2) (r2 v3) (r0 v6)+ restore 16 (r2 v4)+ restore 8 (r3 v5)+ add (r2 v4) (r3 v5) (r1 v7)+ add (r0 v6) (r1 v7) (r0 v8)+ restore 32 (r1 v1) add (r0 v8) (r1 v1) (r0 v0) return_ + it "Allocates between call instructions" $ asmTest 32+ (do label "entry" $ do+ lc v2+ lc v3+ lc v12+ lc v16+ lc v17+ lc v35+ lc v42+ lc v45+ lc v51+ lc v53+ lc v90+ lc v100+ call 97+ add v51 v45 v98+ copy v12 v64+ branch v42 "L92" "L62"++ label "L62" $ do+ lc v50+ jump "L12"++ label "L12" $ do+ nop+ move v100 v44+ call 30+ call 32+ jump "L15"++ label "L15" $ do+ lc v3+ call 35+ lc v73+ return_++ label "L92" $ do+ lc v95+ move v90 v43+ call 95+ call 64+ copy v53 v58+ add v98 v16 v100+ add v35 v3 v67+ copy v2 v24+ lc v13+ move v17 v32+ return_) $ do++ label "entry" $ do+ lc (r31 v2)+ lc (r30 v3)+ lc (r29 v12)+ lc (r28 v16)+ lc (r27 v17)+ lc (r26 v35)+ lc (r25 v42)+ lc (r24 v45)+ lc (r23 v51)+ lc (r22 v53)+ lc (r21 v90)+ lc (r20 v100)+ save (r31 v2) 88+ save (r30 v3) 80+ save (r29 v12) 72+ save (r28 v16) 64+ save (r27 v17) 56+ save (r26 v35) 48+ save (r25 v42) 40+ save (r24 v45) 32+ save (r23 v51) 24+ save (r22 v53) 16+ save (r21 v90) 8+ save (r20 v100) 0+ call 97+ restore 32 (r30 v45)+ restore 24 (r29 v51)+ add (r29 v51) (r30 v45) (r31 v98)+ save (r31 v98) 96+ restore 72 (r30 v12)+ move (r30 v12) (r31 v64)+ save (r31 v64) 104+ restore 40 (r31 v42)+ branch (r31 v42) "L92" "L62"++ label "L62" $ do+ lc (r31 v50)+ jump "L12"++ label "L12" $ do+ nop+ restore 0 (r30 v100)+ move (r30 v100) (r31 v44)+ call 30+ call 32+ jump "L15"++ label "L15" $ do+ lc (r31 v3)+ call 35+ save (r31 v3) 80+ lc (r31 v73)+ return_++ label "L92" $ do+ lc (r31 v95)+ save (r31 v95) 112+ restore 8 (r30 v90)+ move (r30 v90) (r31 v43)+ call 95+ save (r31 v43) 120+ call 64+ restore 16 (r1 v53)+ move (r1 v53) (r0 v58)+ restore 64 (r1 v16)+ restore 96 (r2 v98)+ add (r2 v98) (r1 v16) (r1 v100)+ restore 80 (r4 v3)+ restore 48 (r3 v35)+ add (r3 v35) (r4 v3) (r2 v67)+ restore 88 (r4 v2)+ move (r4 v2) (r3 v24)+ lc (r4 v13)+ restore 56 (r6 v17)+ move (r6 v17) (r5 v32)+ return_+ loopTests :: SpecWith () loopTests = do it "Correctly orders loop blocks" $ asmTestLiteral 4@@ -660,6 +1003,7 @@ label "B1" $ do trace "B1"+ lc v1 branch v1 "B3" "B2" label "B2" $ do@@ -691,19 +1035,20 @@ \ jump \"L2\"\n\ \ label \"L2\" $ do\n\ \ trace \"B1\"\n\-\ branch r0|v1 \"L3\" \"L4\"\n\+\ lc (r0 v1)\n\+\ branch (r0 v1) \"L3\" \"L4\"\n\ \ label \"L3\" $ do\n\ \ trace \"B3\"\n\ \ jump \"L2\"\n\ \ label \"L4\" $ do\n\ \ trace \"B2\"\n\-\ branch r0|v1 \"L5\" \"L9\"\n\+\ branch (r0 v1) \"L5\" \"L9\"\n\ \ label \"L5\" $ do\n\ \ trace \"B5\"\n\ \ return_\n\ \ label \"L6\" $ do\n\ \ trace \"B4\"\n\-\ branch r0|v1 \"L7\" \"L8\"\n\+\ branch (r0 v1) \"L7\" \"L8\"\n\ \ label \"L7\" $ do\n\ \ trace \"B7\"\n\ \ jump \"L2\"\n\
test/Programs/Exhaustion.hs view
@@ -6,6 +6,7 @@ exhaustion1 :: Program (Node IRVar) exhaustion1 = do label "entry" $ do+ lc v206 move pr1 v4 move pr2 v5 move pr3 v6