X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgForeignCall.hs;h=957651d3bae8567b6438eceb65df9ace8fd17c48;hb=fb6d198f498d4e325a540f28aaa6e1d1530839c3;hp=ceff757d3dc56206844cf910100614e82b11d42d;hpb=df52f1e0bbaaadf48757b56b1aa9115fdce1a20c;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index ceff757..957651d 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -34,6 +34,7 @@ import Constants
 import StaticFlags
 import Outputable
 import FastString
+import BasicTypes
 
 import Control.Monad
 
@@ -77,7 +78,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
       (call_args, cmm_target)
 	= case target of
 	   StaticTarget lbl -> (args, CmmLit (CmmLabel 
-					(mkForeignLabel lbl call_size False)))
+					(mkForeignLabel lbl call_size False IsFunction)))
 	   DynamicTarget    ->  case args of
 	                        (CmmHinted fn _):rest -> (rest, fn)
 	                        [] -> panic "emitForeignCall: DynamicTarget []"
@@ -93,9 +94,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'
@@ -211,7 +209,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 +268,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