Extra argument for emitting pre-join label code
authorGabor Greif <ggreif@gmail.com>
Fri, 15 Dec 2017 10:54:49 +0000 (11:54 +0100)
committerGabor Greif <ggreif@gmail.com>
Sat, 16 Dec 2017 12:10:31 +0000 (13:10 +0100)
in 'emitSwitch'. The former functionality can be
recovered by passing `(pure ())`.

Now we can eliminate the forming a the weird branch island
around the switch on info-pointer tag (`cgAlts` in StgCmmExpr.hs).

compiler/codeGen/StgCmmExpr.hs
compiler/codeGen/StgCmmUtils.hs

index a793048..5bb2528 100644 (file)
@@ -307,7 +307,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts
        ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly)
                                               (NonVoid bndr) alts
                                  -- See Note [GC for conditionals]
-       ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1)
+       ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) (pure ())
        ; return AssignedDirectly
        }
   where
@@ -620,7 +620,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
         ; if small || null info
            then -- Yes, bndr_reg has constr. tag in ls bits
                emitSwitch tag_expr branches' mb_deflt 1
-                 $ if small then fam_sz else maxpt
+                 (if small then fam_sz else maxpt) (pure ())
 
            else -- No, get exact tag from info table when mAX_PTR_TAG
               do
@@ -637,14 +637,12 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
 
                 (mb_deflt, mb_branch) <- prelabel mb_deflt
                 emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt
-                join_lbl <- newBlockId
-                emit (mkBranch join_lbl)
-                emitLabel infos_lbl
-                let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg)
-                    tag_expr = getConstrTag dflags untagged_ptr
-                    info0 = first pred <$> info
-                emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1)
-                emitLabel join_lbl
+                  (do emitLabel infos_lbl
+                      let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg)
+                          tag_expr = getConstrTag dflags untagged_ptr
+                          info0 = first pred <$> info
+                      emitSwitch tag_expr info0 mb_branch
+                        (maxpt - 1) (fam_sz - 1) (pure ()))
 
         ; return AssignedDirectly }
 
index 07432c4..0b77bc9 100644 (file)
@@ -453,14 +453,16 @@ emitSwitch :: CmmExpr                      -- Tag to switch on
            -> ConTagZ -> ConTagZ           -- Min and Max possible values;
                                            -- behaviour outside this range is
                                            -- undefined
+           -> FCode ()                     -- code to insert before join label
            -> FCode ()
 
--- First, two rather common cases in which there is no work to do
-emitSwitch _ []         (Just code) _ _ = emit (fst code)
-emitSwitch _ [(_,code)] Nothing     _ _ = emit (fst code)
+-- First, three rather common cases in which there is no work to do
+emitSwitch _ []         (Just code) _ _ pj = emit (fst code) >> pj
+emitSwitch _ [(_,code)] Nothing     _ _ pj = emit (fst code) >> pj
+emitSwitch _ []         Nothing     _ _ pj = pj
 
 -- Right, off we go
-emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do
+emitSwitch tag_expr branches mb_deflt lo_tag hi_tag pj = do
     join_lbl      <- newBlockId
     mb_deflt_lbl  <- label_default join_lbl mb_deflt
     branches_lbls <- label_branches join_lbl branches
@@ -472,7 +474,7 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do
 
     emit $ mk_discrete_switch False tag_expr' branches_lbls' mb_deflt_lbl range
 
-    emitLabel join_lbl
+    pj >> emitLabel join_lbl
 
 mk_discrete_switch :: Bool -- ^ Use signed comparisons
           -> CmmExpr