X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FAsmCodeGen.lhs;h=1cbdb7b98a8b785538fa03932aa104339db081c9;hb=f83010b119096699d1efef2f7bb45460719c48f9;hp=f7b757005f91578997636ec43710372ee7a25f68;hpb=22bbcd1dcd94851b8f9409310cf95f3b9332850c;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index f7b7570..1cbdb7b 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -26,16 +26,12 @@ import CmmOpt		( cmmMiniInline, cmmMachOpFold )
 import PprCmm		( pprStmt, pprCmms )
 import MachOp
 import CLabel
-#if powerpc_TARGET_ARCH
-import CLabel           ( mkRtsCodeLabel )
-#endif
 
 import UniqFM
 import Unique		( Unique, getUnique )
 import UniqSupply
 import FastTypes
 import List		( groupBy, sortBy )
-import CLabel           ( pprCLabel )
 import ErrUtils		( dumpIfSet_dyn )
 import DynFlags
 import StaticFlags	( opt_Static, opt_PIC )
@@ -112,12 +108,12 @@ The machine-dependent bits break down as follows:
 
 -- NB. We *lazilly* compile each block of code for space reasons.
 
-nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc
+nativeCodeGen :: DynFlags -> [RawCmm] -> UniqSupply -> IO Pretty.Doc
 nativeCodeGen dflags cmms us
   = let (res, _) = initUs us $
 	   cgCmm (concat (map add_split cmms))
 
-	cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel])
+	cgCmm :: [RawCmmTop] -> UniqSM (RawCmm, Pretty.Doc, [CLabel])
 	cgCmm tops = 
 	   lazyMapUs (cmmNativeGen dflags) tops  `thenUs` \ results -> 
 	   case unzip3 results of { (cmms,docs,imps) ->
@@ -200,7 +196,7 @@ nativeCodeGen dflags cmms us
 -- Complete native code generation phase for a single top-level chunk
 -- of Cmm.
 
-cmmNativeGen :: DynFlags -> CmmTop -> UniqSM (CmmTop, Pretty.Doc, [CLabel])
+cmmNativeGen :: DynFlags -> RawCmmTop -> UniqSM (RawCmmTop, Pretty.Doc, [CLabel])
 cmmNativeGen dflags cmm
    = {-# SCC "fixAssigns"       #-} 
  	fixAssignsTop cmm	     `thenUs` \ fixed_cmm ->
@@ -344,7 +340,7 @@ shortcutBranches dflags tops
     mapping = foldr plusUFM emptyUFM mappings
 
 build_mapping top@(CmmData _ _) = (top, emptyUFM)
-build_mapping (CmmProc info lbl params []) $
+build_mapping (CmmProc info lbl params [])
   = (CmmProc info lbl params [], emptyUFM)
 build_mapping (CmmProc info lbl params (head:blocks))
   = (CmmProc info lbl params (head:others), mapping)
@@ -394,13 +390,12 @@ apply_mapping ufm (CmmProc info lbl params blocks)
 -- Switching between the two monads whilst carrying along the same
 -- Unique supply breaks abstraction.  Is that bad?
 
-genMachCode :: CmmTop -> UniqSM ([NatCmmTop], [CLabel])
+genMachCode :: RawCmmTop -> UniqSM ([NatCmmTop], [CLabel])
 
 genMachCode cmm_top
   = do	{ initial_us <- getUs
 	; let initial_st           = mkNatM_State initial_us 0
 	      (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
-	      final_us             = natm_us final_st
 	      final_delta          = natm_delta final_st
 	      final_imports        = natm_imports final_st
 	; if   final_delta == 0
@@ -416,7 +411,7 @@ genMachCode cmm_top
 -- the generic optimiser below, to avoid having two separate passes
 -- over the Cmm.
 
-fixAssignsTop :: CmmTop -> UniqSM CmmTop
+fixAssignsTop :: RawCmmTop -> UniqSM RawCmmTop
 fixAssignsTop top@(CmmData _ _) = returnUs top
 fixAssignsTop (CmmProc info lbl params blocks) =
   mapUs fixAssignsBlock blocks `thenUs` \ blocks' ->
@@ -433,9 +428,6 @@ fixAssigns stmts =
   returnUs (concat stmtss)
 
 fixAssign :: CmmStmt -> UniqSM [CmmStmt]
-fixAssign (CmmAssign (CmmGlobal BaseReg) src)
-   = panic "cmmStmtConFold: assignment to BaseReg";
-
 fixAssign (CmmAssign (CmmGlobal reg) src)
   | Left  realreg <- reg_or_addr
   = returnUs [CmmAssign (CmmGlobal reg) src]
@@ -448,27 +440,6 @@ fixAssign (CmmAssign (CmmGlobal reg) src)
   where
 	reg_or_addr = get_GlobalReg_reg_or_addr reg
 
-fixAssign (CmmCall target results args vols)
-  = mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
-    returnUs (caller_save ++
-	      CmmCall target results' args vols :
-	      caller_restore ++
-	      concat stores)
-  where
-	-- we also save/restore any caller-saves STG registers here
-	(caller_save, caller_restore) = callerSaveVolatileRegs vols
-
-	fixResult g@(CmmGlobal reg,hint) = 
-	  case get_GlobalReg_reg_or_addr reg of
-		Left realreg -> returnUs (g, [])
-		Right baseRegAddr ->
-		    getUniqueUs `thenUs` \ uq ->
-		    let local = CmmLocal (LocalReg uq (globalRegRep reg)) in
-		    returnUs ((local,hint), 
-			      [CmmStore baseRegAddr (CmmReg local)])
-	fixResult other =
-	  returnUs (other,[])
-
 fixAssign other_stmt = returnUs [other_stmt]
 
 -- -----------------------------------------------------------------------------
@@ -497,7 +468,7 @@ Ideas for other things we could do (ToDo):
     temp assignments, and certain assigns to mem...)
 -}
 
-cmmToCmm :: CmmTop -> (CmmTop, [CLabel])
+cmmToCmm :: RawCmmTop -> (RawCmmTop, [CLabel])
 cmmToCmm top@(CmmData _ _) = (top, [])
 cmmToCmm (CmmProc info lbl params blocks) = runCmmOpt $ do
   blocks' <- mapM cmmBlockConFold (cmmMiniInline blocks)
@@ -543,7 +514,7 @@ cmmStmtConFold stmt
            -> do addr' <- cmmExprConFold JumpReference addr
                  return $ CmmJump addr' regs
 
-	CmmCall target regs args vols
+	CmmCall target regs args srt
 	   -> do target' <- case target of
 			      CmmForeignCall e conv -> do
 			        e' <- cmmExprConFold CallReference e
@@ -552,7 +523,7 @@ cmmStmtConFold stmt
                  args' <- mapM (\(arg, hint) -> do
                                   arg' <- cmmExprConFold DataReference arg
                                   return (arg', hint)) args
-	         return $ CmmCall target' regs args' vols
+	         return $ CmmCall target' regs args' srt
 
         CmmCondBranch test dest
            -> do test' <- cmmExprConFold DataReference test