Fixes for the unreg build

* Fix code output order when printing C so things are defined before
  they are used.
* Generate _ret rather than _entry functions for INFO_TABLE_RET.
* Use "ASSIGN_BaseReg" rather than "BaseReg =".

6 files changed, 43 insertions, 32 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index ffca61d0a0..3585bde0fb 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -95,7 +95,7 @@ module CLabel (
         mkHpcTicksLabel,
         mkHpcModuleNameLabel,
 
-	infoLblToEntryLbl, entryLblToInfoLbl,
+	infoLblToEntryLbl, entryLblToInfoLbl, infoLblToRetLbl,
 	needsCDecl, isAsmTemp, maybeAsmTemp, externallyVisibleCLabel,
 	CLabelType(..), labelType, labelDynamic,
 
@@ -432,7 +432,7 @@ mkDeadStripPreventer :: CLabel -> CLabel
 mkDeadStripPreventer lbl = DeadStripPreventer lbl
 
 -- -----------------------------------------------------------------------------
--- Converting info labels to entry labels.
+-- Converting between info labels and entry/ret labels.
 
 infoLblToEntryLbl :: CLabel -> CLabel 
 infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
@@ -462,6 +462,12 @@ entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
 entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
 entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
 
+infoLblToRetLbl :: CLabel -> CLabel 
+infoLblToRetLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsRet s)
+infoLblToRetLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsRetFS s)
+infoLblToRetLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
+infoLblToRetLbl _ = panic "CLabel.infoLblToRetLbl"
+
 -- -----------------------------------------------------------------------------
 -- Does a CLabel need declaring before use or not?
 
diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 6c9b5a5d9a..87c8845cfb 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -15,8 +15,9 @@ import MachOp
 import CmmUtils
 import CmmCallConv
 
-import CgProf (curCCS, curCCSAddr)
-import CgUtils (cmmOffsetW)
+import CgProf
+import CgUtils
+import CgInfoTbls
 import SMRep
 import ForeignCall
 
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 78ff5af0ca..3ee0da8205 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -165,8 +165,8 @@ mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
 
   | otherwise	-- Separately emit info table (with the function entry 
   =		-- point as first entry) and the entry code 
-    [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
-     CmmProc [] entry_lbl args blocks]
+    [CmmProc [] entry_lbl args blocks,
+     mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
 
 mkSRTLit :: CLabel
          -> C_SRT
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 2cf1d1d821..40040db01a 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -201,21 +201,21 @@ lits	:: { [ExtFCode CmmExpr] }
 cmmproc :: { ExtCode }
 -- TODO: add real SRT/info tables to parsed Cmm
 	: info maybe_formals maybe_frame maybe_gc_block '{' body '}'
-		{ do ((info_lbl, info, live, formals, frame, gc_block), stmts) <-
+		{ do ((info_lbl, entry_ret_label, info, live, formals, frame, gc_block), stmts) <-
 		       getCgStmtsEC' $ loopDecls $ do {
-		         (info_lbl, info, live) <- $1;
+		         (info_lbl, entry_ret_label, info, live) <- $1;
 		         formals <- sequence $2;
 		         frame <- $3;
 		         gc_block <- $4;
 		         $6;
-		         return (info_lbl, info, live, formals, frame, gc_block) }
+		         return (info_lbl, entry_ret_label, info, live, formals, frame, gc_block) }
 		     blks <- code (cgStmtsToBlocks stmts)
-		     code (emitInfoTableAndCode info_lbl (CmmInfo gc_block frame info) formals blks) }
+		     code (emitInfoTableAndCode entry_ret_label (CmmInfo gc_block frame info) formals blks) }
 
 	| info maybe_formals ';'
-		{ do (info_lbl, info, live) <- $1;
+		{ do (info_lbl, entry_ret_label, info, live) <- $1;
 		     formals <- sequence $2;
-		     code (emitInfoTableAndCode info_lbl (CmmInfo Nothing Nothing info) formals []) }
+		     code (emitInfoTableAndCode entry_ret_label (CmmInfo Nothing Nothing info) formals []) }
 
 	| NAME maybe_formals maybe_frame maybe_gc_block '{' body '}'
 		{ do ((formals, frame, gc_block), stmts) <-
@@ -228,11 +228,12 @@ cmmproc :: { ExtCode }
                      blks <- code (cgStmtsToBlocks stmts)
 		     code (emitProc (CmmInfo gc_block frame CmmNonInfoTable) (mkRtsCodeLabelFS $1) formals blks) }
 
-info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
+info	:: { ExtFCode (CLabel, CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- ptrs, nptrs, closure type, description, type
 		{ do prof <- profilingInfo $11 $13
-		     return (mkRtsInfoLabelFS $3,
+		     let infoLabel = mkRtsInfoLabelFS $3
+		     return (infoLabel, infoLblToEntryLbl infoLabel,
 			CmmInfoTable prof (fromIntegral $9)
 				     (ThunkInfo (fromIntegral $5, fromIntegral $7) NoC_SRT),
 			[]) }
@@ -240,7 +241,8 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
 		-- ptrs, nptrs, closure type, description, type, fun type
 		{ do prof <- profilingInfo $11 $13
-		     return (mkRtsInfoLabelFS $3,
+		     let infoLabel = mkRtsInfoLabelFS $3
+		     return (infoLabel, infoLblToEntryLbl infoLabel,
 			CmmInfoTable prof (fromIntegral $9)
 				     (FunInfo (fromIntegral $5, fromIntegral $7) NoC_SRT (fromIntegral $15) 0
 				      (ArgSpec 0)
@@ -255,7 +257,8 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 		     -- If profiling is on, this string gets duplicated,
 		     -- but that's the way the old code did it we can fix it some other time.
 		     desc_lit <- code $ mkStringCLit $13
-		     return (mkRtsInfoLabelFS $3,
+		     let infoLabel = mkRtsInfoLabelFS $3
+		     return (infoLabel, infoLblToEntryLbl infoLabel,
 			CmmInfoTable prof (fromIntegral $11)
 				     (ConstrInfo (fromIntegral $5, fromIntegral $7) (fromIntegral $9) desc_lit),
 			[]) }
@@ -263,14 +266,16 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
 		-- selector, closure type, description, type
 		{ do prof <- profilingInfo $9 $11
-		     return (mkRtsInfoLabelFS $3,
+		     let infoLabel = mkRtsInfoLabelFS $3
+		     return (infoLabel, infoLblToEntryLbl infoLabel,
 			CmmInfoTable prof (fromIntegral $7)
 				     (ThunkSelectorInfo (fromIntegral $5) NoC_SRT),
 			[]) }
 
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ')'
 		-- closure type (no live regs)
-		{ return (mkRtsInfoLabelFS $3,
+		{ do let infoLabel = mkRtsInfoLabelFS $3
+		     return (infoLabel, infoLblToRetLbl infoLabel,
 			CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
 				     (ContInfo [] NoC_SRT),
 			[]) }
@@ -278,7 +283,8 @@ info	:: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
 	| 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
 		-- closure type, live regs
 		{ do live <- sequence (map (liftM Just) $7)
-		     return (mkRtsInfoLabelFS $3,
+		     let infoLabel = mkRtsInfoLabelFS $3
+		     return (infoLabel, infoLblToRetLbl infoLabel,
 			CmmInfoTable (ProfilingInfo zeroCLit zeroCLit) (fromIntegral $5)
 			             (ContInfo live NoC_SRT),
 			live) }
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 1a909f26d3..77d337df93 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -632,12 +632,12 @@ pprAssign r1 (CmmRegOff r2 off)
 -- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting
 -- the lvalue elicits a warning from new GCC versions (3.4+).
 pprAssign r1 r2
-  | isFixedPtrReg r1
-  = pprReg r1 <> ptext SLIT(" = ") <> mkP_ <> pprExpr1 r2 <> semi
-  | Just ty <- strangeRegType r1
-  = pprReg r1 <> ptext SLIT(" = ") <> parens ty <> pprExpr1 r2 <> semi
-  | otherwise
-  = pprReg r1 <> ptext SLIT(" = ") <> pprExpr r2 <> semi
+  | isFixedPtrReg r1             = mkAssign (mkP_ <> pprExpr1 r2)
+  | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 r2)
+  | otherwise                    = mkAssign (pprExpr r2)
+    where mkAssign x = if r1 == CmmGlobal BaseReg
+                       then ptext SLIT("ASSIGN_BaseReg") <> parens x <> semi
+                       else pprReg r1 <> ptext SLIT(" = ") <> x <> semi
 
 -- ---------------------------------------------------------------------
 -- Registers
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index f6277f1a71..4e38485455 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -60,7 +60,7 @@ emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
 emitClosureCodeAndInfoTable cl_info args body
  = do	{ blks <- cgStmtsToBlocks body
         ; info <- mkCmmInfo cl_info
-        ; emitInfoTableAndCode info_lbl info args blks }
+        ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
   where
     info_lbl  = infoTableLabelFromCI cl_info
 
@@ -151,7 +151,7 @@ emitReturnTarget name stmts
                         (ProfilingInfo zeroCLit zeroCLit)
                         rET_SMALL -- cmmToRawCmm may convert it to rET_BIG
                         (ContInfo frame srt_info))
-        ; emitInfoTableAndCode info_lbl info args blks
+        ; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks
 	; return info_lbl }
   where
     args      = {- trace "emitReturnTarget: missing args" -} []
@@ -401,16 +401,14 @@ funInfoTable info_ptr
 -- put the info table next to the code
 
 emitInfoTableAndCode 
-	:: CLabel 		-- Label of info table
+	:: CLabel 		-- Label of entry or ret
 	-> CmmInfo 		-- ...the info table
 	-> CmmFormals		-- ...args
 	-> [CmmBasicBlock]	-- ...and body
 	-> Code
 
-emitInfoTableAndCode info_lbl info args blocks
-  = emitProc info entry_lbl args blocks
-  where
-	entry_lbl = infoLblToEntryLbl info_lbl
+emitInfoTableAndCode entry_ret_lbl info args blocks
+  = emitProc info entry_ret_lbl args blocks
 
 -------------------------------------------------------------------------
 --