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)

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 $$

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) {
 

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) {

rts/sm/Scav.c

@@ -173,6 +173,19 @@ static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a)
     return (StgPtr)a + mut_arr_ptrs_sizeW(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)
 {
@@ -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) {