X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgTailCall.lhs;h=475196abbaef8df0bf2ae44b1fa5286ab93163fd;hb=a385f0af5ea320a18d580f6a36c59c55b3516efd;hp=e25e794d58a4b72921f03cf2219dd02a98314661;hpb=81b2276ff9434d97aff683218c34c86479a8d868;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs index e25e794..475196a 100644 --- a/compiler/codeGen/CgTailCall.lhs +++ b/compiler/codeGen/CgTailCall.lhs @@ -5,6 +5,13 @@ % Code generation for tail calls. \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module CgTailCall ( cgTailCall, performTailCall, performReturn, performPrimReturn, @@ -27,7 +34,6 @@ import CgUtils import CgTicky import ClosureInfo import SMRep -import MachOp import Cmm import CmmUtils import CLabel @@ -191,7 +197,7 @@ performTailCall fun_info arg_amodes pending_assts -- No, enter the closure. ; enterClosure ; labelC is_constr - ; stmtC (CmmJump (CmmLit (CmmLabel lbl)) []) + ; stmtC (CmmJump (entryCode $ CmmLit (CmmLabel lbl)) []) } {- -- This is a scrutinee for a case expression @@ -220,6 +226,7 @@ performTailCall fun_info arg_amodes pending_assts where --cond1 tag = cmmULtWord tag lowCons -- More efficient than the above? +{- tag_expr = cmmGetClosureType (CmmReg nodeReg) cond1 tag = cmmEqWord tag (CmmLit (mkIntCLit 0)) cond2 tag = cmmUGtWord tag highCons @@ -227,11 +234,9 @@ performTailCall fun_info arg_amodes pending_assts -- CONSTR highCons = CmmLit (mkIntCLit 8) -- CONSTR_NOCAF_STATIC (from ClosureType.h) +-} -untagCmmAssign (CmmAssign r cmmExpr) = CmmAssign r (cmmUntag cmmExpr) -untagCmmAssign stmt = stmt - directCall sp lbl args extra_args assts = do let -- First chunk of args go in registers @@ -468,3 +473,4 @@ adjustSpAndHp newRealSp ; setRealHp vHp } \end{code} +