Big collection of patches for the new codegen branch.

o Fixed bug that emitted the copy-in code for closure entry
  in the wrong place -- at the initialization of the closure.
o Refactored some of the closure entry code.
o Added code to check that no LocalRegs are live-in to a procedure
   -- trip up some buggy programs earlier
o Fixed environment bindings for thunks
   -- we weren't (re)binding the free variables in a thunk
o Fixed a bug in proc-point splitting that dropped some updates
  to the entry block in a procedure.
o Fixed improper calls to code that generates CmmLit's for strings
o New invariant on cg_loc in CgIdInfo: the expression is always tagged
o Code to load free vars on entry to a thunk was (wrongly) placed before
  the heap check.
o Some of the StgCmm code was redundantly passing around Id's
  along with CgIdInfo's; no more.
o Initialize the LocalReg's that point to a closure before allocating and
  initializing the closure itself -- otherwise, we have problems with
  recursive closure bindings
o BlockEnv and BlockSet types are now abstract.
o Update frames:
  - push arguments in Old call area
  - keep track of the return sp in the FCode monad
  - keep the return sp in every call, tail call, and return
      (because it might be different at different call sites,
       e.g. tail calls to the gc after a heap check are performed
            before pushing the update frame)
  - set the sp appropriately on returns and tail calls
o Reduce call, tail call, and return to a single LastCall node
o Added slow entry code, using different calling conventions on entry and tail call
o More fixes to the calling convention code.
  The tricky stuff is all about the closure environment: it must be passed in R1,
  but in non-closures, there is no such argument, so we can't treat all arguments
  the same way: the closure environment is special. Maybe the right step forward
  would be to define a different calling convention for closure arguments.
o Let-no-escapes need to be emitted out-of-line -- otherwise, we drop code.
o Respect RTS requirement of word alignment for pointers
  My stack allocation can pack sub-word values into a single word on the stack,
  but it wasn't requiring word-alignment for pointers. It does now,
  by word-aligning both pointer registers and call areas.
o CmmLint was over-aggresively ruling out non-word-aligned memory references,
  which may be kosher now that we can spill small values into a single word.
o Wrong label order on a conditional branch when compiling switches.
o void args weren't dropped in many cases.
  To help prevent this kind of mistake, I defined a NonVoid wrapper,
  which I'm applying only to Id's for now, although there are probably
  other good candidates.
o A little code refactoring: separate modules for procpoint analysis splitting, 
  stack layout, and building infotables.
o Stack limit check: insert along with the heap limit check, using a symbolic
  constant (a special CmmLit), then replace it when the stack layout is known.
o Removed last node: MidAddToContext 
o Adding block id as a literal: means that the lowering of the calling conventions
  no longer has to produce labels early, which was inhibiting common-block elimination.
  Will also make it easier for the non-procpoint-splitting path.
o Info tables: don't try to describe the update frame!
o Over aggressive use of NonVoid!!!!
  Don't drop the non-void args before setting the type of the closure!!!
o Sanity checking:
  Added a pass to stub dead dead slots on the stack
  (only ~10 lines with the dataflow framework)
o More sanity checking:
  Check that incoming pointer arguments are non-stubbed.
  Note: these checks are still subject to dead-code removal, but they should
  still be quite helpful.
o Better sanity checking: why stop at function arguments?
  Instead, in mkAssign, check that _any_ assignment to a pointer type is non-null
  -- the sooner the crash, the easier it is to debug.
  Still need to add the debugging flag to turn these checks on explicitly.
o Fixed yet another calling convention bug.
  This time, the calls to the GC were wrong. I've added a new convention
  for GC calls and invoked it where appropriate.
  We should really straighten out the calling convention stuff:
    some of the code (and documentation) is spread across the compiler,
    and there's some magical use of the node register that should really
    be handled (not avoided) by calling conventions.
o Switch bug: the arms in mkCmmLitSwitch weren't returning to a single join point.
o Environment shadowing problem in Stg->Cmm:
  When a closure f is bound at the top-level, we should not bind f to the
  node register on entry to the closure.
  Why? Because if the body of f contains a let-bound closure g that refers
  to f, we want to make sure that it refers to the static closure for f.
  Normally, this would all be fine, because when we compile a closure,
  we rebind free variables in the environment. But f doesn't look like
  a free variable because it's a static value. So, the binding for f
  remains in the environment when we compile g, inconveniently referring
  to the wrong thing.
  Now, I bind the variable in the local environment only if the closure is not
  bound at the top level. It's still okay to make assumptions about the
  node holding the closure environment; we just won't find the binding
  in the environment, so code that names the closure will now directly
  get the label of the static closure, not the node register holding a
  pointer to the static closure.
o Don't generate bogus Cmm code containing SRTs during the STG -> Cmm pass!
  The tables made reference to some labels that don't exist when we compute and
  generate the tables in the back end.
o Safe foreign calls need some special treatment (at least until we have the integrated
  codegen). In particular:
  o they need info tables
  o they are not procpoints -- the successor had better be in the same procedure
  o we cannot (yet) implement the calling conventions early, which means we have
    to carry the calling-conv info all the way to the end
o We weren't following the old convention when registering a module.
  Now, we use update frames to push any new modules that have to be registered
  and enter the youngest one on the stack.
  We also use the update frame machinery to specify that the return should pop
  the return address off the stack.
o At each safe foreign call, an infotable must be at the bottom of the stack,
  and the TSO->sp must point to it.
o More problems with void args in a direct call to a function:
  We were checking the args (minus voids) to check whether the call was saturated,
  which caused problems when the function really wasn't saturated because it
  took an extra void argument.
o Forgot to distinguish integer != from floating != during Stg->Cmm
o Updating slotEnv and areaMap to include safe foreign calls
  The dataflow analyses that produce the slotEnv and areaMap give
  results for each basic block, but we also need the results for
  a safe foreign call, which is a middle node.
  After running the dataflow analysis, we have another pass that
  updates the results to includ any safe foreign calls.
o Added a static flag for the debugging technique that inserts
  instructions to stub dead slots on the stack and crashes when
  a stubbed value is loaded into a pointer-typed LocalReg.
o C back end expects to see return continuations before their call sites.
  Sorted the flowgraphs appropriately after splitting.
o PrimOp calling conventions are special -- unlimited registers, no stack
  Yet another calling convention...
o More void value problems: if the RHS of a case arm is a void-typed variable,
  don't try to return it.
o When calling some primOp, they may allocate memory; if so, we need to
  do a heap check when we return from the call.

1 files changed, 58 insertions, 71 deletions

diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 2d5d79e6ff..2a6b794e2d 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -10,11 +10,10 @@
 -----------------------------------------------------------------------------
 
 module StgCmmForeign (
-  cgForeignCall,
+  cgForeignCall, loadThreadState, saveThreadState,
   emitPrimCall, emitCCall,
   emitSaveThreadState, -- will be needed by the Cmm parser
   emitLoadThreadState, -- ditto
-  emitCloseNursery,
   emitOpenNursery,
  ) where
 
@@ -27,18 +26,23 @@ import StgCmmMonad
 import StgCmmUtils
 import StgCmmClosure
 
-import MkZipCfgCmm
+import BlockId
 import Cmm
 import CmmUtils
+import MkZipCfg
+import MkZipCfgCmm hiding (CmmAGraph)
 import Type
 import TysPrim
+import UniqSupply
 import CLabel
 import SMRep
 import ForeignCall
 import Constants
 import StaticFlags
+import FastString
 import Maybes
 import Outputable
+import ZipCfgCmmRep
 
 import Control.Monad
 
@@ -64,8 +68,9 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
 		   DynamicTarget    ->  case args of fn:rest -> (rest, fn)
 	      call_target = ForeignTarget cmm_target fc
 	
-	; srt <- getSRTInfo (panic "emitForeignCall")	-- SLPJ: Not sure what SRT 
-							-- is right here
+	; srt <- getSRTInfo NoSRT	-- SLPJ: Not sure what SRT 
+					-- is right here
+                                        -- JD: Does it matter in the new codegen?
 	; emitForeignCall safety results call_target call_args srt CmmMayReturn }
   where
 	-- in the stdcall calling convention, the symbol needs @size appended
@@ -111,50 +116,18 @@ emitForeignCall
         -> CmmReturnInfo	-- This can say "never returns"
 				--   only RTS procedures do this
 	-> FCode ()
-emitForeignCall safety results target args _srt _ret
-  | not (playSafe safety) = trace "emitForeignCall; ret is undone" $ do
+emitForeignCall safety results target args _srt ret
+  | not (playSafe safety) = do -- trace "emitForeignCall; ret is undone" $ do
     let (caller_save, caller_load) = callerSaveVolatileRegs
+    updfr_off <- getUpdFrameOff
     emit caller_save
-    emit (mkUnsafeCall target results args)
+    emit $ mkUnsafeCall target results args
     emit caller_load
 
-  | otherwise = panic "ToDo: emitForeignCall'"
-
-{-
   | otherwise = do
-    -- Both 'id' and 'new_base' are KindNonPtr because they're
-    -- RTS only objects and are not subject to garbage collection
-    id <- newTemp bWord
-    new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
+    updfr_off <- getUpdFrameOff
     temp_target <- load_target_into_temp target
-    let (caller_save, caller_load) = callerSaveVolatileRegs 
-    emitSaveThreadState
-    emit caller_save
-    -- The CmmUnsafe arguments are only correct because this part
-    -- of the code hasn't been moved into the CPS pass yet.
-    -- Once that happens, this function will just emit a (CmmSafe srt) call,
-    -- and the CPS will will be the one to convert that
-    -- to this sequence of three CmmUnsafe calls.
-    emit (mkCmmCall (CmmCallee suspendThread CCallConv)
-                       [ (id,AddrHint) ]
-                       [ (CmmReg (CmmGlobal BaseReg), AddrHint) ]
-                       CmmUnsafe
-                       ret)
-    emit (mkCmmCall temp_target results args CmmUnsafe ret)
-    emit (mkCmmCall (CmmCallee resumeThread CCallConv)
-                       [ (new_base, AddrHint) ]
-                       [ (CmmReg (CmmLocal id), AddrHint) ]
-                       CmmUnsafe
-                       ret )
-    -- Assign the result to BaseReg: we
-    -- might now have a different Capability!
-    emit (mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)))
-    emit caller_load
-    emitLoadThreadState
-
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
--}
+    emit $ mkSafeCall temp_target results args updfr_off
 
 
 {-
@@ -170,23 +143,23 @@ load_args_into_temps = mapM arg_assign_temp
   where arg_assign_temp (e,hint) = do
 	   tmp <- maybe_assign_temp e
 	   return (tmp,hint)
+-}
 	
-load_target_into_temp (CmmCallee expr conv) = do 
+load_target_into_temp (ForeignTarget expr conv) = do 
   tmp <- maybe_assign_temp expr
-  return (CmmCallee tmp conv)
-load_target_into_temp other_target =
+  return (ForeignTarget tmp conv)
+load_target_into_temp other_target@(PrimTarget _) =
   return other_target
 
 maybe_assign_temp e
   | hasNoGlobalRegs e = return e
-  | otherwise          = do 
+  | otherwise         = do 
 	-- don't use assignTemp, it uses its own notion of "trivial"
 	-- expressions, which are wrong here.
         -- this is a NonPtr because it only duplicates an existing
 	reg <- newTemp (cmmExprType e) --TODO FIXME NOW
 	emit (mkAssign (CmmLocal reg) e)
 	return (CmmReg (CmmLocal reg))
--}
 
 -- -----------------------------------------------------------------------------
 -- Save/restore the thread state in the TSO
@@ -194,23 +167,34 @@ maybe_assign_temp e
 -- This stuff can't be done in suspendThread/resumeThread, because it
 -- refers to global registers which aren't available in the C world.
 
-emitSaveThreadState :: FCode ()
-emitSaveThreadState = do
+saveThreadState :: CmmAGraph
+saveThreadState =
   -- CurrentTSO->sp = Sp;
-  emit $ mkStore (cmmOffset stgCurrentTSO tso_SP) stgSp
-  emitCloseNursery
+  mkStore (cmmOffset stgCurrentTSO tso_SP) stgSp
+  <*> closeNursery
+  -- and save the current cost centre stack in the TSO when profiling:
+  <*> if opt_SccProfilingOn then
+	mkStore (cmmOffset stgCurrentTSO tso_CCCS) curCCS
+      else mkNop
+
+emitSaveThreadState :: BlockId -> FCode ()
+emitSaveThreadState bid = do
+  -- CurrentTSO->sp = Sp;
+  emit $ mkStore (cmmOffset stgCurrentTSO tso_SP)
+                 (CmmStackSlot (CallArea (Young bid)) (widthInBytes (typeWidth gcWord)))
+  emit closeNursery
   -- and save the current cost centre stack in the TSO when profiling:
   when opt_SccProfilingOn $
 	emit (mkStore (cmmOffset stgCurrentTSO tso_CCCS) curCCS)
 
    -- CurrentNursery->free = Hp+1;
-emitCloseNursery :: FCode ()
-emitCloseNursery = emit $ mkStore nursery_bdescr_free (cmmOffsetW stgHp 1)
+closeNursery :: CmmAGraph
+closeNursery = mkStore nursery_bdescr_free (cmmOffsetW stgHp 1)
 
-emitLoadThreadState :: FCode ()
-emitLoadThreadState = do
-  tso <- newTemp gcWord -- TODO FIXME NOW
-  emit $ catAGraphs [
+loadThreadState :: LocalReg -> CmmAGraph
+loadThreadState tso = do
+  -- tso <- newTemp gcWord -- TODO FIXME NOW
+  catAGraphs [
 	-- tso = CurrentTSO;
   	mkAssign (CmmLocal tso) stgCurrentTSO,
 	-- Sp = tso->sp;
@@ -218,16 +202,18 @@ emitLoadThreadState = do
 	                      bWord),
 	-- SpLim = tso->stack + RESERVED_STACK_WORDS;
 	mkAssign spLim (cmmOffsetW (cmmOffset (CmmReg (CmmLocal tso)) tso_STACK)
-			            rESERVED_STACK_WORDS)
-    ]
-  emitOpenNursery
-  -- and load the current cost centre stack from the TSO when profiling:
-  when opt_SccProfilingOn $
-	emit (mkStore curCCSAddr 
-		(CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) ccsType))
-
-emitOpenNursery :: FCode ()
-emitOpenNursery = emit $ catAGraphs [
+			            rESERVED_STACK_WORDS),
+        openNursery,
+        -- and load the current cost centre stack from the TSO when profiling:
+        if opt_SccProfilingOn then
+	  mkStore curCCSAddr
+                  (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) ccsType)
+        else mkNop]
+emitLoadThreadState :: LocalReg -> FCode ()
+emitLoadThreadState tso = emit $ loadThreadState tso
+
+openNursery :: CmmAGraph
+openNursery = catAGraphs [
         -- Hp = CurrentNursery->free - 1;
 	mkAssign hp (cmmOffsetW (CmmLoad nursery_bdescr_free bWord) (-1)),
 
@@ -246,7 +232,8 @@ emitOpenNursery = emit $ catAGraphs [
 		)
 	    )
    ]
-
+emitOpenNursery :: FCode ()
+emitOpenNursery = emit openNursery
 
 nursery_bdescr_free   = cmmOffset stgCurrentNursery oFFSET_bdescr_free
 nursery_bdescr_start  = cmmOffset stgCurrentNursery oFFSET_bdescr_start
@@ -285,7 +272,7 @@ currentNursery 	  = CmmGlobal CurrentNursery
 
 getFCallArgs :: [StgArg] -> FCode [(CmmExpr, ForeignHint)]
 -- (a) Drop void args
--- (b) Add foriegn-call shim code
+-- (b) Add foreign-call shim code
 -- It's (b) that makes this differ from getNonVoidArgAmodes
 
 getFCallArgs args
@@ -295,7 +282,7 @@ getFCallArgs args
     get arg | isVoidRep arg_rep 
 	    = return Nothing
 	    | otherwise
-	    = do { cmm <- getArgAmode arg
+	    = do { cmm <- getArgAmode (NonVoid arg)
 		 ; return (Just (add_shim arg_ty cmm, hint)) }
 	    where
 	      arg_ty  = stgArgType arg