From a4b249c479ebae6e832b350caef17da9efd8cb80 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Thu, 19 Jul 2012 11:32:45 +0100
Subject: [PATCH] Small optimisation to the code generated for CAFs

---
 compiler/codeGen/StgCmmBind.hs | 23 ++++++++++++++---------
 compiler/codeGen/StgCmmHeap.hs | 26 +++++++++++++++++++-------
 2 files changed, 33 insertions(+), 16 deletions(-)

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 55307216c3..e40c660fdb 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -578,7 +578,7 @@ setupUpdate closure_info node body
 	; if closureUpdReqd closure_info
 	  then do	-- Blackhole the (updatable) CAF:
                 { upd_closure <- link_caf True
-		; pushUpdateFrame [CmmReg (CmmLocal upd_closure),
+                ; pushUpdateFrame [upd_closure,
                                    mkLblExpr mkBHUpdInfoLabel] body }
 	  else do {tickyUpdateFrameOmitted; body}
     }
@@ -633,8 +633,8 @@ pushUpdateFrame es body
 -- be closer together, and the compiler wouldn't need to know
 -- about off_indirectee etc.
 
-link_caf :: Bool                -- True <=> updatable, False <=> single-entry
-         -> FCode LocalReg      -- Returns amode for closure to be updated
+link_caf :: Bool               -- True <=> updatable, False <=> single-entry
+         -> FCode CmmExpr      -- Returns amode for closure to be updated
 -- To update a CAF we must allocate a black hole, link the CAF onto the
 -- CAF list, then update the CAF to point to the fresh black hole.
 -- This function returns the address of the black hole, so it can be
@@ -648,19 +648,24 @@ link_caf _is_upd = do
         blame_cc = use_cc
         tso      = CmmReg (CmmGlobal CurrentTSO)
 
-  ; (hp_rel, init) <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole
+  ; hp_rel <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole
                                          use_cc blame_cc [(tso,fixedHdrSize dflags)]
-  ; emit init
-
-	-- Call the RTS function newCAF to add the CAF to the CafList
-	-- so that the garbage collector can find them
+        -- small optimisation: we duplicate the hp_rel expression in
+        -- both the newCAF call and the value returned below.
+        -- If we instead used allocDynClosureReg which assigns it to a reg,
+        -- then the reg is live across the newCAF call and gets spilled,
+        -- which is stupid.  Really we should have an optimisation pass to
+        -- fix this, but we don't yet. --SDM
+
+        -- Call the RTS function newCAF to add the CAF to the CafList
+        -- so that the garbage collector can find them
 	-- This must be done *before* the info table pointer is overwritten,
 	-- because the old info table ptr is needed for reversion
   ; ret <- newTemp bWord
   ; emitRtsCallGen [(ret,NoHint)] rtsPackageId (fsLit "newCAF")
       [ (CmmReg (CmmGlobal BaseReg),  AddrHint),
         (CmmReg nodeReg, AddrHint),
-        (CmmReg (CmmLocal hp_rel), AddrHint) ]
+        (hp_rel, AddrHint) ]
       (Just [node]) False
         -- node is live, so save it.
 
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index e177b72385..be4497aa5c 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -15,7 +15,8 @@ module StgCmmHeap (
         mkVirtHeapOffsets, mkVirtConstrOffsets,
         mkStaticClosureFields, mkStaticClosure,
 
-        allocDynClosure, allocDynClosureCmm, emitSetDynHdr
+        allocDynClosure, allocDynClosureReg, allocDynClosureCmm,
+        emitSetDynHdr
     ) where
 
 #include "HsVersions.h"
@@ -64,11 +65,16 @@ allocDynClosure
                                                 -- No void args in here
         -> FCode (LocalReg, CmmAGraph)
 
-allocDynClosureCmm
+allocDynClosureReg
         :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
         -> [(CmmExpr, VirtualHpOffset)]
         -> FCode (LocalReg, CmmAGraph)
 
+allocDynClosureCmm
+        :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
+        -> [(CmmExpr, VirtualHpOffset)]
+        -> FCode CmmExpr -- returns Hp+n
+
 -- allocDynClosure allocates the thing in the heap,
 -- and modifies the virtual Hp to account for this.
 -- The second return value is the graph that sets the value of the
@@ -89,10 +95,18 @@ allocDynClosureCmm
 allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets
   = do  { let (args, offsets) = unzip args_w_offsets
         ; cmm_args <- mapM getArgAmode args     -- No void args
-        ; allocDynClosureCmm info_tbl lf_info
+        ; allocDynClosureReg info_tbl lf_info
                              use_cc _blame_cc (zip cmm_args offsets)
         }
 
+allocDynClosureReg  info_tbl lf_info use_cc _blame_cc amodes_w_offsets
+  = do  { hp_rel <- allocDynClosureCmm info_tbl lf_info
+                                       use_cc _blame_cc amodes_w_offsets
+
+        -- Note [Return a LocalReg]
+        ; getCodeR $ assignTemp hp_rel
+        }
+
 allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets
   = do  { virt_hp <- getVirtHp
 
@@ -121,10 +135,8 @@ allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets
         ; dflags <- getDynFlags
         ; setVirtHp (virt_hp + heapClosureSize dflags rep)
 
-        -- Assign to a temporary and return
-        -- Note [Return a LocalReg]
-        ; hp_rel <- getHpRelOffset info_offset
-        ; getCodeR $ assignTemp hp_rel }
+        ; getHpRelOffset info_offset
+        }
 
 emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
 emitSetDynHdr base info_ptr ccs
-- 
GitLab