haskell-cnc-0.1.3.200: Intel/Cnc4.hs

{-# LANGUAGE FlexibleInstances
  , BangPatterns
  , MagicHash 
  , ScopedTypeVariables
  , TypeFamilies 
  , UndecidableInstances
  , OverlappingInstances
  , DeriveDataTypeable
  , MultiParamTypeClasses
  , NamedFieldPuns
  #-}
-- State monad transformer is needed for both step & graph:
#ifndef MODNAME
#define MODNAME Intel.Cnc4
#endif
#define CNC_SCHEDULER 4
#define STEPLIFT  S.lift$
#define GRAPHLIFT S.lift$
#define SUPPRESS_runGraph
#define DEFINED_free_items
#include "Cnc.Header.hs"

------------------------------------------------------------
-- Version 4: Global work queue and worker threads that spin until
-- execution is finished.  Note, this ALSO includes the mortal threads
-- business from version 6.

#include "shared_5_6.hs"


-- FIXME: TODO: This version needs the Mortal threads mechanism in version 6...
-- Otherwise it creates extra threads that SPIN, which is terrible.

----------------------------------------------------------------------------------------------------
 
get col tag = ver5_6_core_get (return ()) col tag

-- get col tag = 
--  do (HiddenState5 { stack, mortal }) <- S.get
--     let io = do myId  <- myThreadId	      
--  	        modifyHotVar_ mortal (Set.insert myId)
--     ver5_6_core_get io col tag


-- At finalize time we set up the workers and run them.
finalize userFinalAction = 
    do (state @ HiddenState5 { stack, numworkers, mortal } ) <- S.get
       
       let worker id = 
	       do x <- STEPLIFT tryPop stack
                  let lifecheck = 
		        do myId <- STEPLIFT myThreadId
			   set  <- STEPLIFT readHotVar mortal
			   return (Set.notMember myId set)
		  case x of 
		    Nothing -> do n <- STEPLIFT readHotVar numworkers
				  --STEPLIFT putStrLn$ "NUM WORKERS IS " ++ show n++"\n"
				  -- numWorkers == 0 implies a message to shutdown.
				  if n == 0 
				   then do --STEPLIFT putStrLn$ "================ SHUTTING DOWN "++ show id ++"=============="
					   return ()					
				   else do -- A mortal thread should never spin:
					   b <- lifecheck
					   if b 
					    -- Should we be cooperative by sleeping a little?
					    --System.Posix.usleep 1000
					    then do STEPLIFT yield
						    worker id
					    else return ()
		    Just action -> do action
				      b <- lifecheck
				      if b then worker id else return ()

       let finalAction = 
	    do S.modify$ \stt -> stt { myid = numCapabilities-1 }

               val <- userFinalAction
	       -- UGLY Convention: reusing numworkers variable that's already in the type:
	       -- This variable becomes a "command" rather than diagnosing the current state.  Zero means stop working.
	       STEPLIFT writeHotVar numworkers 0 -- Shut workers down (eventually).
	       --STEPLIFT putStrLn$ " ..............>>>>>>>>>>>>>>>>>>> Initiated shutdown...........\n"
	       return val

       -- The final action will itself be one of the threads and it
       -- will replace itself when it blocks on a get.  Therefore we
       -- request one fewer worker:
       --ver5_6_core_finalize joiner finalAction worker False (numCapabilities-1)
       -- 
       -- FIXME: TODO: Currently having inexplicable problems on embarassingly_par with the N-1 approach.
       -- For now oversubscribing intentionally as the lesser of evils:
       ver5_6_core_finalize (error "joiner unused") finalAction worker False numCapabilities (\_ -> return ())

------------------------------------------------------------

quiescence_support = False