pass arguments to unknown function calls in registers

[ghc-hetmet.git] / ghc / compiler / codeGen / CgCase.lhs

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index bdacd27..e7c0894 100644 (file)
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.71 2004/09/30 10:35:36 simonpj Exp $
+% $Id: CgCase.lhs,v 1.75 2005/06/21 10:44:41 simonmar Exp $
 %
 %********************************************************
 %*                                                     *
@@ -48,7 +48,7 @@ import CmmUtils               ( CmmStmts, noStmts, oneStmt, plusStmts )
 import Cmm
 import MachOp          ( wordRep )
 import ClosureInfo     ( mkLFArgument )
-import CmdLineOpts     ( opt_SccProfilingOn )
+import StaticFlags     ( opt_SccProfilingOn )
 import Id              ( Id, idName, isDeadBinder, idType )
 import ForeignCall     ( ForeignCall(..), CCallSpec(..), playSafe )
 import VarSet          ( varSetElems )
@@ -171,7 +171,7 @@ cgCase (StgOpApp op@(StgFCallOp fcall _) args _)
        live_in_whole_case live_in_alts bndr srt alt_type alts
   | unsafe_foreign_call
   = ASSERT( isSingleton alts )
-    do -- *must* be an unboxed tuple alt.
+    do --  *must* be an unboxed tuple alt.
        -- exactly like the cgInlinePrimOp case for unboxed tuple alts..
        { res_tmps <- mapFCs bindNewToTemp non_void_res_ids
        ; let res_hints = map (typeHint.idType) non_void_res_ids
@@ -336,9 +336,10 @@ cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
                -- Bind the default binder if necessary
                -- (avoiding it avoids the assignment)
                -- The deadness info is set by StgVarInfo
+       ; hmods <- getHomeModules
        ; whenC (not (isDeadBinder bndr))
                (do { tmp_reg <- bindNewToTemp bndr
-                   ; stmtC (CmmAssign tmp_reg (tagToClosure tycon tag_amode)) })
+                   ; stmtC (CmmAssign tmp_reg (tagToClosure hmods tycon tag_amode)) })
 
                -- Compile the alts
        ; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
@@ -470,7 +471,7 @@ are inlined alternatives.
 \begin{code}
 cgAlgAlts :: GCFlag
        -> Maybe VirtualSpOffset
-       -> AltType                              -- ** AlgAlt or PolyAlt only **
+       -> AltType                              --  ** AlgAlt or PolyAlt only **
        -> [StgAlt]                             -- The alternatives
        -> FCode ( [(ConTagZ, CgStmts)], -- The branches
                  Maybe CgStmts )       -- The default case
@@ -490,7 +491,7 @@ cgAlgAlts gc_flag cc_slot alt_type alts
 
 cgAlgAlt :: GCFlag
         -> Maybe VirtualSpOffset       -- Turgid state
-        -> AltType                     -- ** AlgAlt or PolyAlt only **
+        -> AltType                     --  ** AlgAlt or PolyAlt only **
         -> StgAlt
         -> FCode (AltCon, CgStmts)