linearscan-hoopl 0.1.0.0 → 0.4.0.0
raw patch · 5 files changed
+361/−178 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ LinearScan.Hoopl: op1ToString :: NodeAlloc s n1 n2 => n1 e x -> String
Files
- LinearScan/Hoopl.hs +7/−0
- linearscan-hoopl.cabal +2/−2
- test/AsmTest.hs +1/−1
- test/Assembly.hs +20/−6
- test/Main.hs +331/−169
LinearScan/Hoopl.hs view
@@ -27,6 +27,8 @@ mkSaveOps :: PhysReg -> Maybe VarId -> State s [n2 O O] mkRestoreOps :: Maybe VarId -> PhysReg -> State s [n2 O O] + op1ToString :: n1 e x -> String+ data NodeV n = NodeCO { getNodeCO :: n C O } | NodeOO { getNodeOO :: n O O } | NodeOC { getNodeOC :: n O C }@@ -72,6 +74,11 @@ NodeCO n -> [NodeCO (setRegisters m n)] NodeOO n -> [NodeOO (setRegisters m n)] NodeOC n -> [NodeOC (setRegisters m n)]++ , showOp1 = \node -> case node of+ NodeCO n -> op1ToString n+ NodeOO n -> op1ToString n+ NodeOC n -> op1ToString n } data SpillStack = SpillStack
linearscan-hoopl.cabal view
@@ -1,6 +1,6 @@ name: linearscan-hoopl-version: 0.1.0.0-synopsis: Make it easy to use the linearscan register allocator with Hoopl+version: 0.4.0.0+synopsis: Makes it easy to use the linearscan register allocator with Hoopl homepage: http://github.com/jwiegley/linearscan-hoopl license: BSD3 license-file: LICENSE
test/AsmTest.hs view
@@ -18,7 +18,7 @@ asmTest :: Int -> Program (Node IRVar) -> Program (Node PhysReg) -> Expectation asmTest regs (compile "entry" -> (prog, entry)) (compile "entry" -> (result, _)) =- go $ M.fromList $ zip (Prelude.map entryLabel blocks) [(1 :: Int)..]+ go $ M.fromList $ zip (Prelude.map entryLabel blocks) [(0 :: Int)..] where GMany NothingO body NothingO = prog blocks = postorder_dfs_from body entry
test/Assembly.hs view
@@ -54,12 +54,13 @@ Alloc :: Maybe (Src v) -> Dst v -> Node v O O Reclaim :: Src v -> Node v O O Instr :: Instruction v -> Node v O O- Call :: CConv -> Instruction v -> Node v O O+ Call :: CConv -> Int -> Node v O O LoadConst :: Int -> Dst v -> Node v O O Move :: Src v -> Dst v -> Node v O O Copy :: Src v -> Dst v -> Node v O O Save :: Src v -> Dst Int -> Node v O O Restore :: Src Int -> Dst v -> Node v O O+ Trace :: String -> Node v O O Jump :: Label -> Node v O C Branch :: Test -> v -> Success Label -> Failure Label -> Node v O C@@ -74,12 +75,13 @@ ++ " " ++ show x2 show (Reclaim v) = "\t@reclaim " ++ show v show (Instr i) = "\t" ++ show i- show (Call c i) = "\t@call " ++ show c ++ " " ++ show i- show (LoadConst c v) = "\t@lc " ++ show v ++ " " ++ show c+ 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@@ -107,8 +109,9 @@ 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) = Call cc <$> traverse f i+ 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@@ -122,6 +125,9 @@ move :: v -> v -> BodyNode (Node v) move x0 x1 = bodyNode $ Move x0 x1 +call :: Int -> BodyNode (Node v)+call dst = bodyNode $ Call InlineC dst+ lc :: v -> BodyNode (Node v) lc x0 = bodyNode $ LoadConst 0 x0 @@ -131,6 +137,9 @@ restore :: Src PhysReg -> PhysReg -> BodyNode (Node PhysReg) restore src r = bodyNode $ Restore src r +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@@ -158,9 +167,11 @@ go (Label _) = mempty 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 (Trace _) = mempty go (ReturnInstr _ i) = fromInstr i go n = error $ "getReferences: unhandled node: " ++ show n @@ -184,8 +195,9 @@ go :: [(Int, PhysReg)] -> IRVar -> PhysReg go _ (PhysicalIV r) = r go m (VirtualIV n) =- fromMaybe (error $ "Allocation failed for variable " ++ show n)- (Data.List.lookup n m)+ fromMaybe+ (-1) -- (error $ "Allocation failed for variable " ++ show n)+ (Data.List.lookup n m) mkMoveOps src dst = return [Move src dst] mkSwapOps src dst = liftA2 (++) (mkRestoreOps Nothing dst)@@ -195,6 +207,8 @@ return [Save src off] mkRestoreOps src dst = do off <- getStackSlot src return [Restore off dst]++ op1ToString = show var :: Int -> IRVar var = VirtualIV
test/Main.hs view
@@ -13,6 +13,8 @@ main = hspec $ do describe "Sanity tests" sanityTests describe "Block tests" blockTests+ describe "Call tests" callTests+ describe "Loop tests" loopTests sanityTests :: SpecWith () sanityTests = do@@ -22,7 +24,7 @@ return_) $ label "entry" $ do- add r0 r1 r2+ add 0 1 0 return_ it "Single, repeated instruction" $ asmTest 32@@ -33,9 +35,9 @@ return_) $ label "entry" $ do- add r0 r1 r2- add r0 r1 r2- add r0 r1 r2+ add 0 1 2+ add 0 1 2+ add 0 1 2 return_ it "Multiple instructions" $ asmTest 32@@ -46,41 +48,56 @@ return_) $ label "entry" $ do- add r0 r1 r2- add r0 r1 r3- add r0 r1 r2+ add 0 1 2+ add 0 1 3+ add 0 1 2 return_ - it "More variables used than registers" $ asmTest 32+ it "More variables used than registers" $ asmTest 6 (label "entry" $ do+ lc v0+ lc v1+ lc v3+ lc v4+ lc v6+ lc v7+ lc v9+ lc v10+ lc v12+ lc v13 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 v33 v34 v35 return_) $ label "entry" $ do- add r0 r1 r24- add r2 r3 r0- add r4 r5 r1- add r6 r7 r2- add r8 r9 r3- add r10 r11 r4- add r12 r13 r5- add r14 r15 r6- add r16 r17 r7- add r18 r19 r8- add r20 r21 r9- add r22 r23 r10- return_+ lc 0+ lc 1+ lc 2+ lc 3+ lc 4+ lc 5+ save 4 0+ lc 4+ save 4 8+ lc 4+ save 4 16+ lc 4+ save 4 24+ lc 4+ add 0 1 0+ add 2 3 1+ restore 0 3+ add 3 5 2+ save 0 32+ restore 8 5+ restore 16 0+ add 5 0 3+ restore 24 5+ add 5 4 0+ return_ it "Single long-lived variable" $ asmTest 32 (label "entry" $ do@@ -91,10 +108,10 @@ return_) $ label "entry" $ do- add r0 r1 r5- add r0 r2 r1- add r0 r3 r2- add r0 r4 r3+ add 0 1 1+ add 0 2 2+ add 0 3 3+ add 0 4 0 return_ it "Two long-lived variables" $ asmTest 32@@ -106,10 +123,10 @@ return_) $ label "entry" $ do- add r0 r1 r3- add r0 r2 r1- add r0 r2 r4- add r0 r2 r5+ add 0 1 1+ add 0 2 3+ add 0 2 4+ add 0 2 0 return_ it "One variable with a long interval" $ asmTest 32@@ -129,18 +146,18 @@ return_) $ label "entry" $ do- add r0 r1 r23- add r2 r3 r1- add r4 r5 r2- add r6 r7 r3- add r8 r9 r4- add r10 r11 r5- add r12 r13 r6- add r14 r15 r7- add r16 r17 r8- add r18 r19 r9- add r20 r21 r10- add r0 r22 r11+ add 0 1 1+ add 2 3 2+ add 4 5 3+ add 6 7 4+ add 8 9 5+ add 10 11 6+ add 12 13 7+ add 14 15 8+ add 16 17 9+ add 18 19 10+ add 20 21 11+ add 0 22 0 return_ it "Many variables with long intervals" $ asmTest 32@@ -168,26 +185,26 @@ return_) $ label "entry" $ do- add r0 r1 r20- add r2 r3 r21- add r4 r5 r22- add r6 r7 r23- add r8 r9 r24- add r10 r11 r25- add r12 r13 r26- add r14 r15 r27- add r16 r17 r28- add r18 r19 r29- add r0 r1 r20- add r2 r3 r21- add r4 r5 r22- add r6 r7 r23- add r8 r9 r24- add r10 r11 r25- add r12 r13 r26- add r14 r15 r27- add r16 r17 r28- add r18 r19 r29+ add 0 1 20+ add 2 3 21+ add 4 5 22+ add 6 7 23+ add 8 9 24+ add 10 11 25+ add 12 13 26+ add 14 15 27+ add 16 17 28+ add 18 19 29+ add 0 1 20+ add 2 3 21+ add 4 5 22+ add 6 7 23+ add 8 9 24+ add 10 11 25+ add 12 13 26+ add 14 15 27+ add 16 17 28+ add 18 19 29 return_ it "Spilling one variable" $ asmTest 32@@ -217,57 +234,104 @@ return_) $ label "entry" $ do- add r0 r1 r22- add r2 r3 r23- add r4 r5 r24- add r6 r7 r25- add r8 r9 r26- add r10 r11 r27- add r12 r13 r28- add r14 r15 r29- add r16 r17 r30- add r18 r19 r31+ add 0 1 22+ add 2 3 23+ add 4 5 24+ add 6 7 25+ add 8 9 26+ add 10 11 27+ add 12 13 28+ add 14 15 29+ add 16 17 30+ add 18 19 31 -- 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- -- r18, which is next used at position 41.- save r18 0- add r20 r21 r18- add r0 r1 r22- add r2 r3 r23- add r4 r5 r24- add r6 r7 r25- add r8 r9 r26- add r10 r11 r27- add r12 r13 r28- add r14 r15 r29- add r16 r17 r30+ -- 18, which is next used at position 41.+ save 18 0+ add 20 21 18+ add 0 1 22+ add 2 3 23+ add 4 5 24+ add 6 7 25+ add 8 9 26+ add 10 11 27+ add 12 13 28+ add 14 15 29+ add 16 17 30 - -- When it comes time to reload v29 (which had been allocated to r18),- -- we pick the first available register which happens to be r0 in this+ -- 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.- restore 0 r0- add r0 r19 r31- add r20 r21 r18+ restore 0 0+ add 0 19 31+ add 20 21 18 return_ - it "Inserts only necessary saves and restores" $ asmTest 4+ it "Higher register pressure" $ asmTest 3 (label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 add v2 v1 v3 add v3 v2 v4- add v4 v1 v0+ add v4 v3 v5+ add v2 v3 v6+ add v4 v5 v7+ add v6 v7 v8+ add v8 v1 v0 return_) $ label "entry" $ do- add r1 r0 r2- add r2 r0 r3- save r0 0- add r3 r2 r0- restore 0 r2- add r0 r2 r1+ lc 0+ lc 1+ add 0 1 2+ add 2 1 0+ save 1 0+ add 0 2 1+ save 2 8+ add 1 0 2+ save 1 16+ restore 8 1+ add 1 0 0+ save 0 24+ restore 16 0+ add 0 2 1+ restore 24 2+ add 2 1 0+ restore 0 1+ add 0 1 0+ return_++ it "Inserts necessary saves and restores" $ asmTest 4+ (label "entry" $ do+ lc v0+ lc v1+ add v0 v1 v2+ add v2 v1 v3+ add v3 v2 v4+ add v4 v3 v5+ add v2 v3 v6+ add v4 v5 v7+ add v6 v7 v8+ add v8 v1 v0+ return_) $++ label "entry" $ do+ lc 0+ lc 1+ add 0 1 2+ add 2 1 3+ add 3 2 0+ save 1 0+ add 0 3 1+ add 2 3 2+ add 0 1 0+ add 2 0 0+ restore 0 1+ add 0 1 0 return_ blockTests :: SpecWith ()@@ -289,31 +353,33 @@ return_) $ do label "entry" $ do- add r0 r1 r3+ add 0 1 0 jump "L2" label "L2" $ do- add r3 r2 r0- add r3 r0 r1+ add 0 2 1+ add 0 1 1 jump "L3" label "L3" $ do- add r3 r1 r0- add r3 r0 r1- add r3 r1 r0+ add 0 1 1+ add 0 1 1+ add 0 1 0 return_ - it "Inserts resolving moves" $ asmTest 4+ it "Inserts resolving moves" $ asmTest 3 (do label "entry" $ do+ lc v0+ lc v1 add v0 v1 v2 branch Zero v2 "B3" "B2" label "B2" $ do add v1 v2 v3- add v0 v0 v4- add v0 v0 v5- add v0 v4 v6- add v0 v5 v6+ add v0 v3 v4+ add v0 v4 v5+ add v4 v5 v6+ add v6 v3 v7 jump "B4" label "B3" $ do@@ -325,30 +391,33 @@ return_) $ do label "entry" $ do- add r0 r1 r2- branch Zero r2 "B2" "B3"+ lc 0+ lc 1+ add 0 1 2+ branch Zero 2 "B2" "B3" label "B2" $ do- add r1 r2 r3+ add 1 2 0+ move 0 1 jump "B4" label "B3" $ do- add r1 r2 r3- save r3 16- save r2 8- save r1 0- add r0 r0 r1- add r0 r0 r2- add r0 r1 r3- add r0 r2 r3- restore 16 r3+ save 0 0+ add 1 2 0+ restore 0 2+ add 2 0 1+ save 0 8+ add 2 1 0+ add 1 0 0+ restore 8 1+ add 0 1 0 jump "B4" label "B4" $ do- add r3 r3 r0+ add 1 1 2 return_ - it "Inserts resolving moves another way" $ asmTest 4+ it "When resolving moves are not needed" $ asmTest 4 (do label "entry" $ do add v0 v1 v2 branch Zero v2 "B3" "B2"@@ -370,26 +439,23 @@ return_) $ do label "entry" $ do- add r0 r1 r2- branch Zero r2 "B2" "B3"+ add 0 1 2+ branch Zero 2 "B2" "B3" label "B2" $ do- add r1 r2 r3- save r3 0- add r0 r0 r1- add r0 r0 r2- add r0 r1 r3- add r0 r2 r3- restore 0 r1+ add 1 2 3+ add 0 0 1+ add 0 0 2+ add 0 1 1+ add 0 2 1 jump "B4" label "B3" $ do- add r1 r2 r3- move r3 r1+ add 1 2 3 jump "B4" label "B4" $ do- add r1 r1 r0+ add 3 3 0 return_ it "Another resolution case" $ asmTest 4@@ -422,41 +488,137 @@ jump "L6") $ do label "entry" $ do- lc r0- lc r1- lc r2- lc r3- save r3 0+ lc 0+ lc 1+ lc 2+ lc 3 jump "L3" label "L3" $ do- restore 8 r0- move r0 r3- save r0 8- move r3 r0- move r0 r3- move r3 r0- move r0 r3- lc r0- save r0 16- move r2 r0- save r2 24+ move 0 3+ move 3 0+ move 0 3+ move 3 0+ move 0 3+ lc 0+ move 2 0 jump "L6" label "L6" $- branch Zero r1 "L3" "L2"+ branch Zero 1 "L3" "L2" label "L2" $ do- lc r3- move r3 r2- move r0 r1- save r1 40- save r0 32- lc r3- restore 0 r1- move r1 r0- restore 40 r1- restore 32 r0- restore 24 r2- save r1 0+ lc 3+ move 3 2+ move 0 1+ lc 3+ move 1 0 jump "L6"++callTests :: SpecWith ()+callTests = do+ it "Spills all registers at call" $ asmTest 4+ (label "entry" $ do+ lc v0+ lc v1+ add v0 v1 v2+ add v2 v1 v3+ add v3 v2 v4+ add v4 v3 v5+ call 1000+ add v2 v3 v6+ add v4 v5 v7+ add v6 v7 v8+ add v8 v1 v0+ return_) $++ label "entry" $ do+ lc 0+ lc 1+ add 0 1 2+ add 2 1 3+ add 3 2 0+ save 1 0+ add 0 3 1+ save 2 32+ save 3 24+ save 0 16+ save 1 8+ call 1000+ restore 32 1+ restore 24 2+ add 1 2 0+ restore 16 2+ restore 8 3+ add 2 3 1+ add 0 1 0+ restore 0 1+ add 0 1 0+ return_++loopTests :: SpecWith ()+loopTests = do+ it "Correctly orders loop blocks" $ asmTest 4+ (do label "entry" $ do+ trace "B0"+ jump "B1"++ label "B1" $ do+ trace "B1"+ branch Zero v1 "B3" "B2"++ label "B2" $ do+ trace "B2"+ branch Zero v1 "B5" "B4"++ label "B3" $ do+ trace "B3"+ jump "B1"++ label "B4" $ do+ trace "B4"+ branch Zero v1 "B7" "B6"++ label "B5" $ do+ trace "B5"+ return_++ label "B6" $ do+ trace "B6"+ jump "B4"++ label "B7" $ do+ trace "B7"+ jump "B1") $++ do label "entry" $ do+ trace "B0"+ jump "B1"++ label "B1" $ do+ trace "B1"+ branch Zero 0 "B3" "B2"++ label "B2" $ do+ trace "B2"+ branch Zero 0 "B5" "B4"++ label "B3" $ do+ trace "B3"+ jump "B1"++ label "B4" $ do+ trace "B4"+ branch Zero 0 "B7" "B6"++ label "B5" $ do+ trace "B5"+ return_++ label "B6" $ do+ trace "B6"+ jump "B4"++ label "B7" $ do+ trace "B7"+ jump "B1"