X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSGen.hs;h=924ce9d4abb19f1802b34278c1c21be45c98c122;hp=b5f51a98b95162f5ed44f685114a4cf4db823e02;hb=83d563cb9ede0ba792836e529b1e2929db926355;hpb=79d422b3a9e89f0d6dc3ad2383b2c8bd33b5a1d2 diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs index b5f51a9..924ce9d 100644 --- a/compiler/cmm/CmmCPSGen.hs +++ b/compiler/cmm/CmmCPSGen.hs @@ -20,11 +20,11 @@ import CgInfoTbls import SMRep import ForeignCall +import Module import Constants import StaticFlags import Unique -import Maybe -import List +import Data.Maybe import FastString import Panic @@ -232,7 +232,9 @@ foreignCall uniques call results arguments = caller_save ++ [CmmCall (CmmCallee suspendThread CCallConv) [ CmmHinted id AddrHint ] - [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint ] + [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint + -- XXX: allow for interruptible suspension + , CmmHinted (CmmLit (CmmInt 0 wordWidth)) NoHint ] CmmUnsafe CmmMayReturn, CmmCall call results new_args CmmUnsafe CmmMayReturn, @@ -260,8 +262,8 @@ foreignCall uniques call results arguments = -- Save/restore the thread state in the TSO suspendThread, resumeThread :: CmmExpr -suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread"))) -resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread"))) +suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread"))) +resumeThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread"))) -- This stuff can't be done in suspendThread/resumeThread, because it -- refers to global registers which aren't available in the C world.