[project @ 1996-01-08 20:28:12 by partain]

Initial revision

1 files changed, 843 insertions, 0 deletions

diff --git a/ghc/includes/Threads.lh b/ghc/includes/Threads.lh
new file mode 100644
index 0000000000..f08ab9b7a9
--- /dev/null
+++ b/ghc/includes/Threads.lh
@@ -0,0 +1,843 @@
+%
+% (c) The GRASP Project, Glasgow University, 1994-1995
+%
+\section[Thread]{Thread support macros used in \tr{.hc} files}
+
+\begin{code}
+#ifndef THREADS_H
+#define THREADS_H
+\end{code}
+
+\begin{code}
+#ifndef GRAN 
+#define GRAN_ALLOC_HEAP(n,liveness) 			/* nothing */
+#define GRAN_UNALLOC_HEAP(n,liveness) 			/* nothing */
+#define GRAN_FETCH()					/* nothing */
+#define GRAN_FETCH_AND_RESCHEDULE(liveness)		/* nothing */
+#define GRAN_RESCHEDULE(liveness, reenter)		/* nothing */
+#define GRAN_EXEC(arith,branch,loads,stores,floats)	/* nothing */
+#define GRAN_SPARK()					/* nothing */
+#endif
+\end{code}
+
+\begin{code}
+#ifndef CONCURRENT
+
+#define OR_CONTEXT_SWITCH
+
+#else
+
+#define	DEFAULT_MAX_THREADS    	    	(32)
+
+extern I_ do_gr_sim;	    	    	    	/* Are we simulating granularity? */
+extern FILE *gr_file;
+
+extern I_ do_qp_prof;	    	    	    	/* Are we quasi-parallel profiling? */
+extern FILE *qp_file;
+
+#ifdef PAR
+#define DO_QP_PROF 0
+#else
+#define DO_QP_PROF do_qp_prof
+#endif
+
+extern I_ MaxThreads;
+
+extern I_ context_switch;	    	    	/* Flag set by signal handler */
+extern I_ contextSwitchTime;
+#if defined(USE_COST_CENTRES) || defined(GUM)
+extern I_ contextSwitchTicks;
+#endif
+
+#define CS_MAX_FREQUENCY	100		  	/* context switches per second */
+#define CS_MIN_MILLISECS	(1000/CS_MAX_FREQUENCY)	/* milliseconds per slice */
+
+#ifdef __STG_GCC_REGS__
+#define OR_CONTEXT_SWITCH || context_switch
+#else
+#define OR_CONTEXT_SWITCH /* in miniInterpret */
+#endif
+
+#define REQUIRED_POOL 	0
+#define ADVISORY_POOL 	1
+#define SPARK_POOLS 	2
+
+#ifndef GRAN
+
+extern PP_ PendingSparksBase[SPARK_POOLS], PendingSparksLim[SPARK_POOLS];
+extern PP_ PendingSparksHd[SPARK_POOLS], PendingSparksTl[SPARK_POOLS];
+
+extern I_ SparkLimit[SPARK_POOLS];
+
+extern P_ RunnableThreadsHd, RunnableThreadsTl;
+extern P_ WaitingThreadsHd, WaitingThreadsTl;
+
+#define DEFAULT_MAX_LOCAL_SPARKS 100
+
+extern I_ MaxLocalSparks;
+
+IF_RTS(extern void AwaitEvent(I_);)
+
+#else /* GRAN */
+
+extern sparkq PendingSparksHd[][SPARK_POOLS], PendingSparksTl[][SPARK_POOLS];
+extern P_ RunnableThreadsHd[], RunnableThreadsTl[],
+          WaitThreadsHd[], WaitThreadsTl[];
+
+#define SparkQueueHd	PendingSparksHd[CurrentProc][ADVISORY_POOL]
+#define SparkQueueTl	PendingSparksTl[CurrentProc][ADVISORY_POOL]
+#define ThreadQueueHd	RunnableThreadsHd[CurrentProc]
+#define ThreadQueueTl	RunnableThreadsTl[CurrentProc]
+#define WaitingThreadsHd  WaitThreadsHd[CurrentProc]
+#define WaitingThreadsTl  WaitThreadsTl[CurrentProc]
+
+#endif  /* GRAN */
+
+IF_RTS(extern void PruneSparks(STG_NO_ARGS);)
+
+#ifdef GRAN
+
+/* Codes that can be used as params for ReSchedule */
+/* I distinguish them from the values 0/1 in the -UGRAN setup for security */
+/* reasons */
+#define FIND_THREAD	10
+#define SAME_THREAD	11
+#define NEW_THREAD	SAME_THREAD
+#define CHANGE_THREAD	13
+
+#define MAX_PROC (BITS_IN(W_))			/* Maximum number of PEs that can be simulated */
+extern W_ max_proc;
+
+extern W_ IdleProcs, Idlers; 
+
+extern unsigned CurrentProc;
+extern W_ CurrentTime[];
+extern W_ SparksAvail, SurplusThreads;
+
+/* Processor numbers to bitmasks and vice-versa */
+#define MainProc	     0
+
+#define PE_NUMBER(n)          (1l << (long)n)
+#define ThisPE		      PE_NUMBER(CurrentProc)
+#define MainPE		      PE_NUMBER(MainProc)
+
+#define IS_LOCAL_TO(ga,proc)  ((1l << (long) proc) & ga)
+
+/* These constants should eventually be program parameters */
+
+/* Communication Cost Model (EDS-like), max_proc > 2. */
+
+#define LATENCY		           1000	/* Latency for single packet */
+#define ADDITIONAL_LATENCY	    100	/* Latency for additional packets */
+#define BASICBLOCKTIME	    	     10
+#define FETCHTIME	  	(LATENCY*2+MSGUNPACKTIME)
+#define LOCALUNBLOCKTIME  	     10
+#define GLOBALUNBLOCKTIME 	(LATENCY+MSGUNPACKTIME)
+
+extern W_ gran_latency, gran_additional_latency, gran_fetchtime, 
+          gran_lunblocktime, gran_gunblocktime;
+
+#define	MSGPACKTIME		     0  /* Cost of creating a packet */
+#define	MSGUNPACKTIME		     0  /* Cost of receiving a packet */
+
+extern W_ gran_mpacktime, gran_mtidytime, gran_munpacktime;
+
+/* Thread cost model */
+#define THREADCREATETIME	   (25+THREADSCHEDULETIME)
+#define THREADQUEUETIME		    12  /* Cost of adding a thread to the running/runnable queue */
+#define THREADDESCHEDULETIME	    75  /* Cost of descheduling a thread */
+#define THREADSCHEDULETIME	    75  /* Cost of scheduling a thread */
+#define THREADCONTEXTSWITCHTIME	    (THREADDESCHEDULETIME+THREADSCHEDULETIME)
+
+extern W_ gran_threadcreatetime, gran_threadqueuetime, 
+          gran_threadscheduletime, gran_threaddescheduletime, 
+          gran_threadcontextswitchtime;
+
+/* Instruction Cost model (SPARC, including cache misses) */
+#define ARITH_COST	     	   1
+#define BRANCH_COST	     	   2
+#define LOAD_COST	  	   4
+#define STORE_COST	  	   4
+#define FLOAT_COST		   1 /* ? */
+
+extern W_ gran_arith_cost, gran_branch_cost, 
+          gran_load_cost, gran_store_cost, gran_float_cost,
+          gran_heapalloc_cost;
+
+/* Miscellaneous Parameters */
+extern I_ DoFairSchedule;
+extern I_ DoReScheduleOnFetch;
+extern I_ SimplifiedFetch;
+extern I_ DoStealThreadsFirst;
+extern I_ DoAlwaysCreateThreads;
+extern I_ DoThreadMigration;
+extern I_ DoGUMMFetching;
+extern I_ FetchStrategy;
+extern I_ PreferSparksOfLocalNodes;
+/* These come from debug options -bD? */
+extern I_ NoForward;
+extern I_ PrintFetchMisses, fetch_misses;
+#if defined(COUNT)
+extern I_ nUPDs, nUPDs_old, nUPDs_new, nUPDs_BQ, nPAPs, BQ_lens;
+#endif
+
+extern I_ do_gr_binary;
+extern I_ do_gr_profile;
+extern I_ no_gr_profile;
+extern I_ do_sp_profile;
+
+extern I_ NeedToReSchedule;
+
+extern void GranSimAllocate                PROTO((I_, P_, W_));
+extern void GranSimUnAllocate              PROTO((I_, P_, W_));
+extern I_   GranSimFetch                   PROTO((P_));
+extern void GranSimExec                    PROTO((W_,W_,W_,W_,W_));
+extern void GranSimSpark                   PROTO((W_,P_));
+extern void GranSimBlock                   PROTO(());
+extern void PerformReschedule              PROTO((W_, W_));
+
+#if 0   /* 'ngo Dochmey */
+
+#define GRAN_ALLOC_HEAP(n,liveness)	   STGCALL3(void,(),GranSimAllocate,n,0,0)
+#define GRAN_UNALLOC_HEAP(n,liveness)	   STGCALL3(void,(),GranSimUnallocate,n,0,0)
+
+#define GRAN_FETCH()			   STGCALL1(I_,(),GranSimFetch,Node)
+
+#define GRAN_FETCH_AND_RESCHEDULE(liveness_mask)	\
+	do { if(liveness_mask&LIVENESS_R1)  \
+             STGCALL1(I_,(),GranSimFetch,Node); \
+	     GRAN_RESCHEDULE(liveness_mask,1);	\
+	   } while(0)
+
+#define GRAN_RESCHEDULE(liveness_mask,reenter)	\
+        STGCALL2_GC(void,(),     \
+	         PerformReschedule,liveness_mask,reenter)
+
+#define THREAD_CONTEXT_SWITCH(liveness_mask,reenter)	\
+        do { \
+	if (context_switch /* OR_INTERVAL_EXPIRED */) {	\
+          GRAN_RESCHEDULE(liveness_mask,reenter); \
+        } }while(0)
+
+#define GRAN_EXEC(arith,branch,load,store,floats)	\
+					STGCALL5(void,(),GranSimExec,arith,branch,load,store,floats)
+
+
+#else  /* 1 */ /* chu' Dochmey */
+
+#define GRAN_ALLOC_HEAP(n,liveness)	   \
+	SaveAllStgRegs();		   \
+	GranSimAllocate(n,0,0);            \
+	RestoreAllStgRegs();
+
+#define GRAN_UNALLOC_HEAP(n,liveness)	   \
+	SaveAllStgRegs();		   \
+	GranSimUnallocate(n,0,0); 	   \
+	RestoreAllStgRegs();
+
+#define GRAN_FETCH()			   \
+	SaveAllStgRegs();		   \
+	GranSimFetch(Node);		   \
+	RestoreAllStgRegs();
+
+#define GRAN_FETCH_AND_RESCHEDULE(liveness_mask)	\
+	do { if(liveness_mask&LIVENESS_R1)  		\
+	     SaveAllStgRegs();		   	\
+             GranSimFetch(Node); 			\
+	     RestoreAllStgRegs();			\
+	     GRAN_RESCHEDULE(liveness_mask,1);		\
+	   } while(0)
+
+#define GRAN_RESCHEDULE(liveness_mask,reenter)	\
+        PerformReschedule_wrapper(liveness_mask,reenter)
+
+#define THREAD_CONTEXT_SWITCH(liveness_mask,reenter)	\
+        do { \
+	if (context_switch /* OR_INTERVAL_EXPIRED */) {	\
+          GRAN_RESCHEDULE(liveness_mask,reenter); \
+        } }while(0)
+
+#define GRAN_EXEC(arith,branch,load,store,floats)	\
+	SaveAllStgRegs();		   		\
+	GranSimExec(arith,branch,load,store,floats); 	\
+	RestoreAllStgRegs();
+
+#endif
+	
+
+#define ADD_TO_SPARK_QUEUE(spark)			\
+    SPARK_NEXT(spark) = NULL;				\
+    SPARK_PREV(spark) = PendingSparksTl[CurrentProc][ADVISORY_POOL];	\
+    if (PendingSparksHd[CurrentProc][ADVISORY_POOL] == NULL)		\
+	PendingSparksHd[CurrentProc][ADVISORY_POOL] = spark;		\
+    else						\
+	SPARK_NEXT(PendingSparksTl[CurrentProc][ADVISORY_POOL]) = spark;	\
+    PendingSparksTl[CurrentProc][ADVISORY_POOL] = spark;		\
+
+#endif     /* GRAN */
+
+extern P_ CurrentTSO;	    	    	    	/* thread state object now in use */
+
+extern P_ AvailableStack;
+extern P_ AvailableTSO;
+
+extern I_ threadId;
+
+void ScheduleThreads PROTO((P_ topClosure));
+#if defined(GRAN)
+void ReSchedule PROTO((int what_next)) STG_NORETURN;
+#else
+void ReSchedule PROTO((int again)) STG_NORETURN;
+#endif
+void EndThread(STG_NO_ARGS) STG_NORETURN;
+
+void QP_Event0 PROTO((I_, P_));
+void QP_Event1 PROTO((char *, P_));
+void QP_Event2 PROTO((char *, P_, P_));
+long qp_elapsed_time(STG_NO_ARGS);
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection[thread-heap-objs]{Special threads-only heap objects (`closures')}
+%*									*
+%************************************************************************
+
+%************************************************************************
+%*									*
+\subsubsection[TSO-closures]{@TSO@ (thread state object) heap objects}
+%*									*
+%************************************************************************
+
+We now enter the realm of the Deeply Magical.
+
+Reduction threads come and go, resume and suspend, etc., in the threaded
+world.  Obviously, there must be a place to squirrel away state information
+when a thread is suspended.  Hence these {\em thread state objects} (TSOs).
+
+Rather than manage TSOs' alloc/dealloc, etc., in some {\em ad hoc} way, we
+instead alloc/dealloc/etc them in the heap; then we can use all the
+standard garbage-collection/fetching/flushing/etc machinery on them.
+So that's why TSOs are ``heap objects,'' albeit very special ones.
+
+We use all the standard heap-object/closure jargon... (e.g.,
+@SET_TSO_HDR@, fixed headers, variable-hdr size, ...).
+
+A TSO is a fixed-size object with (post-header) words arranged like
+the main register table, and enough slop so that the register table
+can be properly aligned.  The last header word of the TSO is
+a pointer to the (internal) start of the interesting data.
+
+Note that the heap and stack pointers in the TSO are only valid while
+the thread is executing, and only if the corresponding values are not
+stored in machine registers (i.e. the TSO becomes the backing register
+table for those values).
+
+\begin{code}
+#define TSO_INFO_WORDS 10
+
+#ifdef DO_REDN_COUNTING
+#define TSO_REDN_WORDS 2
+#else
+#define TSO_REDN_WORDS 0
+#endif
+
+#if defined(GRAN) || defined(PAR)
+#define TSO_GRAN_WORDS 15
+#else
+#define TSO_GRAN_WORDS 0
+#endif
+
+#define TSO_VHS	\
+    	(GC_MUT_RESERVED_WORDS + TSO_INFO_WORDS + TSO_REDN_WORDS + TSO_GRAN_WORDS)
+
+#define TSO_HS		(FIXED_HS + TSO_VHS)
+#define TSO_CTS_SIZE	(BYTES_TO_STGWORDS(sizeof(STGRegisterTable) + sizeof(StgDouble)))
+
+#define TSO_PTRS	(MAX_VANILLA_REG + 2)
+
+/* std start-filling-in macro: */
+#define SET_TSO_HDR(closure,infolbl,cc)   	\
+{ SET_FIXED_HDR(closure,infolbl,cc);		\
+  SET_MUT_RESERVED_WORDS(closure); 	    	\
+}
+
+#define TSO_INFO_START		(FIXED_HS + GC_MUT_RESERVED_WORDS)
+#define TSO_LINK_LOCN	    	(TSO_INFO_START + 0)
+#define TSO_CCC_LOCN		(TSO_INFO_START + 1)
+#define TSO_NAME_LOCN	    	(TSO_INFO_START + 2)
+#define TSO_ID_LOCN 	    	(TSO_INFO_START + 3)
+#define TSO_TYPE_LOCN	    	(TSO_INFO_START + 4)
+#define TSO_PC1_LOCN	    	(TSO_INFO_START + 5)
+#define TSO_PC2_LOCN	    	(TSO_INFO_START + 6)
+#define TSO_ARG1_LOCN	    	(TSO_INFO_START + 7)
+#define TSO_EVENT_LOCN	    	(TSO_INFO_START + 8)
+#define TSO_SWITCH_LOCN	    	(TSO_INFO_START + 9)
+
+#define TSO_REDN_START		(TSO_INFO_START + TSO_INFO_WORDS)
+#ifdef DO_REDN_COUNTING
+#define TSO_AHWM_LOCN		(TSO_REDN_START + 0)
+#define TSO_BHWM_LOCN		(TSO_REDN_START + 1)
+#endif
+
+#define TSO_GRAN_START		(TSO_REDN_START + TSO_REDN_WORDS)
+#if defined(GRAN) || defined(PAR)
+#define TSO_LOCKED_LOCN		(TSO_GRAN_START + 0)
+#define TSO_SPARKNAME_LOCN   	(TSO_GRAN_START + 1)
+#define TSO_STARTEDAT_LOCN   	(TSO_GRAN_START + 2)
+#define TSO_EXPORTED_LOCN   	(TSO_GRAN_START + 3)
+#define TSO_BASICBLOCKS_LOCN   	(TSO_GRAN_START + 4)
+#define TSO_ALLOCS_LOCN	    	(TSO_GRAN_START + 5)
+#define TSO_EXECTIME_LOCN    	(TSO_GRAN_START + 6)
+#define TSO_FETCHTIME_LOCN    	(TSO_GRAN_START + 7)
+#define TSO_FETCHCOUNT_LOCN    	(TSO_GRAN_START + 8)
+#define TSO_BLOCKTIME_LOCN    	(TSO_GRAN_START + 9)
+#define TSO_BLOCKCOUNT_LOCN    	(TSO_GRAN_START + 10)
+#define TSO_BLOCKEDAT_LOCN    	(TSO_GRAN_START + 11)
+#define TSO_GLOBALSPARKS_LOCN  	(TSO_GRAN_START + 12)
+#define TSO_LOCALSPARKS_LOCN   	(TSO_GRAN_START + 13)
+#define TSO_QUEUE_LOCN   	(TSO_GRAN_START + 14)
+#endif
+
+#define TSO_LINK(closure)     	    (((PP_)closure)[TSO_LINK_LOCN])
+#define TSO_CCC(closure)     	    (((CostCentre *)closure)[TSO_CCC_LOCN])
+#define TSO_NAME(closure)   	    (((PP_)closure)[TSO_NAME_LOCN])
+#define TSO_ID(closure)   	    (((P_)closure)[TSO_ID_LOCN])
+#define TSO_TYPE(closure)     	    (((P_)closure)[TSO_TYPE_LOCN])
+#define TSO_PC1(closure)     	    (((FP_)closure)[TSO_PC1_LOCN])
+#define TSO_PC2(closure)     	    (((FP_)closure)[TSO_PC2_LOCN])
+#define TSO_ARG1(closure)     	    (((P_)closure)[TSO_ARG1_LOCN])
+#define TSO_EVENT(closure)     	    (((P_)closure)[TSO_EVENT_LOCN])
+#define TSO_SWITCH(closure)    	    (((FP_)closure)[TSO_SWITCH_LOCN])
+
+#define TSO_AHWM(closure)   	    (((I_ *)closure)[TSO_AHWM_LOCN])
+#define TSO_BHWM(closure)   	    (((I_ *)closure)[TSO_BHWM_LOCN])
+
+#define TSO_LOCKED(closure)         (((P_)closure)[TSO_LOCKED_LOCN])
+#define TSO_SPARKNAME(closure)      (((P_)closure)[TSO_SPARKNAME_LOCN])
+#define TSO_STARTEDAT(closure)      (((P_)closure)[TSO_STARTEDAT_LOCN])
+#define TSO_EXPORTED(closure)       (((P_)closure)[TSO_EXPORTED_LOCN])
+#define TSO_BASICBLOCKS(closure)    (((P_)closure)[TSO_BASICBLOCKS_LOCN])
+#define TSO_ALLOCS(closure)   	    (((P_)closure)[TSO_ALLOCS_LOCN])
+#define TSO_EXECTIME(closure)  	    (((P_)closure)[TSO_EXECTIME_LOCN])
+#define TSO_FETCHTIME(closure) 	    (((P_)closure)[TSO_FETCHTIME_LOCN])
+#define TSO_FETCHCOUNT(closure)	    (((P_)closure)[TSO_FETCHCOUNT_LOCN])
+#define TSO_BLOCKTIME(closure) 	    (((P_)closure)[TSO_BLOCKTIME_LOCN])
+#define TSO_BLOCKCOUNT(closure)	    (((P_)closure)[TSO_BLOCKCOUNT_LOCN])
+#define TSO_BLOCKEDAT(closure) 	    (((P_)closure)[TSO_BLOCKEDAT_LOCN])
+#define TSO_GLOBALSPARKS(closure)   (((P_)closure)[TSO_GLOBALSPARKS_LOCN])
+#define TSO_LOCALSPARKS(closure)    (((P_)closure)[TSO_LOCALSPARKS_LOCN])
+#define TSO_QUEUE(closure)	    (((P_)closure)[TSO_QUEUE_LOCN])
+
+#define TSO_INTERNAL_PTR(closure)	    \
+  ((STGRegisterTable *)(((W_)(((P_)closure) \
+    + TSO_HS + BYTES_TO_STGWORDS(sizeof(StgDouble)))) & ~(sizeof(StgDouble) - 1)))
+
+#if defined(CONCURRENT) && defined(GRAN)        /* HWL */
+/* Per definitionem a tso is really awake if it has met a first */
+/* GRAN_RESCHEDULE macro after having been rescheduled. */
+#define REALLY_AWAKE(tso)	(TSO_SWITCH(tso) != TSO_PC2(tso))
+#define SET_AWAKE_FLAG(tso)	TSO_SWITCH(tso) = NULL
+#define RESET_AWAKE_FLAG(tso)	TSO_SWITCH(tso) = TSO_PC2(tso)
+#endif
+
+\end{code}
+
+The types of threads (TSO_TYPE):
+\begin{code}
+#define	T_MAIN			0	/* Must be executed locally */
+#define	T_REQUIRED		1	/* A required thread  -- may be exported */
+#define	T_ADVISORY		2	/* An advisory thread -- may be exported */
+#define	T_FAIL			3	/* A failure thread   -- may be exported */
+\end{code}
+
+The total space required to start a new thread (See NewThread in
+Threads.lc):
+\begin{code}
+#define THREAD_SPACE_REQUIRED (TSO_HS + TSO_CTS_SIZE + STKO_HS + StkOChunkSize)
+\end{code}
+
+Here are the various queues for GrAnSim-type events.
+\begin{code}
+#define Q_RUNNING   'G'
+#define Q_RUNNABLE  'A'
+#define Q_BLOCKED   'R'
+#define Q_FETCHING  'Y'
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[spark-closures]{Pending Sparks}
+%*									*
+%************************************************************************
+
+\begin{code}
+#ifdef GUM
+
+P_ FindLocalSpark PROTO((rtsBool forexport));
+
+void DisposeSpark PROTO((P_ spark));
+rtsBool Spark PROTO((P_ closure, rtsBool required));
+
+#endif /*GUM*/
+
+#ifdef GRAN   /* For GrAnSim sparks are currently mallocated -- HWL */
+
+void DisposeSpark PROTO((sparkq spark));
+
+# define MAX_SPARKS		2000  /* For GC Roots Purposes */
+# if defined(GRAN_TNG)
+extern sparkq NewSpark		PROTO((P_,I_,I_,I_));
+# else /* !GRAN_TNG */
+extern sparkq NewSpark		PROTO((P_,I_,I_));
+# endif  /* GRAN_TNG */
+
+# define SPARK_PREV(spark)	(spark->prev)
+# define SPARK_NEXT(spark)    	(sparkq)(spark->next)
+# define SPARK_NODE(spark)	(P_)(spark->node)
+# define SPARK_NAME(spark)	(spark->name)
+# if defined(GRAN_TNG)
+#  define SPARK_GRAN_INFO(spark) (spark->gran_info)
+# endif  /* GRAN_TNG */
+# define SPARK_GLOBAL(spark)	(spark->global)
+# define SPARK_EXPORTED(spark)	(SPARK_GLOBAL(spark) > 1)
+
+#endif      /* GRAN */
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[STKO-closures]{@STKO@ (stack object) heap objects}
+%*									*
+%************************************************************************
+
+We linger in the Deeply Magical...
+
+Each reduction thread has to have its own stack space.  As there may
+be many such threads, and as any given one may need quite a big stack,
+a naive give-'em-a-big-stack-and-let-'em-run approach will cost a {\em
+lot} of memory.
+
+Our approach is to give a thread a small stack space, and then link
+on/off extra ``chunks'' as the need arises.  Again, this is a
+storage-management problem, and, yet again, we choose to graft the
+whole business onto the existing heap-management machinery.  So stack
+objects will live in the heap, be garbage collected, etc., etc..
+
+So, as with TSOs, we use the standard heap-object (`closure') jargon.
+
+Here is the picture of how a stack object is arranged:
+\begin{verbatim}
+    <-----  var hdr -------->			 v ---- FirstPtr --- v
+---------------------------------------------------------------------
+...|| SpB | SuB | SpA | SuA || B stk -> ... | ... <- A stk || PREV ||
+---------------------------------------------------------------------
+			      XX->                     <-YY 
+\end{verbatim}
+
+We keep the following state-of-stack info in the {\em variable-header}
+part of a STKO:
+\begin{tabular}{ll}
+SpB, SuB & their {\em offsets} from 1st non-hdr word (marked \tr{XX} above)\\
+SpA, SuA & their {\em offsets} from the next-to-last word (marked \tr{YY} above)\\
+ctr field??? & (GC\_GEN\_WHATNOT may serve instead)\\
+\end{tabular}
+
+The stack-pointer offsets are from the points indicated and are {\em
+non-negative} for pointers to this chunk of the stack space.
+
+At the {\em end} of the stack object, we have a {\em link} to the
+previous part of the overall stack.  The link is \tr{NULL} if this is
+the bottom of the overall stack.
+
+After the header, we have @STKO_CHUNK_SIZE-1@ words of actual stack
+stuff.  The B-stack part begins at the lowest address and grows
+upwards; the A-stack parts begins at the highest address and grows
+downwards.
+
+From a storage-manager point of view, these are {\em very special}
+objects.
+
+\begin{code}
+#ifdef DO_REDN_COUNTING
+#define STKO_VHS	(GC_MUT_RESERVED_WORDS + 9)
+#else
+#define STKO_VHS	(GC_MUT_RESERVED_WORDS + 7)
+#endif
+#define STKO_HS		(FIXED_HS + STKO_VHS)
+
+#define DEFAULT_STKO_CHUNK_SIZE	1024
+
+#define MIN_STKO_CHUNK_SIZE 16	/* Rather arbitrary */
+
+extern I_ StkOChunkSize;
+
+#define STKO_CLOSURE_SIZE(closure)	STKO_SIZE(closure)
+
+#define STKO_CLOSURE_CTS_SIZE(closure)	(STKO_CLOSURE_SIZE(closure) - STKO_VHS)
+#define STKO_CLOSURE_PTR(closure, no)	(*STKO_CLOSURE_ADDR(closure, no))
+
+#define STKO_CLOSURE_ADDR(s, n)     (((P_)(s)) + STKO_HS + (n) - 1)
+#define STKO_CLOSURE_OFFSET(s, p)   (((P_)(p) - (P_)(s)) - STKO_HS + 1)
+
+/* std start-filling-in macro: */
+#define SET_STKO_HDR(s,infolbl,cc)   	\
+	{ SET_FIXED_HDR(s,infolbl,cc);	\
+	  SET_MUT_RESERVED_WORDS(s); 	\
+	  /* the other header words filled in some other way */ }
+
+/* now we have the STKO-specific stuff 
+
+   Note: The S[pu][AB] registers are put in this order so that
+         they will appear in monotonically increasing order in
+         the StkO...just as an aid to the poor wee soul who has
+         to debug things.
+ */
+
+#ifdef DO_REDN_COUNTING
+#define STKO_ADEP_LOCN      (STKO_HS - 9)
+#define STKO_BDEP_LOCN      (STKO_HS - 8)
+#endif
+#define STKO_SIZE_LOCN      (STKO_HS - 7)
+#define STKO_RETURN_LOCN    (STKO_HS - 6)
+#define	STKO_LINK_LOCN	    (STKO_HS - 5)
+#define	STKO_SuB_LOCN	    (STKO_HS - 4)
+#define	STKO_SpB_LOCN	    (STKO_HS - 3)
+#define	STKO_SpA_LOCN	    (STKO_HS - 2)
+#define	STKO_SuA_LOCN	    (STKO_HS - 1)
+
+#define STKO_ADEP(s)	    (((I_ *)(s))[STKO_ADEP_LOCN])
+#define STKO_BDEP(s)	    (((I_ *)(s))[STKO_BDEP_LOCN])
+#define STKO_SIZE(s)	    (((P_)(s))[STKO_SIZE_LOCN])
+#define STKO_RETURN(s)	    (((StgRetAddr *)(s))[STKO_RETURN_LOCN])
+#define STKO_LINK(s)	    (((PP_)(s))[STKO_LINK_LOCN])
+#define STKO_SpB(s) 	    (((PP_)(s))[STKO_SpB_LOCN])
+#define STKO_SuB(s) 	    (((PP_)(s))[STKO_SuB_LOCN])
+#define STKO_SpA(s) 	    (((PP_ *)(s))[STKO_SpA_LOCN])
+#define STKO_SuA(s) 	    (((PP_ *)(s))[STKO_SuA_LOCN])
+
+#define STKO_BSTK_OFFSET(closure) (STKO_HS)
+#define STKO_ASTK_OFFSET(closure) (FIXED_HS + STKO_CLOSURE_SIZE(closure) - 1)
+#define STKO_BSTK_BOT(closure)    (((P_)(closure)) + STKO_BSTK_OFFSET(closure))
+#define STKO_ASTK_BOT(closure)    (((PP_)(closure)) + STKO_ASTK_OFFSET(closure))
+\end{code}
+
+These are offsets into the stack object proper (starting at 1 for
+the first word after the header).
+
+\begin{code}
+#define	STKO_SpA_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SpA(s)))
+#define	STKO_SuA_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SuA(s)))
+#define	STKO_SpB_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SpB(s)))
+#define	STKO_SuB_OFFSET(s)  (STKO_CLOSURE_OFFSET(s,STKO_SuB(s)))
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[BQ-closures]{@BQ@ (blocking queue) heap objects (`closures')}
+%*									*
+%************************************************************************
+
+Blocking queues are built in the parallel system when a local thread
+enters a non-global node.  They are similar to black holes, except
+that when they are updated, the blocking queue must be enlivened
+too.  A blocking queue closure thus has the following structure.
+
+\begin{onlylatex}
+\begin{center}
+\end{onlylatex}
+\begin{tabular}{||l|l|l|l||}\hline
+GA	&	Info ptr.	& $\ldots$ 		&	Blocking Queue	\\ \hline
+\end{tabular}
+\begin{onlylatex}
+\begin{center}
+\end{onlylatex}
+
+The blocking queue itself is a pointer to a list of blocking queue entries.
+The list is formed from TSO closures.  For the generational garbage collectors,
+the BQ must have the same structure as an IND, with the blocking queue hanging
+off of the indirection pointer.  (This has to do with treating the BQ as an old
+root if it gets updated while in the old generation.)
+
+\begin{code}
+#define BQ_VHS			    IND_VHS
+#define BQ_HS			    IND_HS
+
+#define BQ_CLOSURE_SIZE(closure)    IND_CLOSURE_SIZE(closure)
+#define BQ_CLOSURE_NoPTRS(closure)  IND_CLOSURE_NoPTRS(closure)
+#define BQ_CLOSURE_NoNONPTRS(closure)	IND_CLOSURE_NoNONPTRS(closure)
+#define BQ_CLOSURE_PTR(closure, no) (((P_)(closure))[BQ_HS + (no) - 1])
+\end{code}
+
+Blocking queues store a pointer to a list of blocking queue entries.
+
+\begin{code}
+#define BQ_ENTRIES(closure)  	    IND_CLOSURE_PTR(closure)
+#define BQ_LINK(closure)    	    IND_CLOSURE_LINK(closure)
+\end{code}
+
+We have only one kind of blocking queue closure, so we test the info pointer
+for a specific value rather than looking in the info table for a special bit.
+
+\begin{code}
+EXTDATA_RO(BQ_info);
+EXTFUN(BQ_entry);
+#define IS_BQ_CLOSURE(closure)	   (INFO_PTR(closure) == (W_) BQ_info)
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[TSO_ITBL]{@TSO_ITBL@}
+%*									*
+%************************************************************************
+
+The special info table used for thread state objects (TSOs).
+
+\begin{code}
+
+#define TSO_ITBL()				    \
+    CAT_DECLARE(TSO,INTERNAL_KIND,"TSO","<TSO>")    \
+    EXTFUN(TSO_entry);				    \
+    EXTDATA_RO(MK_REP_LBL(TSO,,));		    \
+    const W_ TSO_info[] = {			    \
+        (W_) TSO_entry				    \
+	,(W_) INFO_OTHER_TAG			    \
+	,(W_) MK_REP_REF(TSO,,)			    \
+	INCLUDE_PROFILING_INFO(TSO)		    \
+	}
+
+#define TSO_RTBL() \
+    const W_ MK_REP_LBL(TSO,,)[] = { \
+	INCLUDE_TYPE_INFO(TSO)					\
+	INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)		\
+	INCLUDE_PAR_INFO					\
+	INCLUDE_COPYING_INFO(_Evacuate_TSO,_Scavenge_TSO) 	\
+	INCLUDE_COMPACTING_INFO(_ScanLink_TSO,_PRStart_TSO,_ScanMove_TSO,_PRIn_TSO) \
+	}
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[STKO_ITBL]{@STKO_ITBL@}
+%*									*
+%************************************************************************
+
+The special info table used for stack objects (STKOs).
+
+\begin{code}
+#define STKO_ITBL()					\
+    CAT_DECLARE(StkO,INTERNAL_KIND,"STKO","<STKO>")	\
+    EXTFUN(StkO_entry);					\
+    EXTDATA_RO(MK_REP_LBL(StkO,,));			\
+    const W_ StkO_info[] = {				\
+        (W_) StkO_entry					\
+	,(W_) INFO_OTHER_TAG				\
+	,(W_) MK_REP_REF(StkO,,)			\
+	INCLUDE_PROFILING_INFO(StkO)			\
+    }
+
+#define STKO_RTBL() \
+    const W_ MK_REP_LBL(StkO,,)[] = { \
+	INCLUDE_TYPE_INFO(STKO_DYNAMIC)				\
+	INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)		\
+	INCLUDE_PAR_INFO					\
+	INCLUDE_COPYING_INFO(_Evacuate_StkO,_Scavenge_StkO)	\
+	INCLUDE_COMPACTING_INFO(_ScanLink_StkO,_PRStart_StkO,_ScanMove_StkO,_PRIn_StkO) \
+    }
+
+#define STKO_STATIC_ITBL()				\
+    CAT_DECLARE(StkO_static,INTERNAL_KIND,"STKO","<STKO>")	\
+    EXTFUN(StkO_static_entry);				\
+    EXTDATA_RO(MK_REP_LBL(StkO_static,,));		\
+    const W_ StkO_static_info[] = {			\
+        (W_) StkO_static_entry				\
+	,(W_) INFO_OTHER_TAG				\
+	,(W_) MK_REP_REF(StkO_static,,)			\
+	INCLUDE_PROFILING_INFO(StkO_static)		\
+    }
+
+#define STKO_STATIC_RTBL() \
+    const W_ MK_REP_LBL(StkO_static,,)[] = { \
+	INCLUDE_TYPE_INFO(STKO_STATIC)				\
+	INCLUDE_SIZE_INFO(INFO_UNUSED,INFO_UNUSED)		\
+	INCLUDE_PAR_INFO					\
+	INCLUDE_COPYING_INFO(_Evacuate_Static,_Scavenge_Static) \
+	INCLUDE_COMPACTING_INFO(_Dummy_Static_entry,_PRStart_Static, \
+				_Dummy_Static_entry,_PRIn_Error)    \
+    }
+
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection[BQ_ITBL]{@BQ_ITBL@}
+%*									*
+%************************************************************************
+
+Special info-table for local blocking queues.
+
+\begin{code}
+#define BQ_ITBL()				\
+    CAT_DECLARE(BQ,INTERNAL_KIND,"BQ","<BQ>") 	\
+    EXTFUN(BQ_entry);				\
+    EXTDATA_RO(MK_REP_LBL(BQ,,));		\
+    const W_ BQ_info[] = {			\
+        (W_) BQ_entry				\
+	,(W_) INFO_OTHER_TAG			\
+	,(W_) MK_REP_REF(BQ,,)			\
+	INCLUDE_PROFILING_INFO(BQ)		\
+    }
+
+#define BQ_RTBL() \
+    const W_ MK_REP_LBL(BQ,,)[] = {				\
+	INCLUDE_TYPE_INFO(BQ)		    			\
+	INCLUDE_SIZE_INFO(MIN_UPD_SIZE,INFO_UNUSED)		\
+	INCLUDE_PAR_INFO			    	    	\
+	INCLUDE_COPYING_INFO(_Evacuate_BQ,_Scavenge_BQ)     	\
+	SPEC_COMPACTING_INFO(_ScanLink_BQ,_PRStart_BQ,_ScanMove_BQ,_PRIn_BQ) \
+    }
+
+\end{code}
+
+\begin{code}
+#endif	/* CONCURRENT */
+\end{code}
+
+Even the sequential system gets to play with SynchVars, though it really
+doesn't make too much sense (if any).  Okay; maybe it makes some sense.
+(See the 1.3 I/O stuff.)
+
+%************************************************************************
+%*									*
+\subsubsection[SVar-closures]{@SynchVar@ heap objects}
+%*									*
+%************************************************************************
+
+\begin{code}
+#define SVAR_HS			    (MUTUPLE_HS)
+
+#define SVAR_CLOSURE_SIZE(closure)  3
+
+#define SET_SVAR_HDR(closure,infolbl,cc)   \
+    SET_MUTUPLE_HDR(closure,infolbl,cc,MUTUPLE_VHS+3,3)
+
+/* The value must come first, because we shrink the other two fields off
+   when writing an IVar */
+
+#define SVAR_VALUE_LOCN	    	(SVAR_HS+0)
+#define SVAR_HEAD_LOCN	    	(SVAR_HS+1)
+#define SVAR_TAIL_LOCN		(SVAR_HS+2)
+
+#define SVAR_VALUE(closure)	((PP_)(closure))[SVAR_VALUE_LOCN]
+#define SVAR_HEAD(closure)    	((PP_)(closure))[SVAR_HEAD_LOCN]
+#define SVAR_TAIL(closure)    	((PP_)(closure))[SVAR_TAIL_LOCN]
+\end{code}
+
+End multi-slurp protection:
+
+\begin{code}
+#endif	/* THREADS_H */
+\end{code}
+
+