Refactor PackageTarget back into StaticTarget

[ghc-hetmet.git] / compiler / codeGen / CgForeignCall.hs

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index ceff757..901dd96 100644 (file)
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -33,7 +33,9 @@ import ClosureInfo
 import Constants
 import StaticFlags
 import Outputable
+import Module
 import FastString
+import BasicTypes
 
 import Control.Monad
 
@@ -76,8 +78,20 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
   where
       (call_args, cmm_target)
        = case target of
-          StaticTarget lbl -> (args, CmmLit (CmmLabel 
-                                       (mkForeignLabel lbl call_size False)))
+          -- If the packageId is Nothing then the label is taken to be in the
+          --   package currently being compiled.
+          StaticTarget lbl mPkgId
+           -> let labelSource 
+                       = case mPkgId of
+                               Nothing         -> ForeignLabelInThisPackage
+                               Just pkgId      -> ForeignLabelInPackage pkgId
+              in ( args
+                 , CmmLit (CmmLabel 
+                               (mkForeignLabel lbl call_size labelSource IsFunction)))
+
+          -- A label imported with "foreign import ccall "dynamic" ..."
+          --   Note: "dynamic" here doesn't mean "dynamic library".
+          --   Read the FFI spec for details.
           DynamicTarget    ->  case args of
                                (CmmHinted fn _):rest -> (rest, fn)
                                [] -> panic "emitForeignCall: DynamicTarget []"
@@ -93,9 +107,6 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
        -- ToDo: this might not be correct for 64-bit API
       arg_size rep = max (widthInBytes (typeWidth rep)) wORD_SIZE
 
-emitForeignCall _ (DNCall _) _ _
-  = panic "emitForeignCall: DNCall"
-
 
 -- alternative entry point, used by CmmParse
 emitForeignCall'
@@ -146,8 +157,8 @@ emitForeignCall' safety results target args vols _srt ret
     emitLoadThreadState
 
 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")))
 
 
 -- we might need to load arguments into temporaries before
@@ -211,7 +222,11 @@ emitLoadThreadState = do
                              bWord),
        -- SpLim = tso->stack + RESERVED_STACK_WORDS;
        CmmAssign spLim (cmmOffsetW (cmmOffset (CmmReg (CmmLocal tso)) tso_STACK)
-                                   rESERVED_STACK_WORDS)
+                                   rESERVED_STACK_WORDS),
+        -- HpAlloc = 0;
+        --   HpAlloc is assumed to be set to non-zero only by a failed
+        --   a heap check, see HeapStackCheck.cmm:GC_GENERIC
+        CmmAssign hpAlloc (CmmLit zeroCLit)
     ]
   emitOpenNursery
   -- and load the current cost centre stack from the TSO when profiling:
@@ -266,13 +281,14 @@ stgHp               = CmmReg hp
 stgCurrentTSO    = CmmReg currentTSO
 stgCurrentNursery = CmmReg currentNursery
 
-sp, spLim, hp, hpLim, currentTSO, currentNursery :: CmmReg
+sp, spLim, hp, hpLim, currentTSO, currentNursery, hpAlloc :: CmmReg
 sp               = CmmGlobal Sp
 spLim            = CmmGlobal SpLim
 hp               = CmmGlobal Hp
 hpLim            = CmmGlobal HpLim
 currentTSO       = CmmGlobal CurrentTSO
 currentNursery           = CmmGlobal CurrentNursery
+hpAlloc          = CmmGlobal HpAlloc
 
 -- -----------------------------------------------------------------------------
 -- For certain types passed to foreign calls, we adjust the actual