[commit: ghc] wip/rwbarton-tiny-tables: Experiment with one-byte info tables (0fd5db7)

[git at git.haskell.org]

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

On branch  : wip/rwbarton-tiny-tables
Link       : http://ghc.haskell.org/trac/ghc/changeset/0fd5db798e31912f335e4553e939e1e783284495/ghc

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

commit 0fd5db798e31912f335e4553e939e1e783284495
Author: Reid Barton <rwbarton at gmail.com>
Date:   Mon Feb 29 17:35:43 2016 -0500

    Experiment with one-byte info tables


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

0fd5db798e31912f335e4553e939e1e783284495
 compiler/cmm/CmmInfo.hs              | 12 +++++++++++-
 compiler/nativeGen/X86/Ppr.hs        |  5 +++++
 includes/rts/storage/ClosureMacros.h | 15 +++++++++++++++
 rts/ThreadPaused.c                   |  8 ++++++++
 rts/sm/Scav.c                        | 20 ++++++++++++++++++++
 5 files changed, 59 insertions(+), 1 deletion(-)

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index b9981f2..299f7bb 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -194,7 +194,11 @@ mkInfoTableContents dflags
                      | null liveness_data     = rET_SMALL -- Fits in extra_bits
                      | otherwise              = rET_BIG   -- Does not; extra_bits is
                                                           -- a label
-       ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
+             mb_tiny_liveness = mkTinyLivenessBits frame
+       ; case (prof_data, liveness_data, srt_label, rts_tag == rET_SMALL,
+               srt_bitmap == toStgHalfWord dflags 0, mb_tiny_liveness) of
+          ([], [], [], True, True, Just b) -> return ([], ([b], []))
+          _ -> return (prof_data ++ liveness_data, (std_info, srt_label)) }
 
   | HeapRep _ ptrs nonptrs closure_type <- smrep
   = do { let layout  = packIntsCLit dflags ptrs nonptrs
@@ -317,6 +321,12 @@ makeRelativeRefTo _ _ lit = lit
 -- The head of the stack layout is the top of the stack and
 -- the least-significant bit.
 
+mkTinyLivenessBits :: Liveness -> Maybe CmmLit
+mkTinyLivenessBits liveness
+  | length liveness > 7 = Nothing
+  | otherwise = Just (CmmInt b W8)
+  where b = foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip (liveness ++ [True]) [0..] ]
+
 mkLivenessBits :: DynFlags -> Liveness -> UniqSM (CmmLit, [RawCmmDecl])
               -- ^ Returns:
               --   1. The bitmap (literal value or label)
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 7809ae1..b5111a1 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -108,6 +108,11 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
     asmLbl = mkAsmTempLabel (getUnique blockid)
     maybe_infotable = case mapLookup blockid info_env of
        Nothing   -> empty
+       Just (Statics info_lbl [b8@(CmmStaticLit (CmmInt _ W8))]) ->
+           text ".align 2" $$   -- XXX Needs to be adjusted for darwin
+           infoTableLoc $$
+           pprData b8 $$
+           pprLabel info_lbl
        Just (Statics info_lbl info) ->
            pprAlignForSection Text $$
            infoTableLoc $$
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index d534873..a5966ab 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -415,11 +415,26 @@ EXTERN_INLINE nat closure_sizeW (StgClosure *p)
    Sizes of stack frames
    -------------------------------------------------------------------------- */
 
+INLINE_HEADER StgWord tiny_bitmap_size(uint8_t liveness)
+{
+    StgWord bitmap_size = 0;
+    // XXX use a table or instruction?
+    while (liveness > 1) {
+        bitmap_size++;
+        liveness = liveness >> 1;
+    }
+    return bitmap_size;
+}
+
 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame );
 EXTERN_INLINE StgWord stack_frame_sizeW( StgClosure *frame )
 {
     StgRetInfoTable *info;
 
+    if (*(P_)frame & 1) {
+        return 1 + tiny_bitmap_size(*(*(uint8_t **)frame - 1));
+    }
+
     info = get_ret_itbl(frame);
     switch (info->i.type) {
 
diff --git a/rts/ThreadPaused.c b/rts/ThreadPaused.c
index 1f1d0af..e0e616a 100644
--- a/rts/ThreadPaused.c
+++ b/rts/ThreadPaused.c
@@ -219,6 +219,14 @@ threadPaused(Capability *cap, StgTSO *tso)
     frame = (StgClosure *)tso->stackobj->sp;
 
     while ((P_)frame < stack_end) {
+        if (*(P_)frame & 1) {
+            nat frame_size = stack_frame_sizeW(frame);
+            weight_pending += frame_size;
+            frame = (StgClosure *)((StgPtr)frame + frame_size);
+            prev_was_update_frame = rtsFalse;
+            continue;
+        }
+
         info = get_ret_itbl(frame);
 
         switch (info->i.type) {
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 953f055..b678374 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -174,6 +174,19 @@ static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a)
 }
 
 STATIC_INLINE StgPtr
+scavenge_tiny_bitmap (StgPtr p, uint8_t layout)
+{
+    while (layout > 1) {
+        if ((layout & 1) == 0) {
+            evacuate((StgClosure **)p);
+        }
+        p++;
+        layout = layout >> 1;
+    }
+    return p;
+}
+
+STATIC_INLINE StgPtr
 scavenge_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
 {
     while (size > 0) {
@@ -1807,6 +1820,13 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
    */
 
   while (p < stack_end) {
+    if (*p & 1) {
+        // Tiny liveness layout: no SRT
+        uint8_t liveness = *((uint8_t *)(*p) - 1);
+        p = scavenge_tiny_bitmap(p+1, liveness);
+        continue;
+    }
+
     info  = get_ret_itbl((StgClosure *)p);
 
     switch (info->i.type) {