X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocLinear.hs;h=c4a5a4a632574f6cdd7381861f8512e070dce1b5;hb=8480018a7f5f1cd961f3bd8ae758cc01910d5e6a;hp=323e1ff1df531ee9206721f0028ce46feb9283eb;hpb=c62b824e9e8808eb3845ddb1614494b0575eaafd;p=ghc-hetmet.git diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs index 323e1ff..c4a5a4a 100644 --- a/compiler/nativeGen/RegAllocLinear.hs +++ b/compiler/nativeGen/RegAllocLinear.hs @@ -432,10 +432,10 @@ raInsn block_live new_instrs (Instr instr (Just live)) Just loc -> setAssigR (addToUFM (delFromUFM assig src) dst loc) - -- we have elimianted this instruction - freeregs <- getFreeRegsR - assig <- getAssigR + -- we have eliminated this instruction {- + freeregs <- getFreeRegsR + assig <- getAssigR pprTrace "raInsn" (text "ELIMINATED: " <> docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do -} return (new_instrs, []) @@ -699,8 +699,11 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do -- to spill. We just pick the first one that isn't used in -- the current instruction for now. - let (temp_to_push_out, my_reg) = myHead "regalloc" candidates2 - + let (temp_to_push_out, my_reg) + = case candidates2 of + [] -> panic "RegAllocLinear.allocRegsAndSpill: no spill candidates" + (x:_) -> x + (spill_insn, slot) <- spillR (RealReg my_reg) temp_to_push_out let spill_store = (if reading then id else reverse) [ COMMENT (fsLit "spill alloc") @@ -741,9 +744,6 @@ loadTemp _ _ _ _ spills = return spills -myHead s [] = panic s -myHead _ (x:_) = x - -- ----------------------------------------------------------------------------- -- Joining a jump instruction to its targets