[commit: ghc] master: Minor refactoring and docs in selector optimisation (f7b9456)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f7b9456cbec62a68806a945479e539ae5a984a4e/ghc

>---------------------------------------------------------------

commit f7b9456cbec62a68806a945479e539ae5a984a4e
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Thu Jun 14 14:26:15 2018 +0300

    Minor refactoring and docs in selector optimisation
    
    Reviewers: bgamari, simonmar, erikd
    
    Reviewed By: simonmar
    
    Subscribers: rwbarton, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4835


>---------------------------------------------------------------

f7b9456cbec62a68806a945479e539ae5a984a4e
 rts/sm/Evac.c | 55 ++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 38 insertions(+), 17 deletions(-)

diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index deaad27..2890319 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -43,7 +43,7 @@
  */
 #define MAX_THUNK_SELECTOR_DEPTH 16
 
-static void eval_thunk_selector (StgClosure **q, StgSelector * p, bool);
+static void eval_thunk_selector (StgClosure **q, StgSelector *p, bool);
 STATIC_INLINE void evacuate_large(StgPtr p);
 
 /* -----------------------------------------------------------------------------
@@ -934,23 +934,34 @@ evacuate_BLACKHOLE(StgClosure **p)
     copy(p,info,q,sizeofW(StgInd),gen_no);
 }
 
-/* -----------------------------------------------------------------------------
-   Evaluate a THUNK_SELECTOR if possible.
+/* ----------------------------------------------------------------------------
+   Update a chain of thunk selectors with the given value. All selectors in the
+   chain become IND pointing to the value, except when there is a loop (i.e.
+   the value of a THUNK_SELECTOR is the THUNK_SELECTOR itself), in that case we
+   leave the selector as-is.
+
+   p is the current selector to update. In eval_thunk_selector we make a list
+   from selectors using ((StgThunk*)p)->payload[0] for the link field and use
+   that field to traverse the chain here.
+
+   val is the final value of the selector chain.
 
-   p points to a THUNK_SELECTOR that we want to evaluate.  The
-   result of "evaluating" it will be evacuated and a pointer to the
-   to-space closure will be returned.
+   A chain is formed when we've got something like:
 
-   If the THUNK_SELECTOR could not be evaluated (its selectee is still
-   a THUNK, for example), then the THUNK_SELECTOR itself will be
-   evacuated.
+      let x = C1 { f1 = e1 }
+          y = C2 { f2 = f1 x }
+          z = f2 y
+
+   Here the chain (p) we get when evacuating z is:
+
+      [ f2 y, f1 x ]
+
+   and val is e1.
    -------------------------------------------------------------------------- */
+
 static void
 unchain_thunk_selectors(StgSelector *p, StgClosure *val)
 {
-    StgSelector *prev;
-
-    prev = NULL;
     while (p)
     {
         ASSERT(p->header.info == &stg_WHITEHOLE_info);
@@ -960,7 +971,7 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val)
         // not evacuate it), so in this case val is in from-space.
         // ASSERT(!HEAP_ALLOCED_GC(val) || Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED));
 
-        prev = (StgSelector*)((StgClosure *)p)->payload[0];
+        StgSelector *prev = (StgSelector*)((StgClosure *)p)->payload[0];
 
         // Update the THUNK_SELECTOR with an indirection to the
         // value.  The value is still in from-space at this stage.
@@ -997,8 +1008,18 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val)
     }
 }
 
+/* -----------------------------------------------------------------------------
+   Evaluate a THUNK_SELECTOR if possible.
+
+   p points to a THUNK_SELECTOR that we want to evaluate.
+
+   If the THUNK_SELECTOR could not be evaluated (its selectee is still a THUNK,
+   for example), then the THUNK_SELECTOR itself will be evacuated depending on
+   the evac parameter.
+   -------------------------------------------------------------------------- */
+
 static void
-eval_thunk_selector (StgClosure **q, StgSelector * p, bool evac)
+eval_thunk_selector (StgClosure **q, StgSelector *p, bool evac)
                  // NB. for legacy reasons, p & q are swapped around :(
 {
     uint32_t field;
@@ -1007,7 +1028,6 @@ eval_thunk_selector (StgClosure **q, StgSelector * p, bool evac)
     StgClosure *selectee;
     StgSelector *prev_thunk_selector;
     bdescr *bd;
-    StgClosure *val;
 
     prev_thunk_selector = NULL;
     // this is a chain of THUNK_SELECTORs that we are going to update
@@ -1132,7 +1152,7 @@ selector_loop:
                                           info->layout.payload.nptrs));
 
               // Select the right field from the constructor
-              val = selectee->payload[field];
+              StgClosure *val = selectee->payload[field];
 
 #if defined(PROFILING)
               // For the purposes of LDV profiling, we have destroyed
@@ -1164,6 +1184,8 @@ selector_loop:
                       val = ((StgInd *)val)->indirectee;
                       goto val_loop;
                   case THUNK_SELECTOR:
+                      // Use payload to make a list of thunk selectors, to be
+                      // used in unchain_thunk_selectors
                       ((StgClosure*)p)->payload[0] = (StgClosure *)prev_thunk_selector;
                       prev_thunk_selector = p;
                       p = (StgSelector*)val;
@@ -1278,5 +1300,4 @@ bale_out:
         copy(q,(const StgInfoTable *)info_ptr,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->dest_no);
     }
     unchain_thunk_selectors(prev_thunk_selector, *q);
-    return;
 }