[commit: ghc] wip/T14677: WIP: a shot in the dark (d47d32b)

[git at git.haskell.org]

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

On branch  : wip/T14677
Link       : http://ghc.haskell.org/trac/ghc/changeset/d47d32b5211831886910f8abc0431809ccacf0c8/ghc

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

commit d47d32b5211831886910f8abc0431809ccacf0c8
Author: Gabor Greif <ggreif at gmail.com>
Date:   Fri Jan 26 23:05:31 2018 +0100

    WIP: a shot in the dark


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

d47d32b5211831886910f8abc0431809ccacf0c8
 compiler/codeGen/StgCmmExpr.hs | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 3fcc935..f90aebc 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -738,7 +738,16 @@ cgIdApp fun_id args = do
         node_points dflags = nodeMustPointToIt dflags lf_info
     case getCallMethod dflags fun_name cg_fun_id lf_info n_args v_args (cg_loc fun_info) self_loop_info of
             -- A value in WHNF, so we can just return it.
+        EnterIt | Just con <- maybeIsLFCon lf_info -> pprPanic "maybeIsLFCon EnterIt" (ppr con)
+
         ReturnIt
+          -- | Just con <- maybeIsLFCon lf_info -> emitReturn [CmmLoad (CmmMachOp (MO_Add $ typeWidth $ gcWord dflags) [fun, CmmLit (CmmInt 7 $ typeWidth $ gcWord dflags)]) $ gcWord dflags]
+          | Just con <- maybeIsLFCon lf_info
+          , CmmLit (CmmLabelOff lab _) <- fun ->
+              let ty = gcWord dflags
+                  width = typeWidth ty
+                  offsLoad = CmmLoad (CmmMachOp (MO_Add width) [cmmUntag dflags fun, CmmLit (CmmInt 8 width)]) $ ty
+              in emitReturn [pprTrace "offsLoad" (ppr offsLoad) offsLoad]
           | isVoidTy (idType fun_id) -> emitReturn []
           | otherwise                -> emitReturn [fun]
           -- ToDo: does ReturnIt guarantee tagged?