[project @ 2000-01-13 14:33:57 by hwloidl]

Merged GUM-4-04 branch into the main trunk. In particular merged GUM and
SMP code. Most of the GranSim code in GUM-4-04 still has to be carried over.

ghc/compiler/absCSyn/Costs.lhs

 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
-%     Hans Wolfgang Loidl
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
+% $Id: Costs.lhs,v 1.20 2000/01/13 14:33:57 hwloidl Exp $
+%
+% Only needed in a GranSim setup -- HWL
 % ---------------------------------------------------------------------------
 
 \section[Costs]{Evaluating the costs of computing some abstract C code}
@@ -28,9 +30,11 @@ The meaning of the result tuple is:
    instructions.
 \end{itemize}
 
-This function is needed in GrAnSim for parallelism.
+This function is needed in GranSim for costing pieces of abstract C.
 
-These are first suggestions for scaling the costs. But, this scaling should be done in the RTS rather than the compiler (this really should be tunable!):
+These are first suggestions for scaling the costs. But, this scaling should
+be done in the RTS rather than the compiler (this really should be
+tunable!):
 
 \begin{pseudocode}
 
@@ -82,6 +86,7 @@ instance Num CostRes where
  negate	 = mapOp negate
  abs	 = mapOp abs
  signum	 = mapOp signum
+ fromInteger _ = error "fromInteger not defined"
 
 mapOp :: (Int -> Int) -> CostRes -> CostRes
 mapOp g ( Cost (i, b, l, s, f) )  = Cost (g i, g b, g l, g s, g f)
@@ -202,7 +207,10 @@ costs absC =
 
    CSimultaneous absC	     -> costs absC
 
-   CCheck _ amodes code	     -> Cost (2, 1, 0, 0, 0)
+   CCheck _ amodes code	     -> Cost (2, 1, 0, 0, 0) -- ToDo: refine this by 
+                                                     -- looking at the first arg 
+
+   CRetDirect _ _ _ _	     -> nullCosts
 
    CMacroStmt	macro modes  -> stmtMacroCosts macro modes
 
@@ -215,19 +223,28 @@ costs absC =
   -- *** the next three [or so...] are DATA (those above are CODE) ***
   -- as they are data rather than code they all have nullCosts	       -- HWL
 
+   CCallTypedef _ _ _ _      -> nullCosts
+
    CStaticClosure _ _ _ _    -> nullCosts
 
-   CClosureInfoAndCode _ _ _ _ -> nullCosts
+   CSRT _ _                  -> nullCosts
 
-   CRetDirect _ _ _ _	     -> nullCosts
+   CBitmap _ _               -> nullCosts
+
+   CClosureInfoAndCode _ _ _ _ -> nullCosts
 
    CRetVector _ _ _ _        -> nullCosts
 
+   CClosureTbl _             -> nullCosts
+
    CCostCentreDecl _ _	     -> nullCosts
+
    CCostCentreStackDecl _    -> nullCosts
 
    CSplitMarker		     -> nullCosts
 
+   _ -> trace ("Costs.costs") nullCosts
+
 -- ---------------------------------------------------------------------------
 
 addrModeCosts :: CAddrMode -> Side -> CostRes
@@ -242,7 +259,11 @@ addrModeCosts addr_mode side =
     CVal _ _ -> if lhs then Cost (0, 0, 0, 1, 0)
 		       else Cost (0, 0, 1, 0, 0)
 
-    CReg _   -> nullCosts	 {- loading from, storing to reg is free ! -}
+    CAddr (CIndex _ n _ ) -> Cost (1, 0, 1, 0, 0) -- does pointer arithmetic
+
+    CAddr _ -> nullCosts
+
+    CReg _  -> nullCosts	 {- loading from, storing to reg is free ! -}
 				 {- for costing CReg->Creg ops see special -}
 				 {- case in costs fct -}
 
@@ -277,6 +298,8 @@ addrModeCosts addr_mode side =
 
     CMacroExpr _ macro mode_list -> exprMacroCosts side macro mode_list
 
+    _ -> trace ("Costs.addrModeCosts") nullCosts
+
 -- ---------------------------------------------------------------------------
 
 exprMacroCosts :: Side -> CExprMacro -> [CAddrMode] -> CostRes
@@ -288,10 +311,11 @@ exprMacroCosts side macro mode_list =
   in
   arg_costs +
   case macro of
-    ENTRY_CODE -> nullCosts
-    ARG_TAG -> nullCosts -- XXX
-    GET_TAG -> nullCosts -- XXX
-    
+    ENTRY_CODE -> nullCosts -- nothing 
+    ARG_TAG -> nullCosts -- nothing
+    GET_TAG -> Cost (0, 0, 1, 0, 0)  -- indirect load
+    UPD_FRAME_UPDATEE -> Cost (0, 0, 1, 0, 0)  -- indirect load
+    _ -> trace ("Costs.exprMacroCosts") nullCosts
 
 -- ---------------------------------------------------------------------------
 
@@ -309,7 +333,9 @@ stmtMacroCosts macro modes =
     UPD_CAF		  ->  Cost (7, 0, 1, 3, 0)	 {- SMupdate.lh	 -}
     UPD_BH_UPDATABLE	  ->  Cost (3, 0, 0, 1, 0)	 {- SMupdate.lh	 -}
     UPD_BH_SINGLE_ENTRY	  ->  Cost (3, 0, 0, 1, 0)	 {- SMupdate.lh	 -}
-    PUSH_UPD_FRAME	  ->  Cost (3, 0, 0, 4, 0)	 {- SMupdate.lh	 -}
+    PUSH_UPD_FRAME	  ->  Cost (3, 0, 0, 4, 0)	 {- Updates.h	 -}
+    PUSH_SEQ_FRAME	  ->  Cost (2, 0, 0, 3, 0)	 {- StgMacros.h	 !-}
+    UPDATE_SU_FROM_UPD_FRAME -> Cost (1, 0, 1, 0, 0)     {- StgMacros.h	 !-}
     SET_TAG		  ->  nullCosts		    {- COptRegs.lh -}
     GRAN_FETCH			->  nullCosts	  {- GrAnSim bookkeeping -}
     GRAN_RESCHEDULE		->  nullCosts	  {- GrAnSim bookkeeping -}

ghc/compiler/basicTypes/Module.lhs

@@ -285,7 +285,8 @@ getAllFilesMatching :: SearchPath
 		    -> (ModuleHiMap, ModuleHiMap)
 		    -> (FilePath, String) 
 		    -> IO (ModuleHiMap, ModuleHiMap)
-getAllFilesMatching dirs hims (dir_path, suffix) = ( do
+getAllFilesMatching dirs hims (dir_path, suffix) = 
+ do
     -- fpaths entries do not have dir_path prepended
   fpaths  <- getDirectoryContents dir_path
   is_dll <- catch
@@ -297,7 +298,7 @@ getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 		)
 		(\ _ {-don't care-} -> return NotDll)
   return (foldl (addModules is_dll) hims fpaths)
-  )  -- soft failure
+  -- soft failure
       `catch` 
         (\ err -> do
 	      hPutStrLn stderr

ghc/compiler/codeGen/CgCase.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.36 1999/11/01 17:10:06 simonpj Exp $
+% $Id: CgCase.lhs,v 1.37 2000/01/13 14:33:57 hwloidl Exp $
 %
 %********************************************************
 %*							*
@@ -602,9 +602,10 @@ cgAlgDefault gc_flag is_fun uniq cc_slot must_label_branch
   = 	-- We have arranged that Node points to the thing
     restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
     getAbsC (absC restore_cc `thenC`
-             (if opt_GranMacros && emit_yield
-                then yield [node] False
-                else absC AbsCNop)                            `thenC`     
+             -- HWL: maybe need yield here
+             --(if emit_yield
+             --   then yield [node] True
+             --   else absC AbsCNop)                            `thenC`     
 	     possibleHeapCheck gc_flag is_fun [node] [] Nothing (cgExpr rhs)
 	-- Node is live, but doesn't need to point at the thing itself;
 	-- it's ok for Node to point to an indirection or FETCH_ME
@@ -633,9 +634,10 @@ cgAlgAlt gc_flag uniq cc_slot must_label_branch
   = 
     restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
     getAbsC (absC restore_cc `thenC`
-    	     (if opt_GranMacros && emit_yield
-      		then yield [node] True		-- XXX live regs wrong
-      		else absC AbsCNop)                               `thenC`     
+             -- HWL: maybe need yield here
+    	     -- (if emit_yield
+      	     --    then yield [node] True		-- XXX live regs wrong
+      	     --    else absC AbsCNop)                               `thenC`    
     	     (case gc_flag of
 		NoGC   	    -> mapFCs bindNewToTemp args `thenFC` \_ -> nopC
     		GCMayHappen -> bindConArgs con args
@@ -667,9 +669,10 @@ cgUnboxedTupleAlt lbl cc_slot emit_yield (con,args,use_mask,rhs)
         restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
 	absC restore_cc `thenC`
 
-  	(if opt_GranMacros && emit_yield
-  	    then yield live_regs True		-- XXX live regs wrong?
-  	    else absC AbsCNop)                         `thenC`     
+        -- HWL: maybe need yield here
+  	-- (if emit_yield
+  	--    then yield live_regs True		-- XXX live regs wrong?
+  	--    else absC AbsCNop)                         `thenC`     
   	let 
 	      -- ToDo: could maybe use Nothing here if stack_res is False
 	      -- since the heap-check can just return to the top of the 

ghc/compiler/codeGen/CgClosure.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.38 1999/11/11 17:50:49 simonpj Exp $
+% $Id: CgClosure.lhs,v 1.39 2000/01/13 14:33:58 hwloidl Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -40,7 +40,8 @@ import CgUsages		( adjustSpAndHp, setRealAndVirtualSp, getVirtSp,
 			  getSpRelOffset, getHpRelOffset
 			)
 import CLabel		( CLabel, mkClosureLabel, mkFastEntryLabel,
-			  mkRednCountsLabel, mkInfoTableLabel
+			  mkRednCountsLabel, mkInfoTableLabel,
+                          pprCLabel
 			)
 import ClosureInfo	-- lots and lots of stuff
 import CmdLineOpts	( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
@@ -325,7 +326,12 @@ closureCodeBody binder_info closure_info cc all_args body
 	--
     	arg_regs = case entry_conv of
 		DirectEntry lbl arity regs -> regs
-		other 		            -> panic "closureCodeBody:arg_regs"
+		other 		           -> trace ("*** closureCodeBody:arg_regs " ++ (pprHWL entry_conv) ++ "(HWL ignored; no args passed in regs)") []
+
+        pprHWL :: EntryConvention -> String    
+        pprHWL (ViaNode) = "ViaNode"
+        pprHWL (StdEntry cl) = "StdEntry"
+        pprHWL (DirectEntry cl i l) = "DirectEntry"
 
 	num_arg_regs = length arg_regs
 	
@@ -350,7 +356,7 @@ closureCodeBody binder_info closure_info cc all_args body
 	    mapCs bindNewToStack arg_offsets	  	    `thenC`
 	    setRealAndVirtualSp sp_all_args		    `thenC`
 
-	    argSatisfactionCheck closure_info		    `thenC`
+	    argSatisfactionCheck closure_info	arg_regs	    `thenC`
 
 	    -- OK, so there are enough args.  Now we need to stuff as
 	    -- many of them in registers as the fast-entry code
@@ -516,24 +522,24 @@ relative offset of this word tells how many words of arguments
 are expected.
 
 \begin{code}
-argSatisfactionCheck :: ClosureInfo -> Code
+argSatisfactionCheck :: ClosureInfo -> [MagicId] {-GRAN-} -> Code
 
-argSatisfactionCheck closure_info
+argSatisfactionCheck closure_info arg_regs
 
   = nodeMustPointToIt (closureLFInfo closure_info)   `thenFC` \ node_points ->
 
-    let
-       emit_gran_macros = opt_GranMacros
-    in
+--      let
+--         emit_gran_macros = opt_GranMacros
+--      in
 
     -- HWL  ngo' ngoq:
     -- absC (CMacroStmt GRAN_FETCH []) 			`thenC`
     -- forceHeapCheck [] node_points (absC AbsCNop)			`thenC`
-    (if emit_gran_macros 
-      then if node_points 
-             then fetchAndReschedule  [] node_points 
-             else yield [] node_points
-      else absC AbsCNop)                       `thenC`
+    --(if opt_GranMacros
+    --  then if node_points 
+    --         then fetchAndReschedule  arg_regs node_points 
+    --         else yield arg_regs node_points
+    --  else absC AbsCNop)                       `thenC`
 
         getSpRelOffset 0 	`thenFC` \ (SpRel sp) ->
 	let
@@ -565,16 +571,13 @@ thunkWrapper closure_info lbl thunk_code
   = 	-- Stack and heap overflow checks
     nodeMustPointToIt (closureLFInfo closure_info) `thenFC` \ node_points ->
 
-    let
-       emit_gran_macros = opt_GranMacros
-    in
-	-- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
-	-- (we prefer fetchAndReschedule-style context switches to yield ones)
-    (if emit_gran_macros 
-      then if node_points 
-             then fetchAndReschedule  [] node_points 
-             else yield [] node_points
-      else absC AbsCNop)                       `thenC`
+    -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
+    -- (we prefer fetchAndReschedule-style context switches to yield ones)
+    (if opt_GranMacros
+       then if node_points 
+              then fetchAndReschedule [] node_points 
+              else yield [] node_points
+       else absC AbsCNop)                       `thenC`
 
         -- stack and/or heap checks
     thunkChecks lbl node_points (
@@ -597,13 +600,10 @@ funWrapper :: ClosureInfo 	-- Closure whose code body this is
 funWrapper closure_info arg_regs stk_tags info_label fun_body
   = 	-- Stack overflow check
     nodeMustPointToIt (closureLFInfo closure_info)  	`thenFC` \ node_points ->
-    let
-       emit_gran_macros = opt_GranMacros
-    in
     -- HWL   chu' ngoq:
-    (if emit_gran_macros
-      then yield  arg_regs node_points
-      else absC AbsCNop)                                 `thenC`
+    (if opt_GranMacros
+       then yield arg_regs node_points
+       else absC AbsCNop)                                 `thenC`
 
         -- heap and/or stack checks
     fastEntryChecks arg_regs stk_tags info_label node_points (

ghc/compiler/codeGen/CgHeapery.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgHeapery.lhs,v 1.19 1999/10/13 16:39:15 simonmar Exp $
+% $Id: CgHeapery.lhs,v 1.20 2000/01/13 14:33:58 hwloidl Exp $
 %
 \section[CgHeapery]{Heap management functions}
 
@@ -32,7 +32,7 @@ import ClosureInfo	( closureSize, closureGoodStuffSize,
 			)
 import PrimRep		( PrimRep(..), isFollowableRep )
 import Unique		( Unique )
-import CmdLineOpts	( opt_SccProfilingOn )
+import CmdLineOpts	( opt_SccProfilingOn, opt_GranMacros )
 import GlaExts
 import Outputable
 
@@ -78,6 +78,10 @@ fastEntryChecks regs tags ret node_points code
      getTickyCtrLabel `thenFC` \ ticky_ctr ->
 
      ( if all_pointers then -- heap checks are quite easy
+          -- HWL: gran-yield immediately before heap check proper
+          --(if node `elem` regs
+          --   then yield regs True
+          --   else absC AbsCNop ) `thenC`
 	  absC (checking_code stk_words hp_words tag_assts 
 			free_reg (length regs) ticky_ctr)
 
@@ -382,22 +386,22 @@ mkRegLiveness (VanillaReg rep i : regs) | isFollowableRep rep
   =  ((int2Word# 1#) `shiftL#` (i -# 1#)) `or#` mkRegLiveness regs
 mkRegLiveness (_ : regs)  =  mkRegLiveness regs
 
+-- The two functions below are only used in a GranSim setup
 -- Emit macro for simulating a fetch and then reschedule
 
 fetchAndReschedule ::   [MagicId]               -- Live registers
 			-> Bool                 -- Node reqd?
 			-> Code
 
-fetchAndReschedule regs node_reqd  =
+fetchAndReschedule regs node_reqd  = 
       if (node `elem` regs || node_reqd)
 	then fetch_code `thenC` reschedule_code
 	else absC AbsCNop
       where
 	all_regs = if node_reqd then node:regs else regs
-	liveness_mask = 0 {-XXX: mkLiveRegsMask all_regs-}
-
+        liveness_mask = mkRegLiveness regs
 	reschedule_code = absC  (CMacroStmt GRAN_RESCHEDULE [
-				 mkIntCLit liveness_mask,
+                                 mkIntCLit (IBOX(word2Int# liveness_mask)), 
 				 mkIntCLit (if node_reqd then 1 else 0)])
 
 	 --HWL: generate GRAN_FETCH macro for GrAnSim
@@ -423,15 +427,16 @@ yield ::   [MagicId]               -- Live registers
              -> Bool                 -- Node reqd?
              -> Code 
 
-yield regs node_reqd =
-      -- NB: node is not alive; that's why we use DO_YIELD rather than 
-      --     GRAN_RESCHEDULE 
-      yield_code
-      where
-        all_regs = if node_reqd then node:regs else regs
-        liveness_mask = 0 {-XXX: mkLiveRegsMask all_regs-}
-
-        yield_code = absC (CMacroStmt GRAN_YIELD [mkIntCLit liveness_mask])
+yield regs node_reqd = 
+   if opt_GranMacros && node_reqd
+     then yield_code
+     else absC AbsCNop
+   where
+     -- all_regs = if node_reqd then node:regs else regs
+     liveness_mask = mkRegLiveness regs
+     yield_code = 
+       absC (CMacroStmt GRAN_YIELD 
+                          [mkIntCLit (IBOX(word2Int# liveness_mask))])
 \end{code}
 
 %************************************************************************

ghc/compiler/codeGen/CgStackery.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgStackery.lhs,v 1.12 1999/06/24 13:04:20 simonmar Exp $
+% $Id: CgStackery.lhs,v 1.13 2000/01/13 14:33:58 hwloidl Exp $
 %
 \section[CgStackery]{Stack management functions}
 
@@ -25,9 +25,10 @@ import AbsCSyn
 import CgUsages		( getRealSp )
 import AbsCUtils	( mkAbstractCs, mkAbsCStmts, getAmodeRep )
 import PrimRep		( getPrimRepSize, PrimRep(..), isFollowableRep )
-import CmdLineOpts	( opt_SccProfilingOn )
+import CmdLineOpts	( opt_SccProfilingOn, opt_GranMacros )
 import Panic		( panic )
-import Constants	( uF_SIZE, sCC_UF_SIZE, sEQ_FRAME_SIZE, sCC_SEQ_FRAME_SIZE )
+import Constants	( uF_SIZE, sCC_UF_SIZE, gRAN_UF_SIZE, 
+			  sEQ_FRAME_SIZE, sCC_SEQ_FRAME_SIZE, gRAN_SEQ_FRAME_SIZE )
 
 import IOExts		( trace )
 \end{code}
@@ -224,11 +225,13 @@ getFinalStackHW fcode info_down (MkCgState absC binds usages) = state1
 \end{code}
 
 \begin{code}
-updateFrameSize | opt_SccProfilingOn = sCC_UF_SIZE
-		| otherwise          = uF_SIZE
+updateFrameSize | opt_SccProfilingOn = trace ("updateFrameSize = " ++ (show sCC_UF_SIZE)) sCC_UF_SIZE
+		| opt_GranMacros     = trace ("updateFrameSize = " ++ (show gRAN_UF_SIZE))gRAN_UF_SIZE
+		| otherwise          = trace ("updateFrameSize = " ++ (show uF_SIZE)) uF_SIZE
 
 seqFrameSize    | opt_SccProfilingOn  = sCC_SEQ_FRAME_SIZE
-	        | otherwise           = sEQ_FRAME_SIZE
+	        | opt_GranMacros      = gRAN_SEQ_FRAME_SIZE
+		| otherwise           = sEQ_FRAME_SIZE
 \end{code}			
 
 %************************************************************************

ghc/compiler/main/Constants.lhs

@@ -34,6 +34,7 @@ module Constants (
 
 	uF_SIZE,
 	sCC_UF_SIZE,
+	gRAN_UF_SIZE,  -- HWL
 	uF_RET,
 	uF_SU,
 	uF_UPDATEE,
@@ -41,6 +42,7 @@ module Constants (
 
 	sEQ_FRAME_SIZE,
 	sCC_SEQ_FRAME_SIZE,
+	gRAN_SEQ_FRAME_SIZE, -- HWL
 
 	mAX_Vanilla_REG,
 	mAX_Float_REG,
@@ -157,6 +159,9 @@ uF_SIZE	= (NOSCC_UF_SIZE::Int)
 -- Same again, with profiling
 sCC_UF_SIZE = (SCC_UF_SIZE::Int)
 
+-- Same again, with gransim
+gRAN_UF_SIZE = (GRAN_UF_SIZE::Int)
+
 -- Offsets in an update frame.  They don't change with profiling!
 uF_RET         = (UF_RET::Int)
 uF_SU          = (UF_SU::Int)
@@ -169,6 +174,7 @@ Seq frame sizes.
 \begin{code}
 sEQ_FRAME_SIZE = (NOSCC_SEQ_FRAME_SIZE::Int)
 sCC_SEQ_FRAME_SIZE = (SCC_SEQ_FRAME_SIZE::Int)
+gRAN_SEQ_FRAME_SIZE = (GRAN_SEQ_FRAME_SIZE::Int)
 \end{code}
 
 \begin{code}

ghc/compiler/nativeGen/StixMacro.lhs

@@ -122,6 +122,7 @@ macroCode PUSH_UPD_FRAME args
     	frame n = StInd PtrRep
 	    (StIndex PtrRep stgSp (StInt (toInteger (n-uF_SIZE))))
 
+        -- HWL: these values are *wrong* in a GranSim setup; ToDo: fix
 	a1 = StAssign PtrRep (frame uF_RET)     upd_frame_info
 	a3 = StAssign PtrRep (frame uF_SU)      stgSu
 	a4 = StAssign PtrRep (frame uF_UPDATEE) bhptr

ghc/driver/ghc-asm.lprl

@@ -687,6 +687,9 @@ sub mangle_asm {
 		    print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
 		}
 
+		# HWL HACK: dont die, just print a warning
+		#print stderr  "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
+		#    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 		die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
 		    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 
@@ -727,6 +730,9 @@ sub mangle_asm {
 		} else {
 		    print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
 		}
+		# HWL HACK: dont die, just print a warning
+		#print stderr "HWL: this should die! Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
+		#    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 		die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
 		    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 

ghc/driver/ghc.lprl

@@ -1911,6 +1911,7 @@ eval 'exec perl -S \$0 \${1+"\$@"}'
 # =!=!=!=!=!=!=!=!=!=!=!
 # This script is automatically generated: DO NOT EDIT!!!
 # Generated by Glasgow Haskell, version ${ProjectVersion}
+# ngoqvam choHbogh vaj' vIHoHnISbej !!!!
 #
 \$pvm_executable      = '$pvm_executable';
 \$pvm_executable_base = '$pvm_executable_base';
@@ -1942,7 +1943,9 @@ args: while ($a = shift(@ARGV)) {
     }
     if ( $a eq '-d' && $in_RTS_args ) {
 	$debug = '-';
-    } elsif ( $a =~ /^-N(\d+)/ && $in_RTS_args ) {
+    } elsif ( $a =~ /^-qN(\d+)/ && $in_RTS_args ) {
+	$nprocessors = $1;
+    } elsif ( $a =~ /^-qp(\d+)/ && $in_RTS_args ) {
 	$nprocessors = $1;
     } else {
 	push(@nonPVM_args, $a);
@@ -2817,9 +2820,24 @@ sub saveIntermediate {
   local ($final,$suffix,$tmp)= @_ ;
   local ($to_do);
 
+  local ($new_suffix);
+
   # $final  -- root of where to park ${final}.${suffix}
   # $tmp    -- temporary file where hsc put the intermediate file.
 
+  # HWL: use -odir for .hc and .s files, too
+  if ( $Specific_output_dir ne '' ) {
+    $final = "${Specific_output_dir}/${final}";
+  }	
+  # HWL: use the same suffix as for $Osuffix in generating intermediate file,
+  #      replacing o with hc or s, respectively. 
+  if ( $Osuffix ne '' ) {
+    ($new_suffix = $Osuffix) =~ s/o$/hc/ if $suffix eq "hc";
+    ($new_suffix = $Osuffix) =~ s/o$/s/ if $suffix eq "s";
+    $suffix = $new_suffix;
+    print stderr "HWL says: suffix for intermediate file is $suffix; ${final}.${suffix} overall\n" if $Verbose;
+  }
+
   # Delete the old file
   $to_do = "$Rm ${final}.${suffix}"; &run_something($to_do, "Removing old .${suffix} file");
 

ghc/driver/test_mangler

-#! /usr/local/bin/perl
+#! /usr/bin/perl
 # a simple wrapper to test a .s-file mangler
 # reads stdin, writes stdout
 
+push(@INC,"/net/dazdak/BUILDS/gransim-4.04/i386-unknown-linux/ghc/driver");
+
 $TargetPlatform = $ARGV[0]; shift; # nice error checking, Will
 
 require("ghc-asm.prl") || die "require mangler failed!\n";

ghc/includes/CCall.h

 /* -----------------------------------------------------------------------------
- * $Id: CCall.h,v 1.3 1999/02/05 16:02:19 simonm Exp $
+ * $Id: CCall.h,v 1.4 2000/01/13 14:34:00 hwloidl Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -55,6 +55,9 @@
 #define STGCALL5(f,a,b,c,d,e) \
   CALLER_SAVE_ALL (void) f(a,b,c,d,e); CALLER_RESTORE_ALL
 
+#define STGCALL6(f,a,b,c,d,e,z) \
+  CALLER_SAVE_ALL (void) f(a,b,c,d,e,z); CALLER_RESTORE_ALL
+
 
 #define RET_STGCALL0(t,f) \
   ({ t _r; CALLER_SAVE_ALL _r = f(); CALLER_RESTORE_ALL; _r; })
@@ -74,6 +77,9 @@
 #define RET_STGCALL5(t,f,a,b,c,d,e) \
   ({ t _r; CALLER_SAVE_ALL _r = f(a,b,c,d,e); CALLER_RESTORE_ALL; _r; })
 
+#define RET_STGCALL6(t,f,a,b,c,d,e,z) \
+  ({ t _r; CALLER_SAVE_ALL _r = f(a,b,c,d,e,z); CALLER_RESTORE_ALL; _r; })
+
 
 /*
  * A PRIM_STGCALL is used when we have arranged to save the R<n>,
@@ -101,6 +107,9 @@
 #define PRIM_STGCALL5(f,a,b,c,d,e) \
   CALLER_SAVE_SYSTEM (void) f(a,b,c,d,e); CALLER_RESTORE_SYSTEM
 
+#define PRIM_STGCALL6(f,a,b,c,d,e,z) \
+  CALLER_SAVE_SYSTEM (void) f(a,b,c,d,e,z); CALLER_RESTORE_SYSTEM
+
 
 #define RET_PRIM_STGCALL0(t,f) \
   ({ t _r; CALLER_SAVE_SYSTEM _r = f(); CALLER_RESTORE_SYSTEM; _r; })
@@ -120,6 +129,9 @@
 #define RET_PRIM_STGCALL5(t,f,a,b,c,d,e) \
   ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b,c,d,e); CALLER_RESTORE_SYSTEM; _r; })
 
+#define RET_PRIM_STGCALL6(t,f,a,b,c,d,e,z) \
+  ({ t _r; CALLER_SAVE_SYSTEM _r = f(a,b,c,d,e,z); CALLER_RESTORE_SYSTEM; _r; })
+
 /* ToDo: ccalls that might garbage collect - do we need to return to
  * the scheduler to perform these?  Similarly, ccalls that might want
  * to call Haskell right back, or start a new thread or something.

ghc/includes/ClosureTypes.h

 /* ----------------------------------------------------------------------------
- * $Id: ClosureTypes.h,v 1.11 1999/05/11 16:47:40 keithw Exp $
+ * $Id: ClosureTypes.h,v 1.12 2000/01/13 14:34:00 hwloidl Exp $
  * 
  * (c) The GHC Team, 1998-1999
  *
@@ -72,10 +72,15 @@
 #define WEAK		        56
 #define FOREIGN		        57
 #define STABLE_NAME	        58
+
 #define TSO		        59
 #define BLOCKED_FETCH	        60
 #define FETCH_ME                61
-#define EVACUATED               62
-#define N_CLOSURE_TYPES         63
+#define FETCH_ME_BQ             62
+#define RBH                     63
+
+#define EVACUATED               64
+
+#define N_CLOSURE_TYPES         65
 
 #endif CLOSURETYPES_H

ghc/includes/Closures.h

 /* ----------------------------------------------------------------------------
- * $Id: Closures.h,v 1.14 1999/12/01 14:34:48 simonmar Exp $
+ * $Id: Closures.h,v 1.15 2000/01/13 14:34:00 hwloidl Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -37,20 +37,38 @@ typedef struct {
    The parallel header
    -------------------------------------------------------------------------- */
 
-#ifdef GRAN
+#ifdef PAR
 
 typedef struct {
-  W_ procs;
-} StgGranHeader;
+  /* StgWord ga; */  /* nope! global addresses are managed via a hash table */
+} StgParHeader;
 
 #else /* !PAR */
 
 typedef struct {
   /* empty */
-} StgGranHeader;
+} StgParHeader;
 
 #endif /* PAR */
 
+/* -----------------------------------------------------------------------------
+   The GranSim header
+   -------------------------------------------------------------------------- */
+
+#if defined(GRAN)
+
+typedef struct {
+  StgWord procs; /* bitmask indicating on which PEs this closure resides */
+} StgGranHeader;
+
+#else /* !GRAN */
+
+typedef struct {
+  /* empty */
+} StgGranHeader;
+
+#endif /* GRAN */
+
 /* -----------------------------------------------------------------------------
    The ticky-ticky header
 
@@ -96,8 +114,11 @@ typedef struct {
 #ifdef PROFILING
 	StgProfHeader         prof;
 #endif
-#ifdef GRAN
-	StgGranHeader         par;
+#ifdef PAR
+	StgParHeader          par;
+#endif
+#if defined(GRAN)
+	StgGranHeader         gran;
 #endif
 #ifdef TICKY_TICKY
 	StgTickyHeader        ticky;
@@ -187,12 +208,6 @@ typedef struct StgCAF_ {
     struct StgCAF_ *link;
 } StgCAF;
 
-typedef struct {
-    StgHeader  header;
-    struct StgTSO_ *blocking_queue;
-    StgMutClosure *mut_link;
-} StgBlockingQueue;
-
 typedef struct {
     StgHeader  header;
     StgWord    words;
@@ -294,12 +309,71 @@ typedef struct {
   StgClosure*     value;
 } StgMVar;
 
-/* Parallel FETCH_ME closures */
-#ifdef PAR
-typedef struct {
+#if defined(PAR) || defined(GRAN)
+/*
+  StgBlockingQueueElement represents the types of closures that can be 
+  found on a blocking queue: StgTSO, StgRBHSave, StgBlockedFetch.
+  (StgRBHSave can only appear at the end of a blocking queue).  
+  Logically, this is a union type, but defining another struct with a common
+  layout is easier to handle in the code (same as for StgMutClosures).
+*/
+typedef struct StgBlockingQueueElement_ {
+  StgHeader                         header;
+  struct StgBlockingQueueElement_  *link;
+  StgMutClosure                    *mut_link;
+  struct StgClosure_               *payload[0];
+} StgBlockingQueueElement;
+
+typedef struct StgBlockingQueue_ {
+  StgHeader                         header;
+  struct StgBlockingQueueElement_  *blocking_queue;
+  StgMutClosure                    *mut_link;
+} StgBlockingQueue;
+
+/* this closure is hanging at the end of a blocking queue in (par setup only) */
+typedef struct StgRBHSave_ {
   StgHeader    header;
-  void        *ga;		/* type globalAddr is abstract here */
+  StgPtr       payload[0];
+} StgRBHSave;
+
+typedef struct StgRBH_ {
+  StgHeader                                header;
+  struct StgBlockingQueueElement_         *blocking_queue;
+  StgMutClosure                           *mut_link;
+} StgRBH;
+
+#else
+/* old sequential version of a blocking queue, which can only hold TSOs */
+typedef struct StgBlockingQueue_ {
+  StgHeader                 header;
+  struct StgTSO_           *blocking_queue;