NCG: Split linear allocator into separate modules.
[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Linear / StackMap.hs
diff --git a/compiler/nativeGen/RegAlloc/Linear/StackMap.hs b/compiler/nativeGen/RegAlloc/Linear/StackMap.hs
new file mode 100644 (file)
index 0000000..56382aa
--- /dev/null
@@ -0,0 +1,72 @@
+
+-- | The assignment of virtual registers to stack slots
+
+--     We have lots of stack slots. Memory-to-memory moves are a pain on most
+--     architectures. Therefore, we avoid having to generate memory-to-memory moves
+--     by simply giving every virtual register its own stack slot.
+
+--     The StackMap stack map keeps track of virtual register - stack slot
+--     associations and of which stack slots are still free. Once it has been
+--     associated, a stack slot is never "freed" or removed from the StackMap again,
+--     it remains associated until we are done with the current CmmProc.
+--
+module RegAlloc.Linear.StackMap (
+       StackSlot,
+       StackMap(..),
+       emptyStackMap,
+       getStackSlotFor
+)
+
+where
+
+import RegAllocInfo    (maxSpillSlots)
+
+import Outputable
+import UniqFM
+import Unique
+
+
+-- | Identifier for a stack slot.
+type StackSlot = Int
+
+data StackMap 
+       = StackMap 
+
+       -- | The slots that are still available to be allocated.
+       { stackMapFreeSlots     :: [StackSlot]
+
+       -- | Assignment of vregs to stack slots.
+       , stackMapAssignment    :: UniqFM StackSlot }
+
+
+-- | An empty stack map, with all slots available.
+emptyStackMap :: StackMap
+emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
+
+
+-- | If this vreg unique already has a stack assignment then return the slot number,
+--     otherwise allocate a new slot, and update the map.
+--
+getStackSlotFor :: StackMap -> Unique -> (StackMap, Int)
+
+getStackSlotFor (StackMap [] _) _
+
+        -- This happens all the time when trying to compile darcs' SHA1.hs, see Track #1993
+       --      SHA1.lhs has also been added to the Crypto library on Hackage,
+       --      so we see this all the time.  
+       --
+       -- It would be better to automatically invoke the graph allocator, or do something
+       --      else besides panicing, but that's a job for a different day.  -- BL 2009/02
+       --
+       = panic $   "RegAllocLinear.getStackSlotFor: out of stack slots\n"
+               ++  "   If you are trying to compile SHA1.hs from the crypto library then this\n"
+               ++  "   is a known limitation in the linear allocator.\n"
+               ++  "\n"
+               ++  "   Try enabling the graph colouring allocator with -fregs-graph instead."
+               ++  "   You can still file a bug report if you like.\n"
+               
+getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
+    case lookupUFM reserved reg of
+       Just slot       -> (fs, slot)
+       Nothing         -> (StackMap stack' (addToUFM reserved reg freeSlot), freeSlot)
+