First pass at implementing info tables for CPS

[ghc-hetmet.git] / compiler / codeGen / CgUtils.hs

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 26857d3..13de213 100644 (file)
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -9,7 +9,9 @@
 module CgUtils (
        addIdReps,
        cgLit,
-       emitDataLits, emitRODataLits, emitIf, emitIfThenElse,
+       emitDataLits, mkDataLits,
+        emitRODataLits, mkRODataLits,
+        emitIf, emitIfThenElse,
        emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
        assignNonPtrTemp, newNonPtrTemp,
        assignPtrTemp, newPtrTemp,
@@ -309,6 +311,11 @@ emitDataLits :: CLabel -> [CmmLit] -> Code
 emitDataLits lbl lits
   = emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
 
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+-- Emit a data-segment data block
+mkDataLits lbl lits
+  = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
+
 emitRODataLits :: CLabel -> [CmmLit] -> Code
 -- Emit a read-only data block
 emitRODataLits lbl lits
@@ -319,6 +326,15 @@ emitRODataLits lbl lits
         needsRelocation (CmmLabelOff _ _) = True
         needsRelocation _                 = False
 
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkRODataLits lbl lits
+  = CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
+  where section | any needsRelocation lits = RelocatableReadOnlyData
+                | otherwise                = ReadOnlyData
+        needsRelocation (CmmLabel _)      = True
+        needsRelocation (CmmLabelOff _ _) = True
+        needsRelocation _                 = False
+
 mkStringCLit :: String -> FCode CmmLit
 -- Make a global definition for the string,
 -- and return its label