[project @ 2000-05-15 15:03:36 by simonmar]

I lied earlier.  _ccall_GC_ should work now.

ghc/compiler/absCSyn/AbsCSyn.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: AbsCSyn.lhs,v 1.29 2000/03/23 17:45:17 simonpj Exp $
+% $Id: AbsCSyn.lhs,v 1.30 2000/05/15 15:03:36 simonmar Exp $
 %
 \section[AbstractC]{Abstract C: the last stop before machine code}
 
@@ -473,6 +473,9 @@ data MagicId
 	PrimRep	        -- Int64Rep or Word64Rep
 	FAST_INT	-- its number (1 .. mAX_Long_REG)
 
+  | CurrentTSO		-- pointer to current thread's TSO
+  | CurrentNursery	-- pointer to allocation area
+
 
 node 	= VanillaReg PtrRep     ILIT(1) -- A convenient alias for Node
 tagreg  = VanillaReg WordRep    ILIT(2) -- A convenient alias for TagReg

ghc/compiler/absCSyn/AbsCUtils.lhs

@@ -133,6 +133,8 @@ magicIdPrimRep Hp		    = PtrRep
 magicIdPrimRep HpLim		    = PtrRep
 magicIdPrimRep CurCostCentre	    = CostCentreRep
 magicIdPrimRep VoidReg		    = VoidRep
+magicIdPrimRep CurrentTSO	    = ThreadIdRep
+magicIdPrimRep CurrentNursery	    = PtrRep
 \end{code}
 
 %************************************************************************

ghc/compiler/absCSyn/CLabel.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.33 2000/04/13 11:56:35 simonpj Exp $
+% $Id: CLabel.lhs,v 1.34 2000/05/15 15:03:36 simonmar Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -418,7 +418,7 @@ pprCLbl (CaseLabel u CaseBitmap)
 
 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
 
-pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("Upd_frame_info")
+pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("upd_frame_info")
 
 pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
 

ghc/compiler/nativeGen/MachRegs.lhs

@@ -584,6 +584,8 @@ baseRegOffset (LongReg _ ILIT(2))    = OFFSET_Lng2
 #endif
 baseRegOffset Hp		     = OFFSET_Hp
 baseRegOffset HpLim		     = OFFSET_HpLim
+baseRegOffset CurrentTSO	     = OFFSET_CurrentTSO
+baseRegOffset CurrentNursery	     = OFFSET_CurrentNursery
 #ifdef DEBUG
 baseRegOffset BaseReg		     = panic "baseRegOffset:BaseReg"
 baseRegOffset CurCostCentre	     = panic "baseRegOffset:CurCostCentre"
@@ -657,6 +659,12 @@ callerSaves Hp				= True
 #ifdef CALLER_SAVES_HpLim
 callerSaves HpLim			= True
 #endif
+#ifdef CALLER_SAVES_CurrentTSO
+callerSaves CurrentTSO			= True
+#endif
+#ifdef CALLER_SAVES_CurrentNursery
+callerSaves CurrentNursery		= True
+#endif
 callerSaves _				= False
 \end{code}
 
@@ -735,6 +743,12 @@ magicIdRegMaybe Hp		   	= Just (FixedReg ILIT(REG_Hp))
 #ifdef REG_HpLim      			
 magicIdRegMaybe HpLim		   	= Just (FixedReg ILIT(REG_HpLim))
 #endif	    				
+#ifdef REG_CurrentTSO      			
+magicIdRegMaybe CurrentTSO	   	= Just (FixedReg ILIT(REG_CurrentTSO))
+#endif	    				
+#ifdef REG_CurrentNursery      			
+magicIdRegMaybe CurrentNursery	   	= Just (FixedReg ILIT(REG_CurrentNursery))
+#endif	    				
 magicIdRegMaybe _		   	= Nothing
 \end{code}
 

ghc/compiler/nativeGen/RegAllocInfo.lhs

@@ -437,8 +437,8 @@ regUsage instr = case instr of
     usageM (OpReg reg)    = mkRU [reg] [reg]
     usageM (OpAddr ea)    = mkRU (use_EA ea) []
 
-    --callClobberedRegs = [ eax, ecx, edx ] -- according to gcc, anyway.
-    callClobberedRegs = [eax,fake0,fake1,fake2,fake3,fake4,fake5]
+    -- caller-saves registers
+    callClobberedRegs = [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
 
     -- Registers defd when an operand is written.
     def_W (OpReg reg)  = [reg]

ghc/compiler/nativeGen/Stix.lhs

@@ -9,7 +9,8 @@ module Stix (
         stixCountTempUses, stixSubst,
 
 	stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, 
-        stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
+        stgHp, stgHpLim, stgTagReg, stgR9, stgR10, 
+	stgCurrentTSO, stgCurrentNursery,
 
 	fixedHS, arrWordsHS, arrPtrsHS,
 
@@ -227,6 +228,8 @@ stgSu 		    = StReg (StixMagicId Su)
 stgSpLim	    = StReg (StixMagicId SpLim)
 stgHp		    = StReg (StixMagicId Hp)
 stgHpLim	    = StReg (StixMagicId HpLim)
+stgCurrentTSO	    = StReg (StixMagicId CurrentTSO)
+stgCurrentNursery   = StReg (StixMagicId CurrentNursery)
 stgR9               = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
 stgR10              = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
 

ghc/compiler/nativeGen/StixMacro.lhs

@@ -205,7 +205,7 @@ bh_info, ind_static_info, ind_info :: StixTree
 bh_info   	= sStLitLbl SLIT("BLACKHOLE_info")
 ind_static_info	= sStLitLbl SLIT("IND_STATIC_info")
 ind_info  	= sStLitLbl SLIT("IND_info")
-upd_frame_info	= sStLitLbl SLIT("Upd_frame_info")
+upd_frame_info	= sStLitLbl SLIT("upd_frame_info")
 seq_frame_info	= sStLitLbl SLIT("seq_frame_info")
 
 -- Some common call trees

ghc/compiler/nativeGen/StixPrim.lhs

@@ -14,17 +14,18 @@ import StixInteger
 
 import AbsCSyn 		hiding ( spRel )
 import AbsCUtils	( getAmodeRep, mixedTypeLocn )
-import Constants	( uF_UPDATEE )
 import SMRep		( fixedHdrSize )
 import Literal		( Literal(..), word2IntLit )
 import CallConv		( cCallConv )
 import PrimOp		( PrimOp(..), CCall(..), CCallTarget(..) )
 import PrimRep		( PrimRep(..), isFloatingRep )
 import UniqSupply	( returnUs, thenUs, getUniqueUs, UniqSM )
-import Constants	( mIN_INTLIKE )
+import Constants	( mIN_INTLIKE, uF_UPDATEE, bLOCK_SIZE )
 import Outputable
 
-import Char	       	( ord )
+import Char	       	( ord, isAlphaNum )
+
+#include "NCG.h"
 \end{code}
 
 The main honcho here is primCode, which handles the guts of COpStmts.
@@ -242,14 +243,17 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
   | is_asm = error "ERROR: Native code generator can't handle casm"
   | not may_gc = returnUs (\xs -> ccall : xs)
   | otherwise =
+	save_thread_state	`thenUs` \ save ->
+	load_thread_state	`thenUs` \ load -> 
 	getUniqueUs		`thenUs` \ uniq -> 
 	let
-	   id = StReg (StixTemp uniq IntRep)
+	   id  = StReg (StixTemp uniq IntRep)
+
     	   suspend = StAssign IntRep id 
 			(StCall SLIT("suspendThread") cconv IntRep [stgBaseReg])
 	   resume  = StCall SLIT("resumeThread") cconv VoidRep [id]
 	in
-	returnUs (\xs -> suspend : ccall : resume : xs)
+	returnUs (\xs -> save (suspend : ccall : resume : load xs))
 
   where
     args = map amodeCodeForCCall rhs
@@ -459,12 +463,11 @@ amodeToStix (CMacroExpr _ macro [arg])
 
 litLitToStix :: String -> StixTree
 litLitToStix nm
-   = case nm of
-        "stdout" -> stixFor_stdout
-        "stderr" -> stixFor_stderr
-        "stdin"  -> stixFor_stdin
-        other    -> error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" 
+  | all is_id nm = StLitLbl (text nm)
+  | otherwise    = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" 
                            ++ "suggested workaround: use flag -fvia-C\n")
+
+  where is_id c = isAlphaNum c || c == '_'
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays
@@ -495,3 +498,62 @@ mutArrPtrsFrozen_info = sStLitLbl SLIT("MUT_ARR_PTRS_FROZEN_info")
 charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 intLikeSize  = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 \end{code}
+
+
+\begin{code}
+save_thread_state 
+   = getUniqueUs   `thenUs` \tso_uq -> 
+     let tso = StReg (StixTemp tso_uq ThreadIdRep) in
+     returnUs (\xs ->
+	StAssign ThreadIdRep tso stgCurrentTSO :
+	StAssign PtrRep
+	   (StInd PtrRep (StPrim IntAddOp 
+		[tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))]))
+	   stgSp :
+	StAssign PtrRep 
+	   (StInd PtrRep (StPrim IntAddOp 
+		[tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))]))
+	   stgSu :
+	StAssign PtrRep 
+	   (StInd PtrRep (StPrim IntAddOp 
+		[tso, StInt (toInteger (TSO_SPLIM*BYTES_PER_WORD))]))
+	   stgSpLim :
+	StAssign PtrRep
+	   (StInd PtrRep (StPrim IntAddOp
+		[stgCurrentNursery, 
+		 StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]))
+	   (StPrim IntAddOp [stgHp, StInt (toInteger (1 * BYTES_PER_WORD))]) :
+	xs
+     )
+
+load_thread_state 
+   = getUniqueUs   `thenUs` \tso_uq -> 
+     let tso = StReg (StixTemp tso_uq ThreadIdRep) in
+     returnUs (\xs ->
+	StAssign ThreadIdRep tso stgCurrentTSO :
+	StAssign PtrRep stgSp
+	   (StInd PtrRep (StPrim IntAddOp 
+		[tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) :
+	StAssign PtrRep stgSu
+	   (StInd PtrRep (StPrim IntAddOp 
+		[tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) :
+	StAssign PtrRep stgSpLim
+	   (StInd PtrRep (StPrim IntAddOp 
+		[tso, StInt (toInteger (TSO_SPLIM*BYTES_PER_WORD))])) :
+	StAssign PtrRep stgHp
+	   (StPrim IntSubOp [
+	      StInd PtrRep (StPrim IntAddOp
+		[stgCurrentNursery, 
+		 StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]),
+	      StInt (toInteger (1 * BYTES_PER_WORD))
+	    ]) :
+	StAssign PtrRep stgHpLim
+	   (StPrim IntAddOp [
+	      StInd PtrRep (StPrim IntAddOp
+		[stgCurrentNursery, 
+		 StInt (toInteger (BDESCR_START * BYTES_PER_WORD))]),
+	      StInt (toInteger (bLOCK_SIZE - (1 * BYTES_PER_WORD)))
+	    ]) :
+	xs
+     )
+\end{code}