More CPP removal: pprDynamicLinkerAsmLabel in CLabel

And some knock-on changes

compiler/cmm/CLabel.hs

@@ -263,23 +263,23 @@ data ForeignLabelSource
 --	We can't make a Show instance for CLabel because lots of its components don't have instances.
 --	The regular Outputable instance only shows the label name, and not its other info.
 --
-pprDebugCLabel :: CLabel -> SDoc
-pprDebugCLabel lbl
+pprDebugCLabel :: Platform -> CLabel -> SDoc
+pprDebugCLabel platform lbl
  = case lbl of
- 	IdLabel{}	-> ppr lbl <> (parens $ text "IdLabel")
+ 	IdLabel{}	-> pprPlatform platform lbl <> (parens $ text "IdLabel")
 	CmmLabel pkg name _info	
-	 -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
+	 -> pprPlatform platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 
-	RtsLabel{}	-> ppr lbl <> (parens $ text "RtsLabel")
+	RtsLabel{}	-> pprPlatform platform lbl <> (parens $ text "RtsLabel")
 
 	ForeignLabel name mSuffix src funOrData
-	 -> ppr lbl <> (parens 
+	 -> pprPlatform platform lbl <> (parens 
 	 			$ text "ForeignLabel" 
 	 			<+> ppr mSuffix
 				<+> ppr src  
 				<+> ppr funOrData)
 
-	_		-> ppr lbl <> (parens $ text "other CLabel)")
+	_		-> pprPlatform platform lbl <> (parens $ text "other CLabel)")
 
 
 -- True if a local IdLabel that we won't mark as exported
@@ -509,38 +509,38 @@ mkPlainModuleInitLabel mod	= PlainModuleInitLabel mod
 -- -----------------------------------------------------------------------------
 -- Convert between different kinds of label
 
-toClosureLbl :: CLabel -> CLabel
-toClosureLbl (IdLabel n c _) = IdLabel n c Closure
-toClosureLbl l = pprPanic "toClosureLbl" (pprCLabel l)
-
-toSlowEntryLbl :: CLabel -> CLabel
-toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
-toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (pprCLabel l)
-
-toRednCountsLbl :: CLabel -> CLabel
-toRednCountsLbl (IdLabel n c _) = IdLabel n c RednCounts
-toRednCountsLbl l = pprPanic "toRednCountsLbl" (pprCLabel l)
-
-toEntryLbl :: CLabel -> CLabel
-toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
-toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
-toEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
-toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
-toEntryLbl (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
-toEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
-toEntryLbl (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
-toEntryLbl l = pprPanic "toEntryLbl" (pprCLabel l)
-
-toInfoLbl :: CLabel -> CLabel
-toInfoLbl (IdLabel n c Entry)          = IdLabel n c InfoTable
-toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
-toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
-toInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
-toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
-toInfoLbl (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
-toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
-toInfoLbl (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
-toInfoLbl l = pprPanic "CLabel.toInfoLbl" (pprCLabel l)
+toClosureLbl :: Platform -> CLabel -> CLabel
+toClosureLbl _ (IdLabel n c _) = IdLabel n c Closure
+toClosureLbl platform l = pprPanic "toClosureLbl" (pprCLabel platform l)
+
+toSlowEntryLbl :: Platform -> CLabel -> CLabel
+toSlowEntryLbl _ (IdLabel n c _) = IdLabel n c Slow
+toSlowEntryLbl platform l = pprPanic "toSlowEntryLbl" (pprCLabel platform l)
+
+toRednCountsLbl :: Platform -> CLabel -> CLabel
+toRednCountsLbl _ (IdLabel n c _) = IdLabel n c RednCounts
+toRednCountsLbl platform l = pprPanic "toRednCountsLbl" (pprCLabel platform l)
+
+toEntryLbl :: Platform -> CLabel -> CLabel
+toEntryLbl _ (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
+toEntryLbl _ (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
+toEntryLbl _ (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
+toEntryLbl _ (IdLabel n c _)               = IdLabel n c Entry
+toEntryLbl _ (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
+toEntryLbl _ (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
+toEntryLbl _ (CmmLabel m str CmmRetInfo)   = CmmLabel m str CmmRet
+toEntryLbl platform l = pprPanic "toEntryLbl" (pprCLabel platform l)
+
+toInfoLbl :: Platform -> CLabel -> CLabel
+toInfoLbl _ (IdLabel n c Entry)          = IdLabel n c InfoTable
+toInfoLbl _ (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
+toInfoLbl _ (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
+toInfoLbl _ (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
+toInfoLbl _ (IdLabel n c _)              = IdLabel n c InfoTable
+toInfoLbl _ (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
+toInfoLbl _ (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
+toInfoLbl _ (CmmLabel m str CmmRet)      = CmmLabel m str CmmRetInfo
+toInfoLbl platform l = pprPanic "CLabel.toInfoLbl" (pprCLabel platform l)
 
 -- -----------------------------------------------------------------------------
 -- Does a CLabel refer to a CAF?
@@ -891,14 +891,12 @@ Not exporting these Just_info labels reduces the number of symbols
 somewhat.
 -}
 
-instance Outputable CLabel where
-  ppr = pprCLabel
 instance PlatformOutputable CLabel where
-  pprPlatform _ = pprCLabel
+  pprPlatform = pprCLabel
 
-pprCLabel :: CLabel -> SDoc
+pprCLabel :: Platform -> CLabel -> SDoc
 
-pprCLabel (AsmTempLabel u)
+pprCLabel _ (AsmTempLabel u)
  | cGhcWithNativeCodeGen == "YES"
   =  getPprStyle $ \ sty ->
      if asmStyle sty then 
@@ -906,19 +904,19 @@ pprCLabel (AsmTempLabel u)
      else
 	char '_' <> pprUnique u
 
-pprCLabel (DynamicLinkerLabel info lbl)
+pprCLabel platform (DynamicLinkerLabel info lbl)
  | cGhcWithNativeCodeGen == "YES"
-   = pprDynamicLinkerAsmLabel info lbl
+   = pprDynamicLinkerAsmLabel platform info lbl
    
-pprCLabel PicBaseLabel
+pprCLabel _ PicBaseLabel
  | cGhcWithNativeCodeGen == "YES"
    = ptext (sLit "1b")
    
-pprCLabel (DeadStripPreventer lbl)
+pprCLabel platform (DeadStripPreventer lbl)
  | cGhcWithNativeCodeGen == "YES"
-   = pprCLabel lbl <> ptext (sLit "_dsp")
+   = pprCLabel platform lbl <> ptext (sLit "_dsp")
 
-pprCLabel lbl
+pprCLabel _ lbl
    = getPprStyle $ \ sty ->
      if cGhcWithNativeCodeGen == "YES" && asmStyle sty
      then maybe_underscore (pprAsmCLbl lbl)
@@ -1072,63 +1070,40 @@ asmTempLabelPrefix =
      (sLit ".L")
 #endif
 
-pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
+pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> CLabel -> SDoc
+pprDynamicLinkerAsmLabel platform dllInfo lbl
+ = if platform == Platform ArchX86_64 OSDarwin
+   then case dllInfo of
+        CodeStub        -> char 'L' <> pprCLabel platform lbl <> text "$stub"
+        SymbolPtr       -> char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr"
+        GotSymbolPtr    -> pprCLabel platform lbl <> text "@GOTPCREL"
+        GotSymbolOffset -> pprCLabel platform lbl
+        _               -> panic "pprDynamicLinkerAsmLabel"
+   else if platformOS platform == OSDarwin
+   then case dllInfo of
+        CodeStub  -> char 'L' <> pprCLabel platform lbl <> text "$stub"
+        SymbolPtr -> char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr"
+        _         -> panic "pprDynamicLinkerAsmLabel"
+   else if platformArch platform == ArchPPC && osElfTarget (platformOS platform)
+   then case dllInfo of
+        CodeStub  -> pprCLabel platform lbl <> text "@plt"
+        SymbolPtr -> text ".LC_" <> pprCLabel platform lbl
+        _         -> panic "pprDynamicLinkerAsmLabel"
+   else if platformArch platform == ArchX86_64 && osElfTarget (platformOS platform)
+   then case dllInfo of
+        CodeStub        -> pprCLabel platform lbl <> text "@plt"
+        GotSymbolPtr    -> pprCLabel platform lbl <> text "@gotpcrel"
+        GotSymbolOffset -> pprCLabel platform lbl
+        SymbolPtr       -> text ".LC_" <> pprCLabel platform lbl
+   else if osElfTarget (platformOS platform)
+   then case dllInfo of
+        CodeStub        -> pprCLabel platform lbl <> text "@plt"
+        SymbolPtr       -> text ".LC_" <> pprCLabel platform lbl
+        GotSymbolPtr    -> pprCLabel platform lbl <> text "@got"
+        GotSymbolOffset -> pprCLabel platform lbl <> text "@gotoff"
+   else if platformOS platform == OSMinGW32
+   then case dllInfo of
+        SymbolPtr -> text "__imp_" <> pprCLabel platform lbl
+        _         -> panic "pprDynamicLinkerAsmLabel"
+   else panic "pprDynamicLinkerAsmLabel"
 
-#if x86_64_TARGET_ARCH && darwin_TARGET_OS
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = char 'L' <> pprCLabel lbl <> text "$stub"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@GOTPCREL"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#elif darwin_TARGET_OS
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = char 'L' <> pprCLabel lbl <> text "$stub"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#elif powerpc_TARGET_ARCH && elf_OBJ_FORMAT
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#elif x86_64_TARGET_ARCH && elf_OBJ_FORMAT
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@gotpcrel"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-
-#elif elf_OBJ_FORMAT
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@got"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl <> text "@gotoff"
-
-#elif mingw32_TARGET_OS
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text "__imp_" <> pprCLabel lbl
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-
-#else
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
-#endif

compiler/cmm/CmmBuildInfoTables.hs

@@ -44,6 +44,7 @@ import Control.Monad
 import Name
 import OptimizationFuel
 import Outputable
+import Platform
 import SMRep
 import UniqSupply
 
@@ -193,8 +194,8 @@ cafLattice = DataflowLattice "live cafs" Map.empty add
   where add _ (OldFact old) (NewFact new) = case old `Map.union` new of
                                               new' -> (changeIf $ Map.size new' > Map.size old, new')
 
-cafTransfers :: BwdTransfer CmmNode CAFSet
-cafTransfers = mkBTransfer3 first middle last
+cafTransfers :: Platform -> BwdTransfer CmmNode CAFSet
+cafTransfers platform = mkBTransfer3 first middle last
   where first  _ live = live
         middle m live = foldExpDeep addCaf m live
         last   l live = foldExpDeep addCaf l (joinOutFacts cafLattice l live)
@@ -203,10 +204,12 @@ cafTransfers = mkBTransfer3 first middle last
                CmmLit (CmmLabelOff c _)         -> add c set
                CmmLit (CmmLabelDiffOff c1 c2 _) -> add c1 $ add c2 set
                _ -> set
-        add l s = if hasCAF l then Map.insert (toClosureLbl l) () s else s
+        add l s = if hasCAF l then Map.insert (toClosureLbl platform l) () s
+                              else s
 
-cafAnal :: CmmGraph -> FuelUniqSM CAFEnv
-cafAnal g = liftM snd $ dataflowPassBwd g [] $ analBwd cafLattice cafTransfers
+cafAnal :: Platform -> CmmGraph -> FuelUniqSM CAFEnv
+cafAnal platform g
+    = liftM snd $ dataflowPassBwd g [] $ analBwd cafLattice (cafTransfers platform)
 
 -----------------------------------------------------------------------
 -- Building the SRTs
@@ -218,9 +221,12 @@ data TopSRT = TopSRT { lbl      :: CLabel
                      , rev_elts :: [CLabel]
                      , elt_map  :: Map CLabel Int }
                         -- map: CLabel -> its last entry in the table
-instance Outputable TopSRT where
-  ppr (TopSRT lbl next elts eltmap) =
-    text "TopSRT:" <+> ppr lbl <+> ppr next <+> ppr elts <+> ppr eltmap
+instance PlatformOutputable TopSRT where
+  pprPlatform platform (TopSRT lbl next elts eltmap) =
+    text "TopSRT:" <+> pprPlatform platform lbl
+                   <+> ppr next
+                   <+> pprPlatform platform elts
+                   <+> pprPlatform platform eltmap
 
 emptySRT :: MonadUnique m => m TopSRT
 emptySRT =
@@ -335,13 +341,13 @@ to_SRT top_srt off len bmp
 --  keep its CAFs live.)
 -- Any procedure referring to a non-static CAF c must keep live
 -- any CAF that is reachable from c.
-localCAFInfo :: CAFEnv -> CmmDecl -> Maybe (CLabel, CAFSet)
-localCAFInfo _      (CmmData _ _) = Nothing
-localCAFInfo cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
+localCAFInfo :: Platform -> CAFEnv -> CmmDecl -> Maybe (CLabel, CAFSet)
+localCAFInfo _        _      (CmmData _ _) = Nothing
+localCAFInfo platform cafEnv (CmmProc top_info top_l (CmmGraph {g_entry=entry})) =
   case info_tbl top_info of
     CmmInfoTable { cit_rep = rep } 
       | not (isStaticRep rep) 
-      -> Just (toClosureLbl top_l,
+      -> Just (toClosureLbl platform top_l,
                expectJust "maybeBindCAFs" $ mapLookup entry cafEnv)
     _ -> Nothing
 

compiler/cmm/CmmInfo.hs

@@ -16,6 +16,7 @@ import Bitmap
 import Maybes
 import Constants
 import Panic
+import Platform
 import StaticFlags
 import UniqSupply
 import MonadUtils
@@ -30,10 +31,10 @@ mkEmptyContInfoTable info_lbl
                  , cit_prof = NoProfilingInfo
                  , cit_srt  = NoC_SRT }
 
-cmmToRawCmm :: [Old.CmmGroup] -> IO [Old.RawCmmGroup]
-cmmToRawCmm cmms
+cmmToRawCmm :: Platform -> [Old.CmmGroup] -> IO [Old.RawCmmGroup]
+cmmToRawCmm platform cmms
   = do { uniqs <- mkSplitUniqSupply 'i'
-       ; return (initUs_ uniqs (mapM (concatMapM mkInfoTable) cmms)) }
+       ; return (initUs_ uniqs (mapM (concatMapM (mkInfoTable platform)) cmms)) }
 
 -- Make a concrete info table, represented as a list of CmmStatic
 -- (it can't be simply a list of Word, because the SRT field is
@@ -68,16 +69,16 @@ cmmToRawCmm cmms
 --
 --  * The SRT slot is only there if there is SRT info to record
 
-mkInfoTable :: CmmDecl -> UniqSM [RawCmmDecl]
-mkInfoTable (CmmData sec dat) 
+mkInfoTable :: Platform -> CmmDecl -> UniqSM [RawCmmDecl]
+mkInfoTable _ (CmmData sec dat) 
   = return [CmmData sec dat]
 
-mkInfoTable (CmmProc (CmmInfo _ _ info) entry_label blocks)
+mkInfoTable platform (CmmProc (CmmInfo _ _ info) entry_label blocks)
   | CmmNonInfoTable <- info   -- Code without an info table.  Easy.
   = return [CmmProc Nothing entry_label blocks]
                                
   | CmmInfoTable { cit_lbl = info_lbl } <- info
-  = do { (top_decls, info_cts) <- mkInfoTableContents info Nothing
+  = do { (top_decls, info_cts) <- mkInfoTableContents platform info Nothing
        ; return (top_decls  ++
                  mkInfoTableAndCode info_lbl info_cts
                                     entry_label blocks) }
@@ -88,18 +89,20 @@ type InfoTableContents = ( [CmmLit]	     -- The standard part
                          , [CmmLit] )	     -- The "extra bits"
 -- These Lits have *not* had mkRelativeTo applied to them
 
-mkInfoTableContents :: CmmInfoTable
+mkInfoTableContents :: Platform
+                    -> CmmInfoTable
                     -> Maybe StgHalfWord    -- Override default RTS type tag?
                     -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
                                InfoTableContents)	-- Info tbl + extra bits
 
-mkInfoTableContents info@(CmmInfoTable { cit_lbl  = info_lbl
+mkInfoTableContents platform
+                    info@(CmmInfoTable { cit_lbl  = info_lbl
                                        , cit_rep  = smrep
                                        , cit_prof = prof
                                        , cit_srt = srt }) 
                     mb_rts_tag
   | RTSRep rts_tag rep <- smrep
-  = mkInfoTableContents info{cit_rep = rep} (Just rts_tag)
+  = mkInfoTableContents platform info{cit_rep = rep} (Just rts_tag)
     -- Completely override the rts_tag that mkInfoTableContents would
     -- otherwise compute, with the rts_tag stored in the RTSRep
     -- (which in turn came from a handwritten .cmm file)
@@ -156,7 +159,7 @@ mkInfoTableContents info@(CmmInfoTable { cit_lbl  = info_lbl
                               , srt_lit, liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
       where
-        slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
+        slow_entry = CmmLabel (toSlowEntryLbl platform info_lbl)
         srt_lit = case srt_label of
                     []          -> mkIntCLit 0
                     (lit:_rest) -> ASSERT( null _rest ) lit
@@ -164,7 +167,7 @@ mkInfoTableContents info@(CmmInfoTable { cit_lbl  = info_lbl
     mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
 
 
-mkInfoTableContents _ _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
+mkInfoTableContents _ _ _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
 
 mkSRTLit :: C_SRT
          -> ([CmmLit],    -- srt_label, if any

compiler/cmm/CmmLint.hs

@@ -30,13 +30,13 @@ import Data.Maybe
 -- -----------------------------------------------------------------------------
 -- Exported entry points:
 
-cmmLint :: (Outputable d, Outputable h)
+cmmLint :: (PlatformOutputable d, PlatformOutputable h)
         => Platform -> GenCmmGroup d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops
+cmmLint platform tops = runCmmLint platform (mapM_ (lintCmmDecl platform)) tops
 
-cmmLintTop :: (Outputable d, Outputable h)
+cmmLintTop :: (PlatformOutputable d, PlatformOutputable h)
            => Platform -> GenCmmDecl d h (ListGraph CmmStmt) -> Maybe SDoc
-cmmLintTop platform top = runCmmLint platform lintCmmDecl top
+cmmLintTop platform top = runCmmLint platform (lintCmmDecl platform) top
 
 runCmmLint :: PlatformOutputable a
            => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
@@ -48,19 +48,19 @@ runCmmLint platform l p =
                            nest 2 (pprPlatform platform p)])
    Right _  -> Nothing
 
-lintCmmDecl :: (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint ()
-lintCmmDecl (CmmProc _ lbl (ListGraph blocks))
-  = addLintInfo (text "in proc " <> pprCLabel lbl) $
+lintCmmDecl :: Platform -> (GenCmmDecl h i (ListGraph CmmStmt)) -> CmmLint ()
+lintCmmDecl platform (CmmProc _ lbl (ListGraph blocks))
+  = addLintInfo (text "in proc " <> pprCLabel platform lbl) $
         let labels = foldl (\s b -> setInsert (blockId b) s) setEmpty blocks
-	in  mapM_ (lintCmmBlock labels) blocks
+	in  mapM_ (lintCmmBlock platform labels) blocks
 
-lintCmmDecl (CmmData {})
+lintCmmDecl _ (CmmData {})
   = return ()
 
-lintCmmBlock :: BlockSet -> GenBasicBlock CmmStmt -> CmmLint ()
-lintCmmBlock labels (BasicBlock id stmts)
+lintCmmBlock :: Platform -> BlockSet -> GenBasicBlock CmmStmt -> CmmLint ()
+lintCmmBlock platform labels (BasicBlock id stmts)
   = addLintInfo (text "in basic block " <> ppr id) $
-	mapM_ (lintCmmStmt labels) stmts
+	mapM_ (lintCmmStmt platform labels) stmts
 
 -- -----------------------------------------------------------------------------
 -- lintCmmExpr
@@ -68,24 +68,24 @@ lintCmmBlock labels (BasicBlock id stmts)
 -- Checks whether a CmmExpr is "type-correct", and check for obvious-looking
 -- byte/word mismatches.
 
-lintCmmExpr :: CmmExpr -> CmmLint CmmType
-lintCmmExpr (CmmLoad expr rep) = do
-  _ <- lintCmmExpr expr
+lintCmmExpr :: Platform -> CmmExpr -> CmmLint CmmType
+lintCmmExpr platform (CmmLoad expr rep) = do
+  _ <- lintCmmExpr platform expr
   -- Disabled, if we have the inlining phase before the lint phase,
   -- we can have funny offsets due to pointer tagging. -- EZY
   -- when (widthInBytes (typeWidth rep) >= wORD_SIZE) $
   --   cmmCheckWordAddress expr
   return rep
-lintCmmExpr expr@(CmmMachOp op args) = do
-  tys <- mapM lintCmmExpr args
+lintCmmExpr platform expr@(CmmMachOp op args) = do
+  tys <- mapM (lintCmmExpr platform) args
   if map (typeWidth . cmmExprType) args == machOpArgReps op
   	then cmmCheckMachOp op args tys
-	else cmmLintMachOpErr expr (map cmmExprType args) (machOpArgReps op)
-lintCmmExpr (CmmRegOff reg offset)
-  = lintCmmExpr (CmmMachOp (MO_Add rep)
+	else cmmLintMachOpErr platform expr (map cmmExprType args) (machOpArgReps op)
+lintCmmExpr platform (CmmRegOff reg offset)
+  = lintCmmExpr platform (CmmMachOp (MO_Add rep)
 		[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
   where rep = typeWidth (cmmRegType reg)
-lintCmmExpr expr = 
+lintCmmExpr _ expr =
   return (cmmExprType expr)
 
 -- Check for some common byte/word mismatches (eg. Sp + 1)
@@ -102,14 +102,14 @@ isOffsetOp _ = False
 
 -- This expression should be an address from which a word can be loaded:
 -- check for funny-looking sub-word offsets.
-_cmmCheckWordAddress :: CmmExpr -> CmmLint ()
-_cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
+_cmmCheckWordAddress :: Platform -> CmmExpr -> CmmLint ()
+_cmmCheckWordAddress platform e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
   | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset e
-_cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
+  = cmmLintDubiousWordOffset platform e
+_cmmCheckWordAddress platform e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
   | isOffsetOp op && notNodeReg arg && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset e
-_cmmCheckWordAddress _
+  = cmmLintDubiousWordOffset platform e
+_cmmCheckWordAddress _ _
   = return ()
 
 -- No warnings for unaligned arithmetic with the node register,
@@ -118,46 +118,47 @@ notNodeReg :: CmmExpr -> Bool
 notNodeReg (CmmReg reg) | reg == nodeReg = False
 notNodeReg _                             = True
 
-lintCmmStmt :: BlockSet -> CmmStmt -> CmmLint ()
-lintCmmStmt labels = lint
+lintCmmStmt :: Platform -> BlockSet -> CmmStmt -> CmmLint ()
+lintCmmStmt platform labels = lint
     where lint (CmmNop) = return ()
           lint (CmmComment {}) = return ()
           lint stmt@(CmmAssign reg expr) = do
-            erep <- lintCmmExpr expr
+            erep <- lintCmmExpr platform expr
 	    let reg_ty = cmmRegType reg
             if (erep `cmmEqType_ignoring_ptrhood` reg_ty)
                 then return ()
-                else cmmLintAssignErr stmt erep reg_ty
+                else cmmLintAssignErr platform stmt erep reg_ty
           lint (CmmStore l r) = do
-            _ <- lintCmmExpr l
-            _ <- lintCmmExpr r
+            _ <- lintCmmExpr platform l
+            _ <- lintCmmExpr platform r
             return ()
           lint (CmmCall target _res args _ _) =
-              lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args
-          lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr e >> checkCond e
+              lintTarget platform target >> mapM_ (lintCmmExpr platform . hintlessCmm) args
+          lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr platform e >> checkCond platform e
           lint (CmmSwitch e branches) = do
             mapM_ checkTarget $ catMaybes branches
-            erep <- lintCmmExpr e
+            erep <- lintCmmExpr platform e
             if (erep `cmmEqType_ignoring_ptrhood` bWord)
               then return ()
-              else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e <>
+              else cmmLintErr (text "switch scrutinee is not a word: " <> pprPlatform platform e <>
                                text " :: " <> ppr erep)
-          lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . hintlessCmm) args
-          lint (CmmReturn ress) = mapM_ (lintCmmExpr . hintlessCmm) ress
+          lint (CmmJump e args) = lintCmmExpr platform e >> mapM_ (lintCmmExpr platform . hintlessCmm) args
+          lint (CmmReturn ress) = mapM_ (lintCmmExpr platform . hintlessCmm) ress
           lint (CmmBranch id)    = checkTarget id
           checkTarget id = if setMember id labels then return ()
                            else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
 
-lintTarget :: CmmCallTarget -> CmmLint ()
-lintTarget (CmmCallee e _) = lintCmmExpr e >> return ()
-lintTarget (CmmPrim {})    = return ()
+lintTarget :: Platform -> CmmCallTarget -> CmmLint ()
+lintTarget platform (CmmCallee e _) = lintCmmExpr platform e >> return ()
+lintTarget _        (CmmPrim {})    = return ()
 
 
-checkCond :: CmmExpr -> CmmLint ()
-checkCond (CmmMachOp mop _) | isComparisonMachOp mop = return ()
-checkCond (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
-checkCond expr = cmmLintErr (hang (text "expression is not a conditional:") 2
-				    (ppr expr))
+checkCond :: Platform -> CmmExpr -> CmmLint ()
+checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
+checkCond _ (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth = return () -- constant values
+checkCond platform expr
+    = cmmLintErr (hang (text "expression is not a conditional:") 2
+                       (pprPlatform platform expr))
 
 -- -----------------------------------------------------------------------------
 -- CmmLint monad
@@ -181,23 +182,23 @@ addLintInfo info thing = CmmLint $
 	Left err -> Left (hang info 2 err)
 	Right a  -> Right a
 
-cmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a
-cmmLintMachOpErr expr argsRep opExpectsRep
+cmmLintMachOpErr :: Platform -> CmmExpr -> [CmmType] -> [Width] -> CmmLint a
+cmmLintMachOpErr platform expr argsRep opExpectsRep
      = cmmLintErr (text "in MachOp application: " $$ 
-					nest 2 (ppr expr) $$
+					nest 2 (pprPlatform platform expr) $$
 				        (text "op is expecting: " <+> ppr opExpectsRep) $$
 					(text "arguments provide: " <+> ppr argsRep))
 
-cmmLintAssignErr :: CmmStmt -> CmmType -> CmmType -> CmmLint a
-cmmLintAssignErr stmt e_ty r_ty
+cmmLintAssignErr :: Platform -> CmmStmt -> CmmType -> CmmType -> CmmLint a
+cmmLintAssignErr platform stmt e_ty r_ty
   = cmmLintErr (text "in assignment: " $$ 
-		nest 2 (vcat [ppr stmt, 
+		nest 2 (vcat [pprPlatform platform stmt, 
 			      text "Reg ty:" <+> ppr r_ty,
 			      text "Rhs ty:" <+> ppr e_ty]))
 			 
 					
 
-cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
-cmmLintDubiousWordOffset expr