linearscan-hoopl 0.5.1.0 → 0.6.0.0

raw patch · 10 files changed

+1746/−433 lines, 10 filesdep +QuickCheckdep +fuzzcheckdep +tardisPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, fuzzcheck, tardis

API changes (from Hackage documentation)

Files

• LinearScan/Hoopl.hs +30/−41
• LinearScan/Hoopl/DSL.hs +27/−40
• linearscan-hoopl.cabal +31/−21
• test/AsmTest.hs +18/−11
• test/Assembly.hs +612/−82
• test/Generated.hs +114/−0
• test/Main.hs +306/−236
• test/Normal.hs +4/−2
• test/Programs/Blocked.hs +207/−0
• test/Programs/Exhaustion.hs +397/−0

@@ -11,8 +11,9 @@ import           Control.Applicative import           Control.Arrow import           Control.Monad.Trans.Class-import           Control.Monad.Trans.State (evalStateT, modify)+import           Control.Monad.Trans.Tardis import           Data.Foldable+import           Data.Functor.Identity import qualified Data.Map as M import           Data.Monoid import           Debug.Trace@@ -20,36 +21,33 @@ import           LinearScan.Hoopl.DSL import           Unsafe.Coerce -class HooplNode (n v) => NodeAlloc n v r | n -> v, n -> r where-    fromVar :: v -> Either PhysReg VarId-    fromReg :: r -> PhysReg--    isCall   :: n v O O -> Bool-    isBranch :: n v O C -> Bool+class HooplNode nv => NodeAlloc nv nr | nv -> nr, nr -> nv where+    isCall   :: nv O O -> Bool+    isBranch :: nv O C -> Bool -    retargetBranch :: n v O C -> Label -> Label -> n v O C+    retargetBranch :: nv O C -> Label -> Label -> nv O C -    mkLabelOp :: Label -> n v C O-    mkJumpOp  :: Label -> n v O C+    mkLabelOp :: Label -> nv C O+    mkJumpOp  :: Label -> nv O C -    getReferences :: n v e x -> [VarInfo]-    setRegisters  :: [(Int, PhysReg)] -> n v e x -> Env (n r e x)+    getReferences :: nv e x -> [VarInfo]+    setRegisters  :: [(Int, PhysReg)] -> nv e x -> Env (nr e x) -    mkMoveOps    :: PhysReg -> PhysReg -> Env [n r O O]-    mkSwapOps    :: PhysReg -> PhysReg -> Env [n r O O]-    mkSaveOps    :: PhysReg -> Maybe VarId -> Env [n r O O]-    mkRestoreOps :: Maybe VarId -> PhysReg -> Env [n r O O]+    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] -    op1ToString  :: n v e x -> String+    op1ToString  :: nv e x -> String  data NodeV n = NodeCO { getNodeCO :: n C O }              | NodeOO { getNodeOO :: n O O }              | NodeOC { getNodeOC :: n O C } -blockInfo :: (NodeAlloc n v r, NonLocal (n v))+blockInfo :: (NodeAlloc nv nr, NonLocal nv, NonLocal nr)           => (Label -> Env Int)-          -> BlockInfo Env (Block (n v) C C) (Block (n r) C C)-                           (NodeV (n v)) (NodeV (n r))+          -> BlockInfo Env (Block nv C C) (Block nr C C)+                           (NodeV nv) (NodeV nr) blockInfo getBlockId = BlockInfo     { blockId = getBlockId . entryLabel @@ -58,14 +56,10 @@     , splitCriticalEdge = \(BlockCC b m e)                            (BlockCC next _ _) -> do         let lab = entryLabel next-        lab' <- lift freshLabel-        modify $ \st ->-            st { envLabels   = M.insert (show lab ++ "'") lab' (envLabels st)-               , envBlockIds = let m = envBlockIds st in-                               M.insert lab' (M.size m + 1) m-               }-        let e' = retargetBranch e lab lab'-        return (BlockCC b m e',+        (next:supply, stack) <- getPast+        sendFuture (supply, stack)+        let lab' = unsafeCoerce next+        return (BlockCC b m (retargetBranch e lab lab'),                 BlockCC (mkLabelOp lab') BNil (mkJumpOp lab))      , blockOps = \(BlockCC a b z) ->@@ -78,11 +72,11 @@             (getNodeOC z)     } -opInfo :: NodeAlloc n v r => OpInfo Env (NodeV (n v)) (NodeV (n r))+opInfo :: NodeAlloc nv nr => OpInfo Env (NodeV nv) (NodeV nr) opInfo = OpInfo     { opKind = \node -> case node of-           NodeOO n | isCall n  -> IsCall-                    | otherwise -> IsNormal+           NodeOO n | isCall n   -> IsCall+                    | otherwise  -> IsNormal            NodeOC n | isBranch n -> IsBranch                     | otherwise  -> IsNormal            _ -> IsNormal@@ -109,20 +103,15 @@            NodeOC n -> op1ToString n     } -newtype SimpleUniqueMonad' a = SUM' { unSUM' :: [Int] -> (a, [Int]) }--runSimpleUniqueMonad' :: Int -> SimpleUniqueMonad a -> a-runSimpleUniqueMonad' start m = fst (unSUM' (unsafeCoerce m) [start..])--allocateHoopl :: (NonLocal (n v), NonLocal (n r), NodeAlloc n v r)+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-              -> Graph (n v) C C -- ^ Program graph-              -> Either String (Graph (n r) C C)+              -> Graph nv C C -- ^ Program graph+              -> Either [String] (Graph nr C C) allocateHoopl regs offset slotSize entry graph =-    newGraph <$> runSimpleUniqueMonad' (1 + length blocks) go+    newGraph <$> runIdentity (go (1 + length blocks))   where     newGraph xs = GMany NothingO (newBody xs) NothingO       where@@ -132,7 +121,7 @@       where         GMany NothingO body NothingO = graph -    go = evalStateT alloc (newEnvState offset slotSize)+    go n = evalTardisT alloc (mempty, ([n..], newSpillStack offset slotSize))       where         alloc = allocate regs (blockInfo getBlockId) opInfo blocks           where

@@ -1,20 +1,27 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+ module LinearScan.Hoopl.DSL where  import           Compiler.Hoopl as Hoopl hiding ((<*>)) import           Control.Applicative import           Control.Arrow (first)+import           Control.Monad+import           Control.Monad.Fix import           Control.Monad.Free import           Control.Monad.Trans.Class import qualified Control.Monad.Trans.Free as TF import           Control.Monad.Trans.Free hiding (FreeF(..), Free)-import           Control.Monad.Trans.State (StateT, evalStateT,-                                            gets, modify, get, put)+import           Control.Monad.Trans.State+import           Control.Monad.Trans.Tardis import qualified Data.Map as M+import           Data.Maybe (fromMaybe) import           Data.Monoid import           LinearScan--type Labels = M.Map String Label-type BlockIds = M.Map Label Int+import           Unsafe.Coerce+import           Test.QuickCheck  data SpillStack = SpillStack     { stackPtr      :: Int@@ -23,14 +30,7 @@     }     deriving (Eq, Show) -data EnvState = EnvState-    { envLabels      :: Labels-    , envBlockIds    :: BlockIds-    , envSpillStack  :: SpillStack-    , envAssignments :: M.Map PhysReg VarId-    }--type Env = StateT EnvState SimpleUniqueMonad+type Env = Tardis (M.Map PhysReg VarId) ([Int], SpillStack)  newSpillStack :: Int -> Int -> SpillStack newSpillStack offset slotSize = SpillStack@@ -39,30 +39,29 @@     , stackSlots    = mempty     } -newEnvState :: Int -> Int -> EnvState-newEnvState offset slotSize = EnvState-    { envLabels      = mempty-    , envBlockIds    = mempty-    , envSpillStack  = newSpillStack offset slotSize-    , envAssignments = mempty-    }- getStackSlot :: Maybe VarId -> Env Int getStackSlot vid = do-    st <- get-    let stack = envSpillStack st+    (supply, stack) <- getPast     case M.lookup vid (stackSlots stack) of         Just off -> return off         Nothing -> do             let off = stackPtr stack-            put st { envSpillStack = stack-                 { stackPtr   = off + stackSlotSize stack-                 , stackSlots =-                     M.insert vid off (stackSlots stack)-                 }}+            sendFuture (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 type Asm = StateT Labels SimpleUniqueMonad  getLabel :: String -> Asm Label@@ -74,18 +73,6 @@             lbl <- lift freshLabel             modify (M.insert str lbl)             return lbl--setAssignment :: PhysReg -> VarId -> Env ()-setAssignment reg vid =-    modify $ \env ->-        env { envAssignments = M.insert reg vid (envAssignments env) }--getAssignment :: PhysReg -> Env VarId-getAssignment reg = do-    l <- gets (M.lookup reg . envAssignments)-    case l of-        Just vid -> return vid-        Nothing  -> error $ "No assignment for register: " ++ show reg  -- | A series of 'Nodes' is a set of assembly instructions that ends with some --   kind of closing operation, such as a jump, branch or return.

@@ -1,5 +1,5 @@ name:          linearscan-hoopl-version:       0.5.1.0+version:       0.6.0.0 synopsis:      Makes it easy to use the linearscan register allocator with Hoopl homepage:      http://github.com/jwiegley/linearscan-hoopl license:       BSD3@@ -24,12 +24,15 @@   exposed-modules:     LinearScan.Hoopl     LinearScan.Hoopl.DSL-  build-depends:    base >=4.7 && <5-                  , hoopl >= 3.10.0.1-                  , linearscan >= 0.3.0.1-                  , containers-                  , transformers-                  , free+  build-depends:    +      base       >=4.7 && <5+    , hoopl      >= 3.10.0.1+    , linearscan >= 0.3.0.1+    , tardis     >= 0.3.0.0+    , containers+    , transformers+    , free+    , QuickCheck  test-suite test   default-language: Haskell2010@@ -37,18 +40,25 @@   ghc-options:      -Wall -fno-warn-deprecated-flags   hs-source-dirs:   test   main-is:          Main.hs-  other-modules:    AsmTest-                    Assembly-                    Normal+  other-modules:    +    AsmTest+    Assembly+    Normal+    Generated+    Programs.Blocked+    Programs.Exhaustion   build-depends: -        base >=3-      , linearscan-      , 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-      , containers         >= 0.5.5-      , transformers       >= 0.3.0.0-      , lens-family-core-      , deepseq+      base >=3+    , linearscan+    , 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+    , containers         >= 0.5.5+    , transformers       >= 0.3.0.0+    , tardis             >= 0.3.0.0+    , lens-family-core+    , deepseq+    , QuickCheck+    , fuzzcheck

@@ -5,25 +5,28 @@ import Assembly import Compiler.Hoopl as Hoopl hiding ((<*>)) import Control.Exception+import Data.List (intercalate) import LinearScan import LinearScan.Hoopl import LinearScan.Hoopl.DSL import Normal () import Test.Hspec -asmTestLiteral :: Int -> Program (Node IRVar) -> String -> Expectation-asmTestLiteral regs program expected = do+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: " ++ err-        Right graph' -> do-            let g = showGraph show graph'-            catch (g `shouldBe` expected) $ \e -> do-                putStrLn $ "---- Parsed ----\n" ++ showGraph show graph-                putStrLn $ "---- Expecting ----\n" ++ expected-                putStrLn $ "---- Compiled  ----\n" ++ g-                putStrLn "-------------------"-                throwIO (e :: SomeException)+        Left err -> error $ "Allocation failed: " ++ intercalate "\n" err+        Right graph' -> case mexpected of+            Nothing -> return ()+            Just expected ->+                let g = showGraph show graph' in+                catch (g `shouldBe` expected) $ \e -> do+                    putStrLn $ "---- Parsed ----\n" ++ showGraph show graph+                    putStrLn $ "---- Expecting ----\n" ++ expected+                    putStrLn $ "---- Compiled  ----\n" ++ g+                    putStrLn "-------------------"+                    throwIO (e :: SomeException)  asmTest :: Int         -> Program (Node IRVar)@@ -31,7 +34,11 @@         -> Expectation asmTest regs program     = asmTestLiteral regs program+    . Just     . showGraph show     . fst     . runSimpleUniqueMonad     . compile "entry"++asmTest_ :: Int -> Program (Node IRVar) -> Expectation+asmTest_ regs program = asmTestLiteral regs program Nothing

@@ -12,9 +12,9 @@  import           Compiler.Hoopl as Hoopl hiding ((<*>)) import           Control.Applicative-import           Data.Foldable+import           Data.Foldable as F import qualified Data.List-import           Data.Maybe (fromMaybe)+import           Data.Maybe (fromMaybe, maybeToList) import           Data.Monoid import           Data.Traversable import           Lens.Family hiding (Constant)@@ -25,13 +25,18 @@ default (Int)  -- | The basic instructions that have nothing to do with control flow.-data Instruction reg-    = Add reg reg reg+data Instruction v+    = Add v v v+    | Offp v v v+    | Offlpi v     | Nop     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 (Offp x1 x2 x3) =+        "offp " ++ show x1 ++ " " ++ show x2 ++ " " ++ show x3+    show (Offlpi x) = "offlpi " ++ show x     show Nop = "nop"  -- | Tests used for branching (correspond to branching instructions)@@ -73,24 +78,24 @@  deriving instance Eq v => Eq (Node v e x) -instance Show v => Show (Node v e x) where-    show (Label l)         = show l ++ ":"-    show (Alloc x1 x2)     = "\t@alloc " ++-                             (case x1 of Just v -> " " ++ show v ; _ -> " _")-                             ++ " " ++ show x2-    show (Reclaim v)       = "\t@reclaim " ++ show v-    show (Instr i)         = "\t" ++ show i-    show (Call c l)        = "\t@call " ++ show c ++ " " ++ show l-    show (LoadConst _c v)  = "\t@lc " ++ show v -- ++ " " ++ show c-    show (Move x1 x2)      = "\t@mvrr " ++ show x1 ++ " " ++ show x2-    show (Copy x1 x2)      = "\t@cprr " ++ show x1 ++ " " ++ show x2-    show (Save src dst)    = "\t@save " ++ show src ++ " " ++ show dst-    show (Restore src dst) = "\t@restore " ++ show src ++ " " ++ show dst-    show (Trace str)       = "\tTRACE " ++ " " ++ show str-    show (Jump l)          = "\t@jmp " ++ show l-    show (Branch c v t f)  = "\t@b" ++ show c ++ " " ++ show v-                          ++ " " ++ show t ++ "; @jmp " ++ show f-    show (ReturnInstr regs i) = "\t@return " ++ show regs ++ " " ++ show i+instance (Show v, VarReg v) => Show (Node v e x) where+    show (Label l)         = "    label \"" ++ show l ++ "\" $ do"+    show (Alloc x1 x2)     = "        alloc " ++ show x1 ++ " " ++ show x2+    show (Reclaim v)       = "        reclaim " ++ show v+    show (Instr i)         = "        " ++ show i+    show (Call _ l)        = "        call " ++ show l+    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 (Trace str)       = "        trace " ++ " " ++ show str+    show (Jump l)          = "        jump \"" ++ show l ++ "\""+    show (Branch _ v t f)  = "        branch " ++ show v+                          ++ " \"" ++ show t ++ "\" \"" ++ show f ++ "\""+    show (ReturnInstr _regs _i) = "        return_"  instance NonLocal (Node v) where   entryLabel (Label l) = l@@ -124,12 +129,24 @@ add :: v -> v -> v -> BodyNode (Node v) add x0 x1 x2 = bodyNode $ Instr (Add x0 x1 x2) +offp :: v -> v -> v -> BodyNode (Node v)+offp x0 x1 x2 = bodyNode $ Instr (Offp x0 x1 x2)++offlpi :: v -> BodyNode (Node v)+offlpi x = bodyNode $ Instr (Offlpi x)++alloc :: Maybe v -> v -> BodyNode (Node v)+alloc src dst = bodyNode $ Alloc src dst+ nop :: BodyNode (Node v) nop = bodyNode $ Instr Nop  move :: v -> v -> BodyNode (Node v) move x0 x1 = bodyNode $ Move x0 x1 +copy :: v -> v -> BodyNode (Node v)+copy = move+ call :: Int -> BodyNode (Node v) call dst = bodyNode $ Call InlineC dst @@ -145,9 +162,9 @@ trace :: String -> BodyNode (Node v) trace str = bodyNode $ Trace str -branch :: Test -> v -> String -> String -> EndNode (Node v)-branch tst v good bad =-    endNode $ Branch tst v <$> getLabel good <*> getLabel bad+branch :: v -> String -> String -> EndNode (Node v)+branch v good bad =+    endNode $ Branch Zero v <$> getLabel good <*> getLabel bad  return_ :: EndNode (Node v) return_ = endNode $ return $ ReturnInstr [] Nop@@ -156,21 +173,25 @@  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 _ r)    = show r+    show (Assign v r)    = "r" ++ show r ++ "|v" ++ show v +class VarReg a where+    varReg :: a -> PhysReg++instance VarReg IRVar where+    varReg (PhysicalIV r) = r+    varReg v = error $ "No register known for " ++ show v++instance VarReg (Assign a PhysReg) where+    varReg (Assign _ b) = b+ data IRVar = PhysicalIV PhysReg | VirtualIV Int deriving Eq  instance Show IRVar where-    show (PhysicalIV r) = "r" ++ show r+    show (PhysicalIV r) = "pr" ++ show r     show (VirtualIV n)  = "v" ++ show n -instance NodeAlloc Node IRVar (Assign VarId PhysReg) where-    fromVar (PhysicalIV r) = Left r-    fromVar (VirtualIV n)  = Right n--    fromReg (Assign _ r) = r-+instance NodeAlloc (Node IRVar) (Node (Assign VarId PhysReg)) where     isCall (Call {}) = True     isCall _ = False @@ -191,20 +212,29 @@       where         go :: Node IRVar e x -> [VarInfo]         go (Label _)         = mempty+        go (Alloc msrc dst)  = F.concatMap (mkv Input) (maybeToList msrc) <>+                               mkv Output dst <>+                               [ vinfo Output (Left n) | n <- [2..16] ]+        go (Reclaim src)     = mkv Input src         go (Instr i)         = fromInstr i-        go (Jump _)          = mempty         go (Call _ _)        = mempty-        go (Move src dst)    = mkv Input src <> mkv Output dst         go (LoadConst _ v)   = mkv Output v-        go (Branch _ v _ _)  = mkv Input 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-        go n = error $ "getReferences: unhandled node: " ++ show n          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)]@@ -217,7 +247,7 @@             }      setRegisters m g = do-        for_ m $ \(v, r) -> setAssignment r v+        -- for_ m $ \(v, r) -> setAssignment r v         return $ over variables go g       where         go :: IRVar -> Assign VarId PhysReg@@ -225,7 +255,8 @@         go (VirtualIV n)  = Assign n (fromMaybe (-1) (Data.List.lookup n m))      mkMoveOps src dst = do-        vid <- getAssignment src+        -- vid <- getAssignment src+        let vid = 0         return [Move (Assign vid src) (Assign vid dst)]     mkSwapOps src dst =         liftA2 (++) (mkRestoreOps Nothing dst)@@ -234,10 +265,12 @@     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+        -- vid <- getAssignment dst+        let vid = 0         return [Restore off (Assign vid dst)]      op1ToString = show@@ -245,47 +278,544 @@ var :: Int -> IRVar var = VirtualIV -v0  = var 0-v1  = var 1-v2  = var 2-v3  = var 3-v4  = var 4-v5  = var 5-v6  = var 6-v7  = var 7-v8  = var 8-v9  = var 9-v10 = var 10-v11 = var 11-v12 = var 12-v13 = var 13-v14 = var 14-v15 = var 15-v16 = var 16-v17 = var 17-v18 = var 18-v19 = var 19-v20 = var 20-v21 = var 21-v22 = var 22-v23 = var 23-v24 = var 24-v25 = var 25-v26 = var 26-v27 = var 27-v28 = var 28-v29 = var 29-v30 = var 30-v31 = var 31-v32 = var 32-v33 = var 33-v34 = var 34-v35 = var 35-v36 = var 36-v37 = var 37-v38 = var 38-v39 = var 39-v40 = var 40+v0   = var 0+v1   = var 1+v2   = var 2+v3   = var 3+v4   = var 4+v5   = var 5+v6   = var 6+v7   = var 7+v8   = var 8+v9   = var 9+v10  = var 10+v11  = var 11+v12  = var 12+v13  = var 13+v14  = var 14+v15  = var 15+v16  = var 16+v17  = var 17+v18  = var 18+v19  = var 19+v20  = var 20+v21  = var 21+v22  = var 22+v23  = var 23+v24  = var 24+v25  = var 25+v26  = var 26+v27  = var 27+v28  = var 28+v29  = var 29+v30  = var 30+v31  = var 31+v32  = var 32+v33  = var 33+v34  = var 34+v35  = var 35+v36  = var 36+v37  = var 37+v38  = var 38+v39  = var 39+v40  = var 40+v41  = var 41+v42  = var 42+v43  = var 43+v44  = var 44+v45  = var 45+v46  = var 46+v47  = var 47+v48  = var 48+v49  = var 49+v50  = var 50+v51  = var 51+v52  = var 52+v53  = var 53+v54  = var 54+v55  = var 55+v56  = var 56+v57  = var 57+v58  = var 58+v59  = var 59+v60  = var 60+v61  = var 61+v62  = var 62+v63  = var 63+v64  = var 64+v65  = var 65+v66  = var 66+v67  = var 67+v68  = var 68+v69  = var 69+v70  = var 70+v71  = var 71+v72  = var 72+v73  = var 73+v74  = var 74+v75  = var 75+v76  = var 76+v77  = var 77+v78  = var 78+v79  = var 79+v80  = var 80+v81  = var 81+v82  = var 82+v83  = var 83+v84  = var 84+v85  = var 85+v86  = var 86+v87  = var 87+v88  = var 88+v89  = var 89+v90  = var 90+v91  = var 91+v92  = var 92+v93  = var 93+v94  = var 94+v95  = var 95+v96  = var 96+v97  = var 97+v98  = var 98+v99  = var 99+v100 = var 100+v101 = var 101+v102 = var 102+v103 = var 103+v104 = var 104+v105 = var 105+v106 = var 106+v107 = var 107+v108 = var 108+v109 = var 109+v110 = var 110+v111 = var 111+v112 = var 112+v113 = var 113+v114 = var 114+v115 = var 115+v116 = var 116+v117 = var 117+v118 = var 118+v119 = var 119+v120 = var 120+v121 = var 121+v122 = var 122+v123 = var 123+v124 = var 124+v125 = var 125+v126 = var 126+v127 = var 127+v128 = var 128+v129 = var 129+v130 = var 130+v131 = var 131+v132 = var 132+v133 = var 133+v134 = var 134+v135 = var 135+v136 = var 136+v137 = var 137+v138 = var 138+v139 = var 139+v140 = var 140+v141 = var 141+v142 = var 142+v143 = var 143+v144 = var 144+v145 = var 145+v146 = var 146+v147 = var 147+v148 = var 148+v149 = var 149+v150 = var 150+v151 = var 151+v152 = var 152+v153 = var 153+v154 = var 154+v155 = var 155+v156 = var 156+v157 = var 157+v158 = var 158+v159 = var 159+v160 = var 160+v161 = var 161+v162 = var 162+v163 = var 163+v164 = var 164+v165 = var 165+v166 = var 166+v167 = var 167+v168 = var 168+v169 = var 169+v170 = var 170+v171 = var 171+v172 = var 172+v173 = var 173+v174 = var 174+v175 = var 175+v176 = var 176+v177 = var 177+v178 = var 178+v179 = var 179+v180 = var 180+v181 = var 181+v182 = var 182+v183 = var 183+v184 = var 184+v185 = var 185+v186 = var 186+v187 = var 187+v188 = var 188+v189 = var 189+v190 = var 190+v191 = var 191+v192 = var 192+v193 = var 193+v194 = var 194+v195 = var 195+v196 = var 196+v197 = var 197+v198 = var 198+v199 = var 199+v200 = var 200+v201 = var 201+v202 = var 202+v203 = var 203+v204 = var 204+v205 = var 205+v206 = var 206+v207 = var 207+v208 = var 208+v209 = var 209+v210 = var 210+v211 = var 211+v212 = var 212+v213 = var 213+v214 = var 214+v215 = var 215+v216 = var 216+v217 = var 217+v218 = var 218+v219 = var 219+v220 = var 220+v221 = var 221+v222 = var 222+v223 = var 223+v224 = var 224+v225 = var 225+v226 = var 226+v227 = var 227+v228 = var 228+v229 = var 229+v230 = var 230+v231 = var 231+v232 = var 232+v233 = var 233+v234 = var 234+v235 = var 235+v236 = var 236+v237 = var 237+v238 = var 238+v239 = var 239+v240 = var 240+v241 = var 241+v242 = var 242+v243 = var 243+v244 = var 244+v245 = var 245+v246 = var 246+v247 = var 247+v248 = var 248+v249 = var 249+v250 = var 250+v251 = var 251+v252 = var 252+v253 = var 253+v254 = var 254+v255 = var 255+v256 = var 256+v257 = var 257+v258 = var 258+v259 = var 259+v260 = var 260+v261 = var 261+v262 = var 262+v263 = var 263+v264 = var 264+v265 = var 265+v266 = var 266+v267 = var 267+v268 = var 268+v269 = var 269+v270 = var 270+v271 = var 271+v272 = var 272+v273 = var 273+v274 = var 274+v275 = var 275+v276 = var 276+v277 = var 277+v278 = var 278+v279 = var 279+v280 = var 280+v281 = var 281+v282 = var 282+v283 = var 283+v284 = var 284+v285 = var 285+v286 = var 286+v287 = var 287+v288 = var 288+v289 = var 289+v290 = var 290+v291 = var 291+v292 = var 292+v293 = var 293+v294 = var 294+v295 = var 295+v296 = var 296+v297 = var 297+v298 = var 298+v299 = var 299+v300 = var 300+v301 = var 301+v302 = var 302+v303 = var 303+v304 = var 304+v305 = var 305+v306 = var 306+v307 = var 307+v308 = var 308+v309 = var 309+v310 = var 310+v311 = var 311+v312 = var 312+v313 = var 313+v314 = var 314+v315 = var 315+v316 = var 316+v317 = var 317+v318 = var 318+v319 = var 319+v320 = var 320+v321 = var 321+v322 = var 322+v323 = var 323+v324 = var 324+v325 = var 325+v326 = var 326+v327 = var 327+v328 = var 328+v329 = var 329+v330 = var 330+v331 = var 331+v332 = var 332+v333 = var 333+v334 = var 334+v335 = var 335+v336 = var 336+v337 = var 337+v338 = var 338+v339 = var 339+v340 = var 340+v341 = var 341+v342 = var 342+v343 = var 343+v344 = var 344+v345 = var 345+v346 = var 346+v347 = var 347+v348 = var 348+v349 = var 349+v350 = var 350+v351 = var 351+v352 = var 352+v353 = var 353+v354 = var 354+v355 = var 355+v356 = var 356+v357 = var 357+v358 = var 358+v359 = var 359+v360 = var 360+v361 = var 361+v362 = var 362+v363 = var 363+v364 = var 364+v365 = var 365+v366 = var 366+v367 = var 367+v368 = var 368+v369 = var 369+v370 = var 370+v371 = var 371+v372 = var 372+v373 = var 373+v374 = var 374+v375 = var 375+v376 = var 376+v377 = var 377+v378 = var 378+v379 = var 379+v380 = var 380+v381 = var 381+v382 = var 382+v383 = var 383+v384 = var 384+v385 = var 385+v386 = var 386+v387 = var 387+v388 = var 388+v389 = var 389+v390 = var 390+v391 = var 391+v392 = var 392+v393 = var 393+v394 = var 394+v395 = var 395+v396 = var 396+v397 = var 397+v398 = var 398+v399 = var 399+v400 = var 400+v401 = var 401+v402 = var 402+v403 = var 403+v404 = var 404+v405 = var 405+v406 = var 406+v407 = var 407+v408 = var 408+v409 = var 409+v410 = var 410+v411 = var 411+v412 = var 412+v413 = var 413+v414 = var 414+v415 = var 415+v416 = var 416+v417 = var 417+v418 = var 418+v419 = var 419+v420 = var 420+v421 = var 421+v422 = var 422+v423 = var 423+v424 = var 424+v425 = var 425+v426 = var 426+v427 = var 427+v428 = var 428+v429 = var 429+v430 = var 430+v431 = var 431+v432 = var 432+v433 = var 433+v434 = var 434+v435 = var 435+v436 = var 436+v437 = var 437+v438 = var 438+v439 = var 439+v440 = var 440+v441 = var 441+v442 = var 442+v443 = var 443+v444 = var 444+v445 = var 445+v446 = var 446+v447 = var 447+v448 = var 448+v449 = var 449+v450 = var 450+v451 = var 451+v452 = var 452+v453 = var 453+v454 = var 454+v455 = var 455+v456 = var 456+v457 = var 457+v458 = var 458+v459 = var 459+v460 = var 460+v461 = var 461+v462 = var 462+v463 = var 463+v464 = var 464+v465 = var 465+v466 = var 466+v467 = var 467+v468 = var 468+v469 = var 469+v470 = var 470+v471 = var 471+v472 = var 472+v473 = var 473+v474 = var 474+v475 = var 475+v476 = var 476+v477 = var 477+v478 = var 478+v479 = var 479+v480 = var 480+v481 = var 481+v482 = var 482+v483 = var 483+v484 = var 484+v485 = var 485+v486 = var 486+v487 = var 487+v488 = var 488+v489 = var 489+v490 = var 490+v491 = var 491+v492 = var 492+v493 = var 493+v494 = var 494+v495 = var 495+v496 = var 496+v497 = var 497+v498 = var 498+v499 = var 499+v500 = var 500++physreg :: PhysReg -> IRVar+physreg = PhysicalIV++pr0  = physreg 0+pr1  = physreg 1+pr2  = physreg 2+pr3  = physreg 3+pr4  = physreg 4+pr5  = physreg 5+pr6  = physreg 6+pr7  = physreg 7+pr8  = physreg 8+pr9  = physreg 9+pr10 = physreg 10+pr11 = physreg 11+pr12 = physreg 12+pr13 = physreg 13+pr14 = physreg 14+pr15 = physreg 15+pr16 = physreg 16+pr17 = physreg 17+pr18 = physreg 18+pr19 = physreg 19+pr20 = physreg 20+pr21 = physreg 21+pr22 = physreg 22+pr23 = physreg 23+pr24 = physreg 24+pr25 = physreg 25+pr26 = physreg 26+pr27 = physreg 27+pr28 = physreg 28+pr29 = physreg 29+pr30 = physreg 30+pr31 = physreg 31+pr32 = physreg 32  reg :: PhysReg -> IRVar -> Assign VarId PhysReg reg _ (PhysicalIV _) = error "Don't use reg to reference a literal register"

@@ -0,0 +1,114 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Generated (generatedTests) where++import           Assembly+import           Compiler.Hoopl hiding ((<*>))+import           Control.Applicative+import           Control.Exception (evaluate)+import           Control.Monad+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import           Data.List (intercalate, isInfixOf)+import           LinearScan.Hoopl+import           Test.FuzzCheck as F hiding (branch)+import           Test.Hspec+import           Test.QuickCheck hiding (label)+import           Unsafe.Coerce++instance Arbitrary IRVar where+    arbitrary = sized $ \n -> frequency+        [ (1, PhysicalIV <$> choose (0,31))+        , (50, VirtualIV <$> choose (0,n))+        ]++instance Arbitrary (Instruction IRVar) where+    arbitrary = frequency+        [ (3, Add <$> arbitrary <*> arbitrary <*> arbitrary)+        , (1, Offp <$> arbitrary <*> arbitrary <*> arbitrary)+        , (1, Offlpi <$> arbitrary)+        , (1, pure Nop)+        ]++instance Arbitrary (Node IRVar O C) where+    arbitrary = sized $ \n -> frequency+        [ (1, Jump <$> unsafeCoerce <$> (choose (0,n) :: Gen Int))+        , (1, Branch <$> pure Zero+                     <*> arbitrary+                     <*> (unsafeCoerce <$> (choose (0,n) :: Gen Int))+                     <*> (unsafeCoerce <$> (choose (0,n) :: Gen Int)))+        , (1, ReturnInstr [] <$> arbitrary)+        ]++instance Arbitrary (Node IRVar O O) where+    arbitrary = sized $ \n -> frequency+        [ (1, Alloc <$> arbitrary <*> arbitrary)+        -- , (1, Reclaim <$> arbitrary)+        , (40, Instr <$> arbitrary)+        , (20, Call InlineC <$> choose (0,n))+        , (30, LoadConst <$> arbitrary <*> arbitrary)+        , (50, Move <$> arbitrary <*> arbitrary)+        , (25, Copy <$> arbitrary <*> arbitrary)+        -- , (0, Save <$> arbitrary <*> arbitrary)+        -- , (0, Restore <$> arbitrary <*> arbitrary)+        -- , (0, pure $ Trace "tracer")+        ]++-- instance Arbitrary (Block (Node IRVar) C C) where+--     arbitrary = BlockCC (Label (unsafeCoerce (0 :: Int)))+--                     <$> arbitrary <*> arbitrary++-- instance Arbitrary (Block (Node IRVar) C O) where+--     arbitrary = BlockCO (Label (unsafeCoerce (0 :: Int))) <$> arbitrary++instance Arbitrary (Block (Node IRVar) O C) where+    arbitrary = BlockOC <$> arbitrary <*> arbitrary++instance Arbitrary (Block (Node IRVar) O O) where+    arbitrary = frequency+        [ (2, pure BNil)+        , (1, BMiddle <$> arbitrary)+        , (1, BCat <$> arbitrary <*> arbitrary)+        , (2, BSnoc <$> arbitrary <*> arbitrary)+        , (3, BCons <$> arbitrary <*> arbitrary)+        ]++instance Arbitrary (Graph' Block (Node IRVar) C C) where+    arbitrary = sized $ \n ->+        GMany NothingO+            <$> (unsafeCoerce+                 <$> IM.fromList+                 <$> (forM [1..n] $ \(i :: Int) ->+                       (,) <$> pure i+                           <*> (BlockCC (Label (unsafeCoerce i))+                                    <$> arbitrary <*> arbitrary+                                :: Gen (Block (Node IRVar) C C))))+            <*> pure NothingO++instance Show (Graph' Block (Node IRVar) C C) where+    show = showGraph show++generatedTests :: SpecWith ()+generatedTests =+  it "Handles generated tests" $+    (\a -> fuzzCheck' a 10000 (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+              | any ("Cannot insert interval onto unhandled list"+                     `isInfixOf`) err ->+                  True `shouldBe` True+              | otherwise ->+                  error $ "Allocation failed: " ++ intercalate "\n" err+          Right graph' -> do+              let g = showGraph show graph'+              _ <- evaluate (length g)+              return ()+              -- putStrLn $ "---- Compiled  ----\n" ++ g

@@ -1,8 +1,14 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+ module Main where  import AsmTest import Assembly+-- import Generated import LinearScan.Hoopl.DSL+-- import Programs.Blocked+import Programs.Exhaustion import Test.Hspec  -- | The objective of these tests is to present a program to the register@@ -17,6 +23,12 @@   describe "Call tests" callTests   describe "Loop tests" loopTests +  describe "Program tests" $ do+    it "Near exhaustion program" $ asmTest_ 32 exhaustion1+    -- it "Blocked register program" $ asmTest_ 32 regBlocked++  -- describe "Generated tests" generatedTests+ sanityTests :: SpecWith () sanityTests = do   it "Single instruction" $ asmTest 32@@ -36,9 +48,9 @@         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r2 v0)-        add (r0 v0) (r1 v0) (r2 v0)-        add (r0 v0) (r1 v0) (r2 v0)+        add (r0 v0) (r1 v1) (r2 v2)+        add (r0 v0) (r1 v1) (r2 v2)+        add (r0 v0) (r1 v1) (r2 v2)         return_    it "Multiple instructions" $ asmTest 32@@ -49,9 +61,9 @@         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r2 v0)-        add (r0 v0) (r1 v0) (r3 v0)-        add (r0 v0) (r1 v0) (r2 v0)+        add (r0 v0) (r1 v1) (r2 v2)+        add (r0 v0) (r1 v1) (r3 v3)+        add (r0 v0) (r1 v1) (r2 v2)         return_    it "More variables used than registers" $ asmTest 6@@ -75,29 +87,29 @@      label "entry" $ do         lc (r0 v0)-        lc (r1 v0)-        lc (r2 v0)-        lc (r3 v0)-        lc (r4 v0)-        lc (r5 v0)-        save (r4 v0) 0-        lc (r4 v0)-        save (r4 v0) 8-        lc (r4 v0)-        save (r4 v0) 16-        lc (r4 v0)-        save (r4 v0) 24-        lc (r4 v0)-        add (r0 v0) (r1 v0) (r0 v0)-        add (r2 v0) (r3 v0) (r1 v0)+        lc (r1 v1)+        lc (r2 v3)+        lc (r3 v4)+        lc (r4 v6)+        lc (r5 v7)+        save (r5 v0) 0+        lc (r5 v9)+        save (r5 v0) 8+        lc (r5 v10)+        save (r5 v0) 16+        lc (r5 v12)+        save (r5 v0) 24+        lc (r5 v13)+        add (r0 v0) (r1 v1) (r0 v2)+        add (r2 v3) (r3 v4) (r1 v5)         restore 0 (r3 v0)-        add (r3 v0) (r5 v0) (r2 v0)+        add (r4 v6) (r3 v7) (r2 v8)         save (r0 v0) 32-        restore 8 (r5 v0)+        restore 8 (r4 v0)         restore 16 (r0 v0)-        add (r5 v0) (r0 v0) (r3 v0)-        restore 24 (r5 v0)-        add (r5 v0) (r4 v0) (r0 v0)+        add (r4 v9) (r0 v10) (r3 v11)+        restore 24 (r4 v0)+        add (r4 v12) (r5 v13) (r0 v14)         return_    it "Single long-lived variable" $ asmTest 32@@ -109,10 +121,10 @@         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r1 v0)-        add (r0 v0) (r2 v0) (r2 v0)-        add (r0 v0) (r3 v0) (r3 v0)-        add (r0 v0) (r4 v0) (r0 v0)+        add (r0 v0) (r1 v1) (r1 v2)+        add (r0 v0) (r2 v4) (r2 v5)+        add (r0 v0) (r3 v7) (r3 v8)+        add (r0 v0) (r4 v10) (r0 v11)         return_    it "Two long-lived variables" $ asmTest 32@@ -124,10 +136,10 @@         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r1 v0)-        add (r0 v0) (r2 v0) (r3 v0)-        add (r0 v0) (r2 v0) (r4 v0)-        add (r0 v0) (r2 v0) (r0 v0)+        add (r0 v0) (r1 v1) (r1 v2)+        add (r0 v0) (r2 v4) (r3 v5)+        add (r0 v0) (r2 v4) (r4 v8)+        add (r0 v0) (r2 v4) (r0 v11)         return_    it "One variable with a long interval" $ asmTest 32@@ -147,18 +159,18 @@         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r1 v0)-        add (r2 v0) (r3 v0) (r2 v0)-        add (r4 v0) (r5 v0) (r3 v0)-        add (r6 v0) (r7 v0) (r4 v0)-        add (r8 v0) (r9 v0) (r5 v0)-        add (r10 v0) (r11 v0) (r6 v0)-        add (r12 v0) (r13 v0) (r7 v0)-        add (r14 v0) (r15 v0) (r8 v0)-        add (r16 v0) (r17 v0) (r9 v0)-        add (r18 v0) (r19 v0) (r10 v0)-        add (r20 v0) (r21 v0) (r11 v0)-        add (r0 v0) (r22 v0) (r0 v0)+        add (r0  v0)  (r1  v1)  (r1  v2)+        add (r2  v3)  (r3  v4)  (r2  v5)+        add (r4  v6)  (r5  v7)  (r3  v8)+        add (r6  v9)  (r7  v10) (r4  v11)+        add (r8  v12) (r9  v13) (r5  v14)+        add (r10 v15) (r11 v16) (r6  v17)+        add (r12 v18) (r13 v19) (r7  v20)+        add (r14 v21) (r15 v22) (r8  v23)+        add (r16 v24) (r17 v25) (r9  v26)+        add (r18 v27) (r19 v28) (r10 v29)+        add (r20 v30) (r21 v31) (r11 v32)+        add (r0  v0)  (r22 v34) (r0  v35)         return_    it "Many variables with long intervals" $ asmTest 32@@ -186,31 +198,31 @@         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r20 v0)-        add (r2 v0) (r3 v0) (r21 v0)-        add (r4 v0) (r5 v0) (r22 v0)-        add (r6 v0) (r7 v0) (r23 v0)-        add (r8 v0) (r9 v0) (r24 v0)-        add (r10 v0) (r11 v0) (r25 v0)-        add (r12 v0) (r13 v0) (r26 v0)-        add (r14 v0) (r15 v0) (r27 v0)-        add (r16 v0) (r17 v0) (r28 v0)-        add (r18 v0) (r19 v0) (r29 v0)-        add (r0 v0) (r1 v0) (r20 v0)-        add (r2 v0) (r3 v0) (r21 v0)-        add (r4 v0) (r5 v0) (r22 v0)-        add (r6 v0) (r7 v0) (r23 v0)-        add (r8 v0) (r9 v0) (r24 v0)-        add (r10 v0) (r11 v0) (r25 v0)-        add (r12 v0) (r13 v0) (r26 v0)-        add (r14 v0) (r15 v0) (r27 v0)-        add (r16 v0) (r17 v0) (r28 v0)-        add (r18 v0) (r19 v0) (r29 v0)+        add (r0  v0)  (r1 v1)   (r20 v2)+        add (r2  v3)  (r3 v4)   (r21 v5)+        add (r4  v6)  (r5 v7)   (r22 v8)+        add (r6  v9)  (r7 v10)  (r23 v11)+        add (r8  v12) (r9 v13)  (r24 v14)+        add (r10 v15) (r11 v16) (r25 v17)+        add (r12 v18) (r13 v19) (r26 v20)+        add (r14 v21) (r15 v22) (r27 v23)+        add (r16 v24) (r17 v25) (r28 v26)+        add (r18 v27) (r19 v28) (r29 v29)+        add (r0  v0)  (r1 v1)   (r20 v2)+        add (r2  v3)  (r3 v4)   (r21 v5)+        add (r4  v6)  (r5 v7)   (r22 v8)+        add (r6  v9)  (r7 v10)  (r23 v11)+        add (r8  v12) (r9 v13)  (r24 v14)+        add (r10 v15) (r11 v16) (r25 v17)+        add (r12 v18) (r13 v19) (r26 v20)+        add (r14 v21) (r15 v22) (r27 v23)+        add (r16 v24) (r17 v25) (r28 v26)+        add (r18 v27) (r19 v28) (r29 v29)         return_  spillTests :: SpecWith () spillTests = do-  it "Spilling one variable" $ asmTest 32+  it "No spilling necessary" $ asmTest 32     (label "entry" $ do         add v0   v1  v2         add v3   v4  v5@@ -223,6 +235,7 @@         add v24 v25 v26         add v27 v28 v29         add v30 v31 v32+        add v33 v34 v35         add v0   v1  v2         add v3   v4  v5         add v6   v7  v8@@ -234,43 +247,106 @@         add v24 v25 v26         add v27 v28 v29         add v30 v31 v32+        add v33 v34 v35         return_) $      label "entry" $ do-        add (r0 v0) (r1 v0) (r22 v0)-        add (r2 v0) (r3 v0) (r23 v0)-        add (r4 v0) (r5 v0) (r24 v0)-        add (r6 v0) (r7 v0) (r25 v0)-        add (r8 v0) (r9 v0) (r26 v0)-        add (r10 v0) (r11 v0) (r27 v0)-        add (r12 v0) (r13 v0) (r28 v0)-        add (r14 v0) (r15 v0) (r29 v0)-        add (r16 v0) (r17 v0) (r30 v0)-        add (r18 v0) (r19 v0) (r31 v0)+        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)+        save (r31 v0) 0         -- jww (2015-05-26): These saves are unnecessary+        add (r16 v24) (r17 v25) (r31 v26)+        save (r31 v0) 8+        add (r18 v27) (r19 v28) (r31 v29)+        save (r31 v0) 16+        add (r20 v30) (r21 v31) (r31 v32)+        save (r31 v0) 24+        add (r22 v33) (r23 v34) (r31 v35)+        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)+        restore 0 (r0 v0)+        add (r14 v21) (r15 v22) (r0 v23)+        restore 8 (r1 v31)+        add (r16 v24) (r17 v25) (r1 v26)+        restore 16 (r2 v0)+        add (r18 v27) (r19 v28) (r2 v29)+        restore 24 (r3 v0)+        add (r20 v30) (r21 v31) (r3 v32)+        add (r22 v33) (r23 v34) (r31 v35)+        return_ +  it "Spilling one variable" $ asmTest 32+    (label "entry" $ do+        add v0   v1  v2+        add v3   v4  v5+        add v6   v7  v8+        add v9  v10 v11+        add v12 v13 v14+        add v15 v16 v17+        add v18 v19 v20+        add v21 v22 v23+        add v24 v25 v26+        add v27 v28 v29+        add v30 v31 v32+        add v0   v1  v2+        add v3   v4  v5+        add v6   v7  v8+        add v9  v10 v11+        add v12 v13 v14+        add v15 v16 v17+        add v18 v19 v20+        add v21 v22 v23+        add v24 v25 v26+        add v27 v29 v28+        add v30 v32 v31+        return_) $++    label "entry" $ do+        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)+        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.  That happens to be-        -- 18, which is next used at position 41.-        save (r18 v0) 0-        add (r20 v0) (r21 v0) (r18 v0)-        add (r0 v0) (r1 v0) (r22 v0)-        add (r2 v0) (r3 v0) (r23 v0)-        add (r4 v0) (r5 v0) (r24 v0)-        add (r6 v0) (r7 v0) (r25 v0)-        add (r8 v0) (r9 v0) (r26 v0)-        add (r10 v0) (r11 v0) (r27 v0)-        add (r12 v0) (r13 v0) (r28 v0)-        add (r14 v0) (r15 v0) (r29 v0)-        add (r16 v0) (r17 v0) (r30 v0)+        -- position is the furthest from this position.+        save (r31 v0) 0 -        -- When it comes time to reload v29 (which had been allocated to 18),-        -- we pick the first available register which happens to be 0 in this-        -- case.+        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 (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 v0)-        add (r0 v0) (r19 v0) (r31 v0)-        add (r20 v0) (r21 v0) (r18 v0)++        add (r18 v27) (r0 v29) (r19 v28)+        add (r20 v30) (r31 v32) (r21 v31)         return_    it "Higher register pressure" $ asmTest 3@@ -289,23 +365,21 @@      label "entry" $ do         lc (r0 v0)-        lc (r1 v0)-        add (r0 v0) (r1 v0) (r2 v0)-        add (r2 v0) (r1 v0) (r0 v0)-        save (r1 v0) 0-        add (r0 v0) (r2 v0) (r1 v0)-        save (r2 v0) 8-        add (r1 v0) (r0 v0) (r2 v0)-        save (r1 v0) 16-        restore 8 (r1 v0)-        add (r1 v0) (r0 v0) (r0 v0)-        save (r0 v0) 24-        restore 16 (r0 v0)-        add (r0 v0) (r2 v0) (r1 v0)-        restore 24 (r2 v0)-        add (r2 v0) (r1 v0) (r0 v0)-        restore 0 (r1 v0)-        add (r0 v0) (r1 v0) (r0 v0)+        lc (r1 v1)+        add (r0 v0) (r1 v1) (r2 v2)+        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)+        add (r2 v2) (r0 v3) (r0 v6)+        restore 16 (r2 v5)+        add (r1 v4) (r2 v5) (r1 v7)+        add (r0 v6) (r1 v7) (r0 v8)+        restore 0 (r1 v1)+        add (r0 v8) (r1 v1) (r0 v0)         return_    it "Inserts necessary saves and restores" $ asmTest 4@@ -324,17 +398,17 @@      label "entry" $ do         lc (r0 v0)-        lc (r1 v0)-        add (r0 v0) (r1 v0) (r2 v0)-        add (r2 v0) (r1 v0) (r3 v0)-        add (r3 v0) (r2 v0) (r0 v0)+        lc (r1 v1)+        add (r0 v0) (r1 v1) (r2 v2)+        add (r2 v2) (r1 v1) (r3 v3)         save (r1 v0) 0-        add (r0 v0) (r3 v0) (r1 v0)-        add (r2 v0) (r3 v0) (r2 v0)-        add (r0 v0) (r1 v0) (r0 v0)-        add (r2 v0) (r0 v0) (r0 v0)+        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)-        add (r0 v0) (r1 v0) (r0 v0)+        add (r0 v8) (r1 v1) (r0 v0)         return_  blockTests :: SpecWith ()@@ -356,18 +430,18 @@             return_) $      do label "entry" $ do-           add (r0 v0) (r1 v0) (r0 v0)+           add (r0 v0) (r1 v1) (r0 v2)            jump "L2"         label "L2" $ do-           add (r0 v0) (r2 v0) (r1 v0)-           add (r0 v0) (r1 v0) (r1 v0)+           add (r0 v2) (r2 v3) (r1 v4)+           add (r0 v2) (r1 v4) (r1 v5)            jump "L3"         label "L3" $ do-           add (r0 v0) (r1 v0) (r1 v0)-           add (r0 v0) (r1 v0) (r1 v0)-           add (r0 v0) (r1 v0) (r0 v0)+           add (r0 v2) (r1 v5) (r1 v6)+           add (r0 v2) (r1 v6) (r1 v7)+           add (r0 v2) (r1 v7) (r0 v8)            return_    it "Inserts resolving moves" $ asmTest 3@@ -375,7 +449,7 @@             lc v0             lc v1             add v0 v1 v2-            branch Zero v2 "B3" "B2"+            branch v2 "B3" "B2"          label "B2" $ do             add v1 v2 v3@@ -395,35 +469,35 @@      do label "entry" $ do            lc (r0 v0)-           lc (r1 v0)-           add (r0 v0) (r1 v0) (r2 v0)-           branch Zero (r2 v0) "B2" "B3"+           lc (r1 v1)+           add (r0 v0) (r1 v1) (r2 v2)+           branch (r2 v2) "B3" "B2"         label "B2" $ do-           move (r1 v0) (r0 v0)-           add (r0 v0) (r2 v0) (r1 v0)+           save (r0 v0) 0+           add (r1 v1) (r2 v2) (r0 v3)+           restore 0 (r1 v0)+           add (r1 v0) (r0 v3) (r2 v4)+           save (r0 v3) 8+           add (r1 v0) (r2 v4) (r0 v5)+           add (r2 v4) (r0 v5) (r0 v6)+           restore 8 (r2 v3)+           add (r0 v6) (r2 v3) (r0 v7)            jump "B4"         label "B3" $ do-           save (r0 v0) 0-           add (r1 v0) (r2 v0) (r0 v0)-           restore 0 (r2 v0)-           add (r2 v0) (r0 v0) (r1 v0)-           save (r0 v0) 8-           add (r2 v0) (r1 v0) (r0 v0)-           add (r1 v0) (r0 v0) (r0 v0)-           restore 8 (r1 v0)-           add (r0 v0) (r1 v0) (r0 v0)+           move (r2 v0) (r0 v0)+           add (r1 v1) (r0 v2) (r2 v3)            jump "B4"         label "B4" $ do-           add (r1 v0) (r1 v0) (r0 v0)+           add (r2 v3) (r2 v3) (r0 v0)            return_    it "When resolving moves are not needed" $ asmTest 4     (do label "entry" $ do             add v0 v1 v2-            branch Zero v2 "B3" "B2"+            branch v2 "B3" "B2"          label "B2" $ do             add v1 v2 v3@@ -442,23 +516,23 @@             return_) $      do label "entry" $ do-           add (r0 v0) (r1 v0) (r2 v0)-           branch Zero (r2 v0) "B2" "B3"+           add (r0 v0) (r1 v1) (r2 v2)+           branch (r2 v2) "B2" "B3"         label "B2" $ do-           add (r1 v0) (r2 v0) (r3 v0)-           add (r0 v0) (r0 v0) (r1 v0)-           add (r0 v0) (r0 v0) (r2 v0)-           add (r0 v0) (r1 v0) (r1 v0)-           add (r0 v0) (r2 v0) (r1 v0)+           add (r1 v1) (r2 v2) (r3 v3)+           add (r0 v0) (r0 v0) (r1 v4)+           add (r0 v0) (r0 v0) (r2 v5)+           add (r0 v0) (r1 v4) (r1 v6)+           add (r0 v0) (r2 v5) (r1 v6)            jump "B4"         label "B3" $ do-           add (r1 v0) (r2 v0) (r3 v0)+           add (r1 v1) (r2 v2) (r3 v3)            jump "B4"         label "B4" $ do-           add (r3 v0) (r3 v0) (r0 v0)+           add (r3 v3) (r3 v3) (r0 v0)            return_    it "Another resolution case" $ asmTest 4@@ -480,7 +554,7 @@             jump "L6"          label "L6" $-            branch Zero v4 "L3" "L2"+            branch v4 "L3" "L2"          label "L2" $ do             lc v21@@ -491,53 +565,49 @@             jump "L6") $      do label "entry" $ do-           lc (r0 v0)-           lc (r1 v0)-           lc (r2 v0)-           lc (r3 v0)-           save (r3 v0) 0+           lc (r0 v3)+           lc (r1 v4)+           lc (r2 v15)+           lc (r3 v20)+           save (r3 v20) 0            jump "L3"         label "L3" $ do-           move (r0 v0) (r3 v0)-           move (r3 v0) (r3 v0)-           move (r3 v0) (r3 v0)-           move (r3 v0) (r3 v0)-           move (r3 v0) (r3 v0)-           save (r0 v0) 8-           lc (r0 v0)-           save (r0 v0) 16-           move (r2 v0) (r0 v0)+           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 "L2" $ do-           lc (r3 v0)-           save (r2 v0) 24-           move (r3 v0) (r2 v0)-           move (r0 v0) (r1 v0)-           save (r0 v0) 32-           lc (r0 v0)-           save (r1 v0) 48-           save (r0 v0) 40-           restore 0 (r1 v0)-           move (r1 v0) (r0 v0)-           save (r1 v0) 0-           restore 24 (r2 v0)-           restore 32 (r0 v0)-           restore 48 (r1 v0)+           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) 48+           save (r3 v19) 40+           restore 0 (r2 v20)+           move (r2 v20) (r3 v17)+           save (r2 v20) 0+           restore 24 (r2 v15)            jump "L6"         label "L6" $-           branch Zero (r1 v0) "L5" "L2"+           branch (r1 v4) "L5" "L2"         label "L5" $ do-           save (r1 v0) 48-           restore 0 (r1 v0)-           save (r2 v0) 24-           save (r1 v0) 0-           restore 24 (r2 v0)-           restore 48 (r1 v0)-           restore 8 (r0 v0)+           save (r2 v15) 24+           restore 0 (r2 v20)   -- jww (2015-05-26): should be unnecessary+           save (r2 v20) 0+           restore 24 (r2 v15)+           restore 8 (r0 v3)            jump "L3"  callTests :: SpecWith ()@@ -559,24 +629,24 @@      label "entry" $ do         lc (r0 v0)-        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 (r0 v4) (r3 v3) (r1 v5)-        save (r2 v2) 32-        save (r3 v3) 24-        save (r0 v4) 16-        save (r1 v5) 8+        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         call 1000-        restore 32 (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 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)         add (r0 v8) (r1 v1) (r0 v0)         return_@@ -590,11 +660,11 @@          label "B1" $ do             trace "B1"-            branch Zero v1 "B3" "B2"+            branch v1 "B3" "B2"          label "B2" $ do             trace "B2"-            branch Zero v1 "B5" "B4"+            branch v1 "B5" "B4"          label "B3" $ do             trace "B3"@@ -602,7 +672,7 @@          label "B4" $ do             trace "B4"-            branch Zero v1 "B7" "B6"+            branch v1 "B7" "B6"          label "B5" $ do             trace "B5"@@ -616,29 +686,29 @@             trace "B7"             jump "B1") $ -    "L1:\n\-\\tTRACE  \"B0\"\n\-\\t@jmp L2\n\-\L2:\n\-\\tTRACE  \"B1\"\n\-\\t@bZero 0 L3; @jmp L4\n\-\L3:\n\-\\tTRACE  \"B3\"\n\-\\t@jmp L2\n\-\L4:\n\-\\tTRACE  \"B2\"\n\-\\t@bZero 0 L5; @jmp L9\n\-\L5:\n\-\\tTRACE  \"B5\"\n\-\\t@return [] nop\n\-\L6:\n\-\\tTRACE  \"B4\"\n\-\\t@bZero 0 L7; @jmp L8\n\-\L7:\n\-\\tTRACE  \"B7\"\n\-\\t@jmp L2\n\-\L8:\n\-\\tTRACE  \"B6\"\n\-\\t@jmp L6\n\-\L9:\n\-\\t@jmp L6\n"+    Just "    label \"L1\" $ do\n\+\        trace  \"B0\"\n\+\        jump \"L2\"\n\+\    label \"L2\" $ do\n\+\        trace  \"B1\"\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\+\    label \"L5\" $ do\n\+\        trace  \"B5\"\n\+\        return_\n\+\    label \"L6\" $ do\n\+\        trace  \"B4\"\n\+\        branch r0|v1 \"L7\" \"L8\"\n\+\    label \"L7\" $ do\n\+\        trace  \"B7\"\n\+\        jump \"L2\"\n\+\    label \"L8\" $ do\n\+\        trace  \"B6\"\n\+\        jump \"L6\"\n\+\    label \"L9\" $ do\n\+\        jump \"L6\"\n"

@@ -18,8 +18,10 @@     rnf (VirtualIV r) = r `deepseq` ()  instance NFData v => NFData (Instruction v) where-    rnf (Add x y z) = x `deepseq` y `deepseq` z `deepseq` ()-    rnf Nop = ()+    rnf (Add x y z)  = x `deepseq` y `deepseq` z `deepseq` ()+    rnf (Offp x y z) = x `deepseq` y `deepseq` z `deepseq` ()+    rnf (Offlpi x)   = x `deepseq` ()+    rnf Nop          = ()  instance NFData CConv where     rnf InlineC = ()

@@ -0,0 +1,207 @@+module Programs.Blocked where++import Assembly+import LinearScan.Hoopl.DSL++regBlocked :: Program (Node IRVar)+regBlocked = do+    label "entry" $ do+        lc v23+        add v64 v64 pr11+        call 80+        jump "L61"++    label "L61" $ do+        add v86 v39 v98+        nop+        add v77 v47 v60+        add v71 v4 v5+        move v57 v18+        copy v20 v42+        offp v20 pr19 v19+        call 57+        add pr31 v99 pr4+        nop+        nop+        move pr5 v41+        add v47 v57 v98+        alloc (Just pr21) v28+        branch v26 "L44" "L9"++    label "L9" $ do+        copy v9 v52+        copy v42 v36+        branch v24 "L74" "L52"++    label "L52" $ do+        jump "L60"++    label "L74" $ do+        copy pr14 v8+        move v34 pr20+        branch v92 "L51" "L50"++    label "L50" $ do+        jump "L39"++    label "L51" $ do+        jump "L5"++    label "L5" $ do+        alloc (Just v3) v79+        move v81 v76+        lc v55+        call 21+        lc v70+        add v99 v20 v89+        lc v5+        move v72 pr12+        offp v90 pr13 v0+        lc v2+        offlpi v78+        branch pr21 "L29" "L49"++    label "L49" $ do+        jump "L60"++    label "L60" $ do+        lc v84+        move pr30 v47+        branch v0 "L33" "L18"++    label "L18" $ do+        call 22+        jump "L35"++    label "L35" $ do+        copy v91 pr19+        move v43 v91+        branch v37 "L48" "L17"++    label "L17" $ do+        move v66 v27+        jump "L10"++    label "L10" $ do+        add v9 pr11 pr29+        branch v54 "L98" "L21"++    label "L21" $ do+        move pr14 pr14+        copy v15 v43+        move v79 v77+        copy v4 v79+        call 61+        move pr13 v31+        alloc (Just v59) v37+        return_++    label "L98" $ do+        lc v25+        return_++    label "L33" $ do+        add v35 pr3 v59+        lc v42+        branch v62 "L94" "L63"++    label "L63" $ do+        move pr23 v47+        return_++    label "L94" $ do+        move v27 v74+        call 87+        add v48 pr2 v95+        copy v11 v92+        copy pr0 v35+        lc pr25+        copy v80 v59+        add pr28 v96 pr17+        move v92 v88+        move v77 v92+        jump "L40"++    label "L40" $ do+        branch v13 "L25" "L47"++    label "L47" $ do+        jump "L57"++    label "L57" $ do+        move v59 v3+        alloc (Just v27) pr6+        jump "L4"++    label "L4" $ do+        branch v59 "L12" "L46"++    label "L46" $ do+        jump "L48"++    label "L48" $ do+        jump "L61"++    label "L12" $ do+        branch v84 "L8" "L90"++    label "L90" $ do+        call 63+        offp v71 v37 pr15+        add v16 v91 v9+        call 18+        branch v100 "L53" "L15"++    label "L15" $ do+        nop+        add pr24 v23 v73+        jump "L66"++    label "L66" $ do+        branch v78 "L42" "L41"++    label "L41" $ do+        jump "L61"++    label "L42" $ do+        jump "L57"++    label "L53" $ do+        add v32 v3 pr16+        jump "L87"++    label "L87" $ do+        return_++    label "L8" $ do+        move v67 v2+        offlpi v85+        lc v39+        jump "L26"++    label "L26" $ do+        copy v58 v91+        return_++    label "L25" $ do+        move v5 pr30+        move pr12 v5+        move v74 v19+        copy pr1 v50+        branch v31 "L71" "L40"++    label "L71" $ do+        branch v42 "L39" "L0"++    label "L39" $ do+        offlpi v7+        branch v82 "L44" "L43"++    label "L43" $ do+        jump "L5"++    label "L44" $ do+        jump "L61"++    label "L29" $ do+        return_

@@ -0,0 +1,397 @@+module Programs.Exhaustion where++import Assembly+import LinearScan.Hoopl.DSL++exhaustion1 :: Program (Node IRVar)+exhaustion1 = do+    label "entry" $ do+        move pr1 v4+        move pr2 v5+        move pr3 v6+        alloc Nothing pr0+        move v4 v1+        move v5 v2+        move v6 v3+        lc v8+        move v8 v9+        lc v10+        move v10 v11+        lc v12+        move v12 v13+        move v1 v16+        copy v16 v14+        offlpi v16+        copy v16 v15+        move v14 v17+        move v15 v18+        move v2 v21+        copy v21 v19+        offlpi v21+        copy v21 v20+        move v19 v22+        move v20 v23+        move v3 v26+        copy v26 v24+        offlpi v26+        copy v26 v25+        move v25 v28+        move v17 v30+        move v30 v29+        move v29 v32+        move v22 v34+        move v34 v33+        move v33 v36+        move v18 v39+        move v39 v37+        move v37 v40+        move v23 v43+        move v43 v41+        move v41 v44+        move v28 v47+        move v47 v45+        move v45 v48+        jump "L2"++    label "L2" $ do+        move v9 v51+        move v32 v52+        lc v53+        move v53 v54+        lc v55+        move v55 v56+        move v51 v58+        move v52 v59+        add v58 v59 v60+        move v60 v57+        jump "L9"++    label "L9" $ do+        move v57 v61+        branch v61 "L10" "L11"++    label "L11" $ do+        move v54 v62+        jump "L12"++    label "L10" $ do+        move v56 v62+        jump "L12"++    label "L12" $ do+        move v62 v50+        jump "L8"++    label "L8" $ do+        branch v50 "L5" "L6"++    label "L6" $ do+        lc v49+        jump "L7"++    label "L5" $ do+        move v11 v64+        move v36 v65+        lc v66+        move v66 v67+        lc v68+        move v68 v69+        move v64 v71+        move v65 v72+        add v71 v72 v73+        move v73 v70+        jump "L18"++    label "L18" $ do+        move v70 v74+        branch v74 "L19" "L20"++    label "L20" $ do+        move v67 v75+        jump "L21"++    label "L19" $ do+        move v69 v75+        jump "L21"++    label "L21" $ do+        move v75 v63+        jump "L17"++    label "L17" $ do+        branch v63 "L14" "L15"++    label "L15" $ do+        lc v49+        jump "L7"++    label "L14" $ do+        move v13 v76+        lc v77+        lc v78+        move v78 v79+        lc v80+        move v80 v81+        move v76 v83+        move v77 v84+        add v83 v84 v85+        move v85 v82+        jump "L24"++    label "L24" $ do+        move v82 v86+        branch v86 "L25" "L26"++    label "L26" $ do+        move v79 v87+        jump "L27"++    label "L25" $ do+        move v81 v87+        jump "L27"++    label "L27" $ do+        move v87 v49+        jump "L7"++    label "L7" $ do+        branch v49 "L3" "L75"++    label "L3" $ do+        move v40 v90+        move v9 v91+        move v91 v92+        offp v92 v90 v89+        copy v89 v88+        move v88 v93+        move v44 v96+        move v11 v97+        move v97 v98+        offp v98 v96 v95+        copy v95 v94+        move v94 v99+        move v93 v113+        copy v113 v101+        move v99 v114+        copy v114 v102+        lc v103+        move v103 v104+        lc v105+        move v105 v106+        move v101 v108+        move v102 v109+        add v108 v109 v110+        move v110 v107+        jump "L33"++    label "L33" $ do+        move v107 v111+        branch v111 "L34" "L35"++    label "L35" $ do+        move v104 v112+        jump "L36"++    label "L34" $ do+        move v106 v112+        jump "L36"++    label "L36" $ do+        move v112 v100+        jump "L32"++    label "L32" $ do+        branch v100 "L29" "L30"++    label "L30" $ do+        move v44 v130+        move v11 v131+        move v131 v132+        offp v132 v130 v129+        copy v129 v128+        move v48 v134+        move v13 v135+        move v135 v136+        offp v136 v134 v133+        move v128 v133+        move v11 v138+        lc v139+        add v138 v139 v140+        move v140 v137+        jump "L39"++    label "L39" $ do+        move v137 v11+        move v93 v145+        copy v145 v142+        move v99 v146+        copy v146 v143+        add v142 v143 v144+        move v144 v141+        jump "L43"++    label "L43" $ do+        branch v141 "L40" "L73"++    label "L40" $ do+        move v9 v148+        lc v149+        add v148 v149 v150+        move v150 v147+        jump "L44"++    label "L44" $ do+        move v147 v9+        jump "L31"++    label "L29" $ do+        move v40 v117+        move v9 v118+        move v118 v119+        offp v119 v117 v116+        copy v116 v115+        move v48 v121+        move v13 v122+        move v122 v123+        offp v123 v121 v120+        move v115 v120+        move v9 v125+        lc v126+        add v125 v126 v127+        move v127 v124+        jump "L38"++    label "L38" $ do+        move v124 v9+        jump "L31"++    label "L31" $ do+        move v13 v152+        lc v153+        add v152 v153 v154+        move v154 v151+        jump "L45"++    label "L45" $ do+        move v151 v13+        jump "L2"++    label "L73" $ do+        move v206 v210+        branch v210 "L74" "L75"++    label "L75" $ do+        jump "L46"++    label "L46" $ do+        move v9 v157+        move v32 v158+        lc v159+        move v159 v160+        lc v161+        move v161 v162+        move v157 v164+        move v158 v165+        add v164 v165 v166+        move v166 v163+        jump "L53"++    label "L53" $ do+        move v163 v167+        branch v167 "L54" "L55"++    label "L55" $ do+        move v160 v168+        jump "L56"++    label "L54" $ do+        move v162 v168+        jump "L56"++    label "L56" $ do+        move v168 v156+        jump "L52"++    label "L52" $ do+        branch v156 "L49" "L50"++    label "L50" $ do+        lc v155+        jump "L51"++    label "L49" $ do+        move v13 v169+        lc v170+        lc v171+        move v171 v172+        lc v173+        move v173 v174+        move v169 v176+        move v170 v177+        add v176 v177 v178+        move v178 v175+        jump "L59"++    label "L59" $ do+        move v175 v179+        branch v179 "L60" "L61"++    label "L61" $ do+        move v172 v180+        jump "L62"++    label "L60" $ do+        move v174 v180+        jump "L62"++    label "L62" $ do+        move v180 v155+        jump "L51"++    label "L51" $ do+        branch v155 "L47" "L74"++    label "L47" $ do+        move v40 v183+        move v9 v184+        move v184 v185+        offp v185 v183 v182+        copy v182 v181+        move v48 v187+        move v13 v188+        move v188 v189+        offp v189 v187 v186+        move v181 v186+        move v9 v191+        lc v192+        add v191 v192 v193+        move v193 v190+        jump "L64"++    label "L64" $ do+        move v190 v9+        move v13 v195+        lc v196+        add v195 v196 v197+        move v197 v194+        jump "L65"++    label "L65" $ do+        move v194 v13+        jump "L46"++    label "L74" $ do+        jump "L66"++    label "L66" $ do+        move v11 v200+        move v36 v201+        lc v202+        move v202 v203+        lc v204+        move v204 v205+        move v200 v207+        move v201 v208+        add v207 v208 v209+        move v209 v206+        jump "L73"