diff --git a/LinearScan/Hoopl.hs b/LinearScan/Hoopl.hs --- a/LinearScan/Hoopl.hs +++ b/LinearScan/Hoopl.hs @@ -32,7 +32,7 @@ mkJumpOp :: Label -> nv O C getReferences :: nv e x -> [VarInfo] - setRegisters :: [(Int, PhysReg)] -> nv e x -> Env (nr e x) + setRegisters :: [((VarId, VarKind), PhysReg)] -> nv e x -> Env (nr e x) mkMoveOps :: PhysReg -> VarId -> PhysReg -> Env [nr O O] mkSaveOps :: PhysReg -> VarId -> Env [nr O O] @@ -65,11 +65,17 @@ , blockOps = \(BlockCC a b z) -> ([NodeCO a], Prelude.map NodeOO (blockToList b), [NodeOC z]) - , setBlockOps = \_ [a] b [z] -> - BlockCC - (getNodeCO a) - (blockFromList (Prelude.map getNodeOO b)) - (getNodeOC z) + , setBlockOps = \_ as b zs -> + case as of + [a] -> case zs of + [z] -> + BlockCC (getNodeCO a) + (blockFromList (Prelude.map getNodeOO b)) + (getNodeOC z) + [] -> error "End node missing!" + _ -> error "Too many end nodes" + [] -> error "Beginning node missing!" + _ -> error "Too many beginning nodes" } opInfo :: NodeAlloc nv nr => OpInfo Env (NodeV nv) (NodeV nr) @@ -109,20 +115,20 @@ -> UseVerifier -- ^ Whether to use allocation verifier -> Label -- ^ Label of graph entry block -> Graph nv C C -- ^ Program graph - -> Either (String, [String]) (Graph nr C C) + -> (String, Either [String] (Graph nr C C)) allocateHoopl regs offset slotSize useVerifier entry graph = - newGraph <$> runIdentity (go (1 + IM.size (unsafeCoerce body))) + fmap 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 GMany NothingO body NothingO = graph go n = evalStateT alloc ([n..], newSpillStack offset slotSize) where - alloc = allocate regs (blockInfo getBlockId) opInfo useVerifier blocks + alloc = allocate regs (blockInfo getBlockId) opInfo useVerifier $ + postorder_dfs_from body entry where getBlockId :: Hoopl.Label -> Env Int getBlockId = return . unsafeCoerce diff --git a/linearscan-hoopl.cabal b/linearscan-hoopl.cabal --- a/linearscan-hoopl.cabal +++ b/linearscan-hoopl.cabal @@ -1,5 +1,5 @@ name: linearscan-hoopl -version: 0.8.1 +version: 0.9.0 synopsis: Makes it easy to use the linearscan register allocator with Hoopl homepage: http://github.com/jwiegley/linearscan-hoopl license: BSD3 diff --git a/test/AsmTest.hs b/test/AsmTest.hs --- a/test/AsmTest.hs +++ b/test/AsmTest.hs @@ -17,10 +17,10 @@ asmTestLiteral verif regs program mexpected = do let (graph, entry) = runSimpleUniqueMonad $ compile "entry" program case allocateHoopl regs 0 8 verif entry graph of - Left (dump, err) -> - error $ "Allocation failed: " ++ intercalate "\n" err ++ "\n" + (dump, Left errs) -> + error $ "Allocation failed: " ++ intercalate "\n" errs ++ "\n" ++ dump - Right graph' -> case mexpected of + (dump, Right graph') -> case mexpected of Nothing -> return () Just expected -> let g = showGraph show graph' in @@ -29,6 +29,7 @@ putStrLn $ "---- Expecting ----\n" ++ expected putStrLn $ "---- Compiled ----\n" ++ g putStrLn "-------------------" + putStrLn $ "Allocation result:\n" ++ dump throwIO (e :: SomeException) asmTest :: Int diff --git a/test/Assembly.hs b/test/Assembly.hs --- a/test/Assembly.hs +++ b/test/Assembly.hs @@ -33,7 +33,8 @@ deriving (Eq, Functor, Foldable, Traversable) instance Show r => Show (Instruction r) where - show (Add x1 x2 x3) = "add " ++ show x1 ++ " " ++ show x2 ++ " " ++ show x3 + show (Add x1 x2 x3) = + "add " ++ show x1 ++ " " ++ show x2 ++ " " ++ show x3 show (Offp x1 x2 x3) = "offp " ++ show x1 ++ " " ++ show x2 ++ " " ++ show x3 show (Offlpi x) = "offlpi " ++ show x @@ -108,24 +109,65 @@ mkBranchNode = Jump mkLabelNode = Label -variables :: Applicative f => LensLike f (Node v1 e x) (Node v2 e x) v1 v2 +vinfo k en = VarInfo + { varId = en + , varKind = k + , regRequired = True + } + +vinfos k en = [vinfo k en] + +instrVars :: Applicative f + => LensLike f (Instruction v1) (Instruction v2) + (v1, Either PhysReg VarId -> [VarInfo]) v2 +instrVars f = go + where + go Nop = pure Nop + go (Add s1 s2 d1) = + Add <$> f (s1, vinfos Input) + <*> f (s2, vinfos Input) + <*> f (d1, vinfos Output) + go (Offp x1 x2 x3) = + Offp <$> f (x1, vinfos Input) + <*> f (x2, vinfos Input) + <*> f (x3, vinfos Output) + -- jww (2015-08-25): I need to deal with the possibility that different + -- registers are allocated for the input and output sides. + go (Offlpi x) = + Offlpi <$> f (x, vinfos Input -- <> vinfos Output + ) + +-- Traverse the input and temp/output variables of each instruction. +variables :: Applicative f + => LensLike f (Node v1 e x) (Node v2 e x) + (v1, Either PhysReg VarId -> [VarInfo]) v2 variables f = go where - go (Alloc msrc dst) = Alloc <$> traverse f msrc <*> f dst - go (Reclaim src) = Reclaim <$> f src - go (Instr i) = Instr <$> traverse f i - go (LoadConst c dst) = LoadConst c <$> f dst - go (Move src dst) = Move <$> f src <*> f dst - go (Copy src dst) = Copy <$> f src <*> f dst - go (Save src x) = Save <$> f src <*> pure x - go (Restore x src) = Restore x <$> f src - go (Trace str) = pure $ Trace str - go (Branch x1 cond x2 x3) = Branch x1 <$> f cond <*> pure x2 <*> pure x3 - go (Call cc i) = pure $ Call cc i - go (ReturnInstr liveInRegs i) = ReturnInstr liveInRegs <$> traverse f i - go (Label x) = pure $ Label x - go (Jump x) = pure $ Jump x + go (Alloc msrc dst) = + Alloc <$> traverse (\x -> f (x, vinfos Input)) msrc + <*> f (dst, \en -> vinfos Output en <> blockRegs2to16) + where + blockRegs2to16 = [ vinfo Output (Left n) | n <- [2..16] ] + go (Reclaim src) = Reclaim <$> f (src, vinfos Output) + go (Instr i) = Instr <$> sequenceA (over instrVars f i) + go (LoadConst c dst) = LoadConst c <$> f (dst, vinfos Output) + go (Move src dst) = Move <$> f (src, vinfos Input) + <*> f (dst, vinfos Output) + go (Copy src dst) = Copy <$> f (src, vinfos Input) + <*> f (dst, vinfos Output) + go (Save src x) = Save <$> f (src, vinfos Input) <*> pure x + go (Restore x src) = Restore x <$> f (src, vinfos Output) + go (Trace str) = pure $ Trace str + go (Branch x1 cond x2 x3) = Branch x1 <$> f (cond, vinfos Input) + <*> pure x2 + <*> pure x3 + go (Call cc i) = pure $ Call cc i + go (ReturnInstr rs i) = ReturnInstr rs + <$> sequenceA (over instrVars f i) + go (Label x) = pure $ Label x + go (Jump x) = pure $ Jump x + add :: v -> v -> v -> BodyNode (Node v) add x0 x1 x2 = bodyNode $ Instr (Add x0 x1 x2) @@ -185,7 +227,7 @@ instance VarReg (Assign a PhysReg) where varReg (Assign _ b) = b -data IRVar = PhysicalIV PhysReg | VirtualIV Int deriving Eq +data IRVar = PhysicalIV PhysReg | VirtualIV VarId deriving Eq instance Show IRVar where show (PhysicalIV r) = "pr" ++ show r @@ -193,11 +235,11 @@ instance NodeAlloc (Node IRVar) (Node (Assign VarId PhysReg)) where isCall (Call {}) = True - isCall _ = False + isCall _ = False isBranch (Jump {}) = True isBranch (Branch {}) = True - isBranch _ = False + isBranch _ = False retargetBranch (Jump _) _ lab = Jump lab retargetBranch (Branch b v x y) old lab @@ -208,51 +250,22 @@ mkLabelOp = Label mkJumpOp = Jump - getReferences = go + getReferences = (^. variables.to f) where - go :: Node IRVar e x -> [VarInfo] - go (Label _) = mempty - go (Alloc msrc dst) = maybe mempty (mkv Input) msrc <> - mkv Output dst <> - [ vinfo Output (Left n) | n <- [2..16] ] - go (Reclaim src) = mkv Input src - go (Instr i) = fromInstr i - go (Call _ _) = mempty - go (LoadConst _ v) = mkv Output v - go (Move src dst) = mkv Input src <> mkv Output dst - go (Copy src dst) = mkv Input src <> mkv Output dst - go (Save src _) = mkv Input src - go (Restore _ dst) = mkv Output dst - go (Trace _) = mempty - go (Jump _) = mempty - go (Branch _ v _ _) = mkv Input v - go (ReturnInstr _ i) = fromInstr i - - fromInstr :: Instruction IRVar -> [VarInfo] - fromInstr Nop = mempty - fromInstr (Add s1 s2 d1) = - mkv Input s1 <> mkv Input s2 <> mkv Output d1 - fromInstr (Offp x1 x2 x3) = - mkv Input x1 <> mkv Input x2 <> mkv Output x3 - fromInstr (Offlpi x) = mkv Input x <> mkv Output x - - mkv :: VarKind -> IRVar -> [VarInfo] - mkv k (PhysicalIV n) = [vinfo k (Left n)] - mkv k (VirtualIV n) = [vinfo k (Right n)] - - vinfo k en = VarInfo - { varId = en - , varKind = k - , regRequired = True - } + f (PhysicalIV r, k) = k (Left r) + f (VirtualIV v, k) = k (Right v) - setRegisters m g = return $ over variables go g + setRegisters m = return . over variables go where - go :: IRVar -> Assign VarId PhysReg - go (PhysicalIV r) = Assign (-1) r - go (VirtualIV n) = Assign n (fromMaybe (-1) (Data.List.lookup n m)) + go (PhysicalIV r, _) = Assign (-1) r + go (VirtualIV n, k) = case k (Right n) of + [] -> error "No kind assigned to variable" + v : _ -> + -- jww (2015-08-25): Must handle multiple roles by + -- introducing move instructions. + Assign n (fromMaybe (-1) (Data.List.lookup (n, varKind v) m)) - mkMoveOps sreg svar dreg = do + mkMoveOps sreg svar dreg = return [Move (Assign svar sreg) (Assign svar dreg)] mkSaveOps sreg dvar = do diff --git a/test/Generated.hs b/test/Generated.hs --- a/test/Generated.hs +++ b/test/Generated.hs @@ -13,7 +13,7 @@ import qualified Data.IntMap as IM import qualified Data.IntSet as IS import Data.List (intercalate, isInfixOf) -import LinearScan (UseVerifier(..)) +import LinearScan import LinearScan.Hoopl import Test.Hspec import Test.QuickCheck hiding (label) @@ -36,12 +36,12 @@ instance Arbitrary (Node IRVar O C) where arbitrary = sized $ \n -> frequency - [ (1, Jump <$> unsafeCoerce <$> (choose (0,n) :: Gen Int)) + [ (1, Jump <$> unsafeCoerce <$> (choose (1,n) :: Gen Int)) , (1, Branch <$> pure Zero <*> arbitrary - <*> (unsafeCoerce <$> (choose (0,n) :: Gen Int)) - <*> (unsafeCoerce <$> (choose (0,n) :: Gen Int))) - , (1, ReturnInstr [] <$> arbitrary) + <*> (unsafeCoerce <$> (choose (1,n) :: Gen Int)) + <*> (unsafeCoerce <$> (choose (1,n) :: Gen Int))) + , (1, pure $ ReturnInstr [] Nop) ] instance Arbitrary (Node IRVar O O) where @@ -92,9 +92,12 @@ instance Show (Graph' Block (Node IRVar) C C) where show = showGraph show +instance Show (Graph' Block (Node (Assign VarId PhysReg)) C C) where + show = showGraph show + generatedTests :: SpecWith () generatedTests = it "Handles generated tests" $ do - res <- quickCheckWithResult stdArgs { maxSuccess = 1000 } $ + res <- quickCheckWithResult stdArgs { maxSuccess = 1000000000 } $ forAll arbitrary testGraph isSuccess res `shouldBe` True @@ -104,14 +107,13 @@ [] -> True `shouldBe` True (entry:_) -> case allocateHoopl 32 0 8 VerifyEnabled (unsafeCoerce entry) graph of - Left (dump, err) - | any ("Cannot insert onto unhandled:" `isInfixOf`) err -> + (dump, Left errs) + | any ("Cannot insert onto unhandled:" `isInfixOf`) errs -> True `shouldBe` True | otherwise -> error $ "Allocation failed: " - ++ intercalate "\n" err ++ "\n" ++ dump - Right graph' -> do - let g = showGraph show graph' - _ <- evaluate (length g) + ++ intercalate "\n" errs ++ "\n" ++ dump + (dump, Right graph') -> do + -- Make sure everything about the graph is computed + _ <- evaluate $ length (show graph') + length dump return () - -- putStrLn $ "---- Compiled ----\n" ++ g diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -15,12 +15,15 @@ import Programs.Incoming import Programs.Residency import Programs.Residency2 +import Programs.Residency3 import Programs.BranchAlloc import Programs.Returned import Programs.Restoration import Programs.Allocation import Programs.Allocation2 import Programs.Allocation3 +import Programs.Allocation4 +import Programs.Allocation5 import Programs.UponEntry import Programs.Overlapped import Programs.ReturnAssign @@ -47,12 +50,15 @@ it "Properly reserves incoming registers" $ runTest regsIncoming it "Handles edge-case 1 residency scenario" $ runTest residency it "Handles edge-case 2 residency scenario" $ runTest residency2 + it "Handles edge-case 3 residency scenario" $ runTest residency3 it "A case of residency involving branches" $ runTest branchAlloc it "Frees registers properly before returning" $ runTest freeBeforeReturn it "Restoration after a graph edge split" $ runTest restoration it "Handles edge-case 1 allocation scenario" $ runTest allocation it "Handles edge-case 2 allocation scenario" $ runTest allocation2 it "Handles edge-case 3 allocation scenario" $ runTest allocation3 + it "Handles edge-case 4 allocation scenario" $ runTest allocation4 + it "Handles edge-case 5 allocation scenario" $ runTest allocation5 it "Allocates correctly on block entry" $ runTest uponEntry it "Register over-allocation edge-case" $ runTest overlapped it "Does not assign after a return_" $ runTest returnAssign @@ -146,8 +152,8 @@ add (r2 v3) (r3 v4) (r1 v5) restore 0 (r2 v7) add (r4 v6) (r2 v7) (r2 v8) - restore 16 (r4 v10) restore 8 (r3 v9) + restore 16 (r4 v10) add (r3 v9) (r4 v10) (r3 v11) restore 24 (r4 v12) add (r4 v12) (r5 v13) (r4 v14) @@ -363,6 +369,34 @@ add (r18 v27) (r19 v28) (r29 v29) return_ + it "Handles blocks with no instructions" $ + flip (asmTestLiteral VerifyEnabled 32) Nothing $ do + label "L1" $ do + copy v1 v5 + return_ + label "entry" $ + jump "L1" + label "L3" $ do + move v3 v5 + copy v4 v0 + lc v6 + add v4 v3 v3 + call 2 + call 1 + return_ + label "L4" return_ + label "L5" $ do + copy pr8 v6 + add v3 v5 v5 + offlpi v0 + copy v1 v2 + call 3 + return_ + label "L6" $ do + move v2 v0 + copy v0 v4 + branch v6 "L6" "L4" + spillTests :: SpecWith () spillTests = do it "No spilling necessary" $ asmTest 32 @@ -442,18 +476,25 @@ 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) - add (r6 v9) (r7 v10) (r27 v11) - add (r8 v12) (r9 v13) (r28 v14) + add (r0 v0) (r1 v1) (r24 v2) + add (r2 v3) (r3 v4) (r25 v5) + add (r4 v6) (r5 v7) (r26 v8) + add (r6 v9) (r7 v10) (r27 v11) + add (r8 v12) (r9 v13) (r28 v14) add (r10 v15) (r11 v16) (r29 v17) add (r12 v18) (r13 v19) (r30 v20) add (r14 v21) (r15 v22) (r31 v23) - add (r16 v24) (r17 v25) (r31 v26) - add (r18 v27) (r19 v28) (r31 v29) - add (r20 v30) (r21 v31) (r31 v32) - add (r22 v33) (r23 v34) (r31 v35) + -- jww (2015-08-26): Why is this spilling, instead of re-using r31? It + -- has to do with the r17 input being now pos+1 from the v23 output of + -- the preceding line. + save (r17 v25) 0 + add (r16 v24) (r17 v25) (r17 v26) + save (r19 v28) 8 + add (r18 v27) (r19 v28) (r19 v29) + save (r21 v31) 16 + add (r20 v30) (r21 v31) (r21 v32) + save (r23 v34) 24 + add (r22 v33) (r23 v34) (r23 v35) add (r0 v0) (r1 v1) (r24 v2) add (r2 v3) (r3 v4) (r25 v5) add (r4 v6) (r5 v7) (r26 v8) @@ -461,11 +502,15 @@ add (r8 v12) (r9 v13) (r28 v14) add (r10 v15) (r11 v16) (r29 v17) add (r12 v18) (r13 v19) (r30 v20) - add (r14 v21) (r15 v22) (r0 v23) - add (r16 v24) (r17 v25) (r1 v26) - add (r18 v27) (r19 v28) (r2 v29) - add (r20 v30) (r21 v31) (r3 v32) - add (r22 v33) (r23 v34) (r31 v35) + add (r14 v21) (r15 v22) (r31 v23) + restore 0 (r0 v25) + add (r16 v24) (r0 v25) (r17 v26) + restore 8 (r0 v28) + add (r18 v27) (r0 v28) (r19 v29) + restore 16 (r0 v31) + add (r20 v30) (r0 v31) (r21 v32) + restore 24 (r0 v34) + add (r22 v33) (r0 v34) (r23 v35) return_ it "Spilling one variable" $ asmTest 32 @@ -539,41 +584,29 @@ 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) - add (r6 v9) (r7 v10) (r25 v11) - add (r8 v12) (r9 v13) (r26 v14) + add (r0 v0) (r1 v1) (r22 v2) + add (r2 v3) (r3 v4) (r23 v5) + add (r4 v6) (r5 v7) (r24 v8) + add (r6 v9) (r7 v10) (r25 v11) + add (r8 v12) (r9 v13) (r26 v14) add (r10 v15) (r11 v16) (r27 v17) add (r12 v18) (r13 v19) (r28 v20) add (r14 v21) (r15 v22) (r29 v23) add (r16 v24) (r17 v25) (r30 v26) + -- jww (2015-08-26): This avoids spilling, even though we expect it! add (r18 v27) (r19 v28) (r31 v29) - - -- When we reach the 32nd variable considered (which happens to be - -- 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 v29) 0 - - add (r20 v30) (r21 v31) (r31 v32) - - add (r0 v0) (r1 v1) (r22 v2) - add (r2 v3) (r3 v4) (r23 v5) - add (r4 v6) (r5 v7) (r24 v8) - add (r6 v9) (r7 v10) (r25 v11) - add (r8 v12) (r9 v13) (r26 v14) + add (r20 v30) (r21 v31) (r21 v32) + add (r0 v0) (r1 v1) (r22 v2) + add (r2 v3) (r3 v4) (r23 v5) + add (r4 v6) (r5 v7) (r24 v8) + add (r6 v9) (r7 v10) (r25 v11) + add (r8 v12) (r9 v13) (r26 v14) add (r10 v15) (r11 v16) (r27 v17) add (r12 v18) (r13 v19) (r28 v20) add (r14 v21) (r15 v22) (r29 v23) add (r16 v24) (r17 v25) (r30 v26) - - -- When it comes time to reload v29, we pick the first available - -- register. - restore 0 (r0 v29) - - add (r18 v27) (r0 v29) (r19 v28) - add (r20 v30) (r31 v32) (r21 v31) + add (r18 v27) (r31 v29) (r19 v28) + add (r20 v30) (r21 v32) (r0 v31) return_ it "Higher register pressure" $ asmTest 3 @@ -597,13 +630,11 @@ add (r2 v2) (r1 v1) (r0 v3) save (r1 v1) 0 add (r0 v3) (r2 v2) (r1 v4) - save (r2 v2) 8 - add (r1 v4) (r0 v3) (r2 v5) - save (r2 v5) 16 - restore 8 (r2 v2) + save (r1 v4) 8 + add (r1 v4) (r0 v3) (r1 v5) add (r2 v2) (r0 v3) (r0 v6) - restore 16 (r2 v5) - add (r1 v4) (r2 v5) (r1 v7) + restore 8 (r2 v4) + add (r2 v4) (r1 v5) (r1 v7) add (r0 v6) (r1 v7) (r0 v8) restore 0 (r1 v1) add (r0 v8) (r1 v1) (r0 v0) @@ -628,11 +659,11 @@ lc (r1 v1) add (r0 v0) (r1 v1) (r2 v2) add (r2 v2) (r1 v1) (r3 v3) + add (r3 v3) (r2 v2) (r0 v4) save (r1 v1) 0 - add (r3 v3) (r2 v2) (r1 v4) - add (r1 v4) (r3 v3) (r0 v5) + add (r0 v4) (r3 v3) (r1 v5) add (r2 v2) (r3 v3) (r2 v6) - add (r1 v4) (r0 v5) (r0 v7) + add (r0 v4) (r1 v5) (r0 v7) add (r2 v6) (r0 v7) (r0 v8) restore 0 (r1 v1) add (r0 v8) (r1 v1) (r0 v0) @@ -704,28 +735,23 @@ lc (r0 v0) lc (r1 v1) add (r0 v0) (r1 v1) (r2 v2) - branch (r2 v2) "B3" "B2" - - label "B2" $ do - save (r0 v0) 0 - add (r1 v1) (r2 v2) (r0 v3) - restore 0 (r2 v0) - add (r2 v0) (r0 v3) (r1 v4) - save (r0 v3) 8 - add (r2 v0) (r1 v4) (r0 v5) - add (r1 v4) (r0 v5) (r0 v6) - restore 8 (r1 v3) - add (r0 v6) (r1 v3) (r0 v7) - jump "B4" + branch (r2 v2) "L2" "L3" - label "B3" $ do + label "L2" $ do move (r2 v2) (r0 v2) - move (r1 v1) (r2 v1) - add (r2 v1) (r0 v2) (r1 v3) - jump "B4" + add (r1 v1) (r0 v2) (r2 v3) + jump "L4" - label "B4" $ do - add (r1 v3) (r1 v3) (r0 v0) + label "L3" $ do + add (r1 v1) (r2 v2) (r2 v3) + add (r0 v0) (r2 v3) (r1 v4) + add (r0 v0) (r1 v4) (r0 v5) + add (r1 v4) (r0 v5) (r0 v6) + add (r0 v6) (r2 v3) (r0 v7) + jump "L4" + + label "L4" $ do + add (r2 v3) (r2 v3) (r0 v0) return_ it "When resolving moves are not needed" $ asmTest 4 @@ -800,53 +826,53 @@ move v5 v4 lc v19 move v20 v17 - jump "L6") $ + jump "L6") $ do - do label "entry" $ do - lc (r0 v3) - lc (r1 v4) - lc (r2 v15) - lc (r3 v20) - save (r3 v20) 0 - jump "L3" + label "entry" $ do + lc (r0 v3) + lc (r1 v4) + lc (r2 v15) + lc (r3 v20) + jump "L3" - label "L3" $ do - move (r0 v3) (r3 v9) - move (r3 v9) (r3 v11) - move (r3 v11) (r3 v10) - move (r3 v10) (r3 v12) - move (r3 v12) (r3 v13) - save (r0 v3) 8 - lc (r0 v14) - save (r0 v14) 16 - move (r2 v15) (r0 v5) - jump "L6" + label "L3" $ do + save (r0 v3) 0 + move (r0 v3) (r0 v9) + move (r0 v9) (r0 v11) + move (r0 v11) (r0 v10) + move (r0 v10) (r0 v12) + move (r0 v12) (r0 v13) + save (r0 v13) 8 + lc (r0 v14) + save (r0 v14) 16 + move (r2 v15) (r0 v5) + jump "L6" - label "L2" $ do - lc (r3 v21) - save (r2 v15) 24 - move (r3 v21) (r2 v18) - move (r0 v5) (r1 v4) - save (r3 v21) 32 - lc (r3 v19) - save (r2 v18) 40 - save (r3 v19) 48 - restore 0 (r3 v20) - move (r3 v20) (r2 v17) - save (r3 v20) 0 - restore 24 (r2 v15) - jump "L6" + label "L2" $ do + save (r2 v15) 24 + lc (r2 v21) + save (r2 v21) 32 + move (r2 v21) (r2 v18) + move (r0 v5) (r1 v4) + save (r2 v18) 40 + lc (r2 v19) + save (r3 v20) 48 + move (r3 v20) (r3 v17) + restore 24 (r2 v15) + restore 48 (r3 v20) + jump "L6" - label "L6" $ - branch (r1 v4) "L5" "L2" + label "L6" $ do + branch (r1 v4) "L5" "L2" - label "L5" $ do - restore 0 (r3 v20) -- jww (2015-05-26): should be unnecessary - save (r2 v15) 24 - save (r3 v20) 0 - restore 24 (r2 v15) - restore 8 (r0 v3) - jump "L3" + label "L5" $ do + -- jww (2015-05-26): all of these should be unnecessary? + save (r2 v15) 24 + save (r3 v20) 48 + restore 0 (r0 v3) + restore 24 (r2 v15) + restore 48 (r3 v20) + jump "L3" callTests :: SpecWith () callTests = do @@ -872,17 +898,17 @@ 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) 16 - save (r3 v4) 24 - save (r2 v5) 32 + save (r3 v4) 8 + add (r3 v4) (r1 v3) (r3 v5) + save (r2 v2) 16 + save (r1 v3) 24 + save (r3 v5) 32 call 1000 - restore 16 (r2 v3) - restore 8 (r1 v2) + restore 16 (r1 v2) + restore 24 (r2 v3) add (r1 v2) (r2 v3) (r1 v6) + restore 8 (r2 v4) restore 32 (r3 v5) - restore 24 (r2 v4) add (r2 v4) (r3 v5) (r2 v7) add (r1 v6) (r2 v7) (r1 v8) restore 0 (r2 v1) @@ -940,29 +966,29 @@ 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) 0 - lc (r31 v3) - save (r31 v3) 8 - lc (r31 v12) - save (r31 v12) 16 - lc (r31 v16) - save (r31 v16) 24 - lc (r31 v17) - save (r31 v17) 32 - lc (r31 v35) - save (r31 v35) 40 - lc (r31 v42) - save (r31 v42) 48 - lc (r31 v45) - save (r31 v45) 56 - lc (r31 v51) - save (r31 v51) 64 - lc (r31 v53) - save (r31 v53) 72 - lc (r31 v90) - save (r31 v90) 80 - lc (r31 v100) - save (r31 v100) 88 + save (r30 v3) 8 + save (r29 v12) 16 + save (r28 v16) 24 + save (r27 v17) 32 + save (r26 v35) 40 + save (r25 v42) 48 + save (r24 v45) 56 + save (r23 v51) 64 + save (r22 v53) 72 + save (r21 v90) 80 + save (r20 v100) 88 call 97 restore 56 (r0 v45) restore 64 (r1 v51) @@ -973,18 +999,18 @@ branch (r1 v42) "L2" "L3" label "L2" $ do - save (r31 v98) 104 - lc (r31 v95) + lc (r30 v95) restore 80 (r1 v90) - save (r31 v95) 112 - move (r1 v90) (r31 v43) - save (r31 v43) 120 + move (r1 v90) (r29 v43) + save (r29 v43) 104 + save (r30 v95) 112 + save (r31 v98) 120 call 95 call 64 restore 72 (r1 v53) move (r1 v53) (r1 v58) restore 24 (r2 v16) - restore 104 (r3 v98) + restore 120 (r3 v98) add (r3 v98) (r2 v16) (r0 v100) restore 8 (r3 v3) restore 40 (r2 v35) @@ -1003,15 +1029,15 @@ label "L4" $ do nop restore 88 (r0 v100) - move (r0 v100) (r31 v44) - save (r31 v44) 96 + move (r0 v100) (r30 v44) + save (r30 v44) 96 call 30 call 32 jump "L5" label "L5" $ do - lc (r31 v3) - save (r31 v3) 8 + lc (r30 v3) + save (r30 v3) 8 call 35 lc (r1 v73) return_