Commit dd4c28a9 authored by hwloidl's avatar hwloidl

[project @ 2000-03-31 03:09:35 by hwloidl]

Numerous changes in the RTS to get GUM-4.06 working (currently works with
parfib-ish programs). Most changes are isolated in the rts/parallel dir.

rts/parallel/:
  The most important changes are a rewrite of the (un-)packing code (Pack.c)
  and changes in LAGA, GALA table operations (Global.c) expecially in
  rebuilding the tables during GC.

rts/:
  Minor changes in Schedule.c, GC.c (interface to par specific root marking
  and evacuation), and lots of additions to Sanity.c (surprise ;-)
  Main.c change for startup: I use a new function rts_evalNothing to
  start non-main-PEs in a PAR || SMP setup (RtsAPI.c)

includes/:
  Updated GranSim macros in PrimOps.h.

lib/std:
  Few changes in PrelHandle.c etc replacing ForeignObj by Addr in a PAR
  setup (we still don't support ForeignObjs or WeakPtrs in GUM).
  Typically use
    #define FILE_OBJECT	    Addr
  when dealing with files.

hslibs/lang/:
  Same as above (in Foreign(Obj).lhs, Weak.lhs, IOExts.lhs etc).

-- HWL
parent b822aa0e
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.72 2000/03/23 17:45:17 simonpj Exp $
# $Id: Makefile,v 1.73 2000/03/31 03:09:35 hwloidl Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -161,6 +161,7 @@ rename/RnNames_HC_OPTS = -H12m
rename/RnMonad_HC_OPTS =
specialise/Specialise_HC_OPTS = -Onot -H12m
simplCore/Simplify_HC_OPTS = -H15m
simplCore/OccurAnal_HC_OPTS = -H10m
typecheck/TcGenDeriv_HC_OPTS = -H10m
# tmp, -- SDM
......
/* ----------------------------------------------------------------------------
* $Id: Closures.h,v 1.16 2000/01/18 12:36:38 simonmar Exp $
* $Id: Closures.h,v 1.17 2000/03/31 03:09:35 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -227,6 +227,15 @@ typedef struct {
StgMutClosure *mut_link;
} StgMutVar;
/*
A collective typedef for all linkable stack frames i.e.
StgUpdateFrame, StgSeqFrame, StgCatchFrame
*/
typedef struct _StgFrame {
StgHeader header;
struct _StgFrame *link;
} StgFrame;
typedef struct _StgUpdateFrame {
StgHeader header;
struct _StgUpdateFrame *link;
......@@ -311,35 +320,40 @@ 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).
StgBlockingQueueElement is a ``collective type'' representing 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).
Note that in the standard setup only StgTSOs can be on a blocking queue.
This is one of the main reasons for slightly different code in files
such as Schedule.c.
*/
typedef struct StgBlockingQueueElement_ {
StgHeader header;
struct StgBlockingQueueElement_ *link;
StgMutClosure *mut_link;
struct StgClosure_ *payload[0];
struct StgBlockingQueueElement_ *link; /* next elem in BQ */
StgMutClosure *mut_link; /* next elem in mutable list */
struct StgClosure_ *payload[0];/* contents of the closure */
} StgBlockingQueueElement;
/* only difference to std code is type of the elem in the BQ */
typedef struct StgBlockingQueue_ {
StgHeader header;
struct StgBlockingQueueElement_ *blocking_queue;
StgMutClosure *mut_link;
struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */
StgMutClosure *mut_link; /* next elem in mutable list */
} StgBlockingQueue;
/* this closure is hanging at the end of a blocking queue in (par setup only) */
/* this closure is hanging at the end of a blocking queue in (see RBH.c) */
typedef struct StgRBHSave_ {
StgHeader header;
StgPtr payload[0];
} StgRBHSave;
StgPtr payload[0]; /* 2 words ripped out of the guts of the */
} StgRBHSave; /* closure holding the blocking queue */
typedef struct StgRBH_ {
StgHeader header;
struct StgBlockingQueueElement_ *blocking_queue;
StgMutClosure *mut_link;
StgHeader header;
struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */
StgMutClosure *mut_link; /* next elem in mutable list */
} StgRBH;
#else
......@@ -356,25 +370,30 @@ typedef struct StgBlockingQueue_ {
/* global indirections aka FETCH_ME closures */
typedef struct StgFetchMe_ {
StgHeader header;
globalAddr *ga; /* type globalAddr is abstract here */
StgMutClosure *mut_link;
globalAddr *ga; /* ptr to unique id for a closure */
StgMutClosure *mut_link; /* next elem in mutable list */
} StgFetchMe;
/* same contents as an ordinary StgBlockingQueue */
typedef struct StgFetchMeBlockingQueue_ {
StgHeader header;
struct StgBlockingQueueElement_ *blocking_queue;
StgMutClosure *mut_link;
struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */
StgMutClosure *mut_link; /* next elem in mutable list */
} StgFetchMeBlockingQueue;
/* entry in a blocking queue, indicating a request from a TSO on another PE */
/* This is an entry in a blocking queue. It indicates a fetch request from a
TSO on another PE demanding the value of this closur. Note that a
StgBlockedFetch can only occur in a BQ. Once the node is evaluated and
updated with the result, the result will be sent back (the PE is encoded
in the globalAddr) and the StgBlockedFetch closure will be nuked.
*/
typedef struct StgBlockedFetch_ {
StgHeader header;
struct StgBlockingQueueElement_ *link;
StgMutClosure *mut_link;
StgClosure *node;
globalAddr ga;
} StgBlockedFetch;
struct StgBlockingQueueElement_ *link; /* next elem in the BQ */
StgMutClosure *mut_link; /* next elem in mutable list */
StgClosure *node; /* node to fetch */
globalAddr ga; /* where to send the result to */
} StgBlockedFetch; /* NB: not just a ptr to a GA */
#endif
#endif /* CLOSURES_H */
/*
Time-stamp: <Tue Jan 11 2000 11:29:41 Stardate: [-30]4188.43 hwloidl>
$Id: GranSim.h,v 1.2 2000/01/13 14:34:00 hwloidl Exp $
Time-stamp: <Fri Mar 24 2000 23:55:42 Stardate: [-30]4554.98 hwloidl>
$Id: GranSim.h,v 1.3 2000/03/31 03:09:35 hwloidl Exp $
Headers for GranSim specific objects.
......@@ -9,14 +9,15 @@
run_queue_hd to be relative to CurrentProc. The main arrays of runnable
and blocking queues are defined in Schedule.c. The important STG-called
GranSim macros (e.g. for fetching nodes) are at the end of this
file. Usually they are just wrappers to proper C functions in GranSim.c. */
file. Usually they are just wrappers to proper C functions in GranSim.c.
*/
#ifndef GRANSIM_H
#define GRANSIM_H
#if !defined(GRAN)
//Dummy definitions for basic GranSim macros (see GranSim.h)
/* Dummy definitions for basic GranSim macros called from STG land */
#define DO_GRAN_ALLOCATE(n) /* nothing */
#define DO_GRAN_UNALLOCATE(n) /* nothing */
#define DO_GRAN_FETCH(node) /* nothing */
......@@ -28,13 +29,12 @@
#if defined(GRAN) /* whole file */
extern StgTSO *CurrentTSOs[];
extern StgTSO *CurrentTSO;
//@node Headers for GranSim specific objects, , ,
//@section Headers for GranSim specific objects
//@menu
//* Includes::
//* Externs and prototypes::
//* Run and blocking queues::
//* Spark queues::
......@@ -44,15 +44,6 @@ extern StgTSO *CurrentTSOs[];
//* STG-called routines::
//@end menu
//@node Includes, Externs and prototypes, Headers for GranSim specific objects, Headers for GranSim specific objects
//@subsection Includes
/*
#include "Closures.h"
#include "TSO.h"
#include "Rts.h"
*/
//@node Externs and prototypes, Run and blocking queues, Includes, Headers for GranSim specific objects
//@subsection Externs and prototypes
......@@ -93,20 +84,20 @@ extern StgTSO *ccalling_threadss[];
//@subsection Spark queues
/*
In GranSim we use a double linked list to represent spark queues.
This is more flexible, but slower, than the array of pointers
representation used in GUM. We use the flexibility to define new fields in
the rtsSpark structure, representing e.g. granularity info (see HWL's PhD
thesis), or info about the parent of a spark.
In GranSim we use a double linked list to represent spark queues.
This is more flexible, but slower, than the array of pointers
representation used in GUM. We use the flexibility to define new fields in
the rtsSpark structure, representing e.g. granularity info (see HWL's PhD
thesis), or info about the parent of a spark.
*/
/* Sparks and spark queues */
typedef struct rtsSpark_
{
StgClosure *node;
StgInt name, global;
StgInt gran_info; /* for granularity improvement mechanisms */
nat name, global;
nat gran_info; /* for granularity improvement mechanisms */
PEs creator; /* PE that created this spark (unused) */
struct rtsSpark_ *prev, *next;
} rtsSpark;
......@@ -120,9 +111,9 @@ extern rtsSparkQ pending_sparks_tls[];
/* Prototypes of those spark routines visible to compiler generated .hc */
/* Routines only used inside the RTS are defined in rts/parallel GranSimRts.h */
rtsSpark *newSpark(StgClosure *node,
StgInt name, StgInt gran_info, StgInt size_info,
StgInt par_info, StgInt local);
void add_to_spark_queue(rtsSpark *spark);
nat name, nat gran_info, nat size_info,
nat par_info, nat local);
// void add_to_spark_queue(rtsSpark *spark);
//@node Processor related stuff, GranSim costs, Spark queues, Headers for GranSim specific objects
//@subsection Processor related stuff
......@@ -137,7 +128,7 @@ extern rtsTime CurrentTime[];
//#error MAX_PROC should be 32 on this architecture
//#endif
#define CurrentTSO CurrentTSOs[CurrentProc]
// #define CurrentTSO CurrentTSOs[CurrentProc]
/* Processor numbers to bitmasks and vice-versa */
#define MainProc 0 /* Id of main processor */
......
/* ----------------------------------------------------------------------------
* $Id: InfoMacros.h,v 1.9 2000/01/13 14:34:00 hwloidl Exp $
* $Id: InfoMacros.h,v 1.10 2000/03/31 03:09:35 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -32,7 +32,7 @@
#endif
/*
On the GRAN/PAR specific parts of the InfoTables:
On the GranSim/GUM specific parts of the InfoTables (GRAN/PAR):
In both GranSim and GUM we use revertible black holes (RBH) when putting
an updatable closure into a packet for communication. The entry code for
......@@ -70,7 +70,7 @@ INFO_TABLE_SRT(info, /* info-table label */ \
prof_descr, prof_type) /* profiling info */ \
entry_class(RBH_##entry); \
entry_class(entry); \
info_class INFO_TBL_CONST StgInfoTable info; \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
layout : { payload : {ptrs,nptrs} }, \
SRT_INFO(RBH,srt_,srt_off_,srt_len_), \
......@@ -117,7 +117,7 @@ INFO_TABLE_SRT_BITMAP(info, entry, bitmap_, srt_, srt_off_, srt_len_, \
prof_descr, prof_type) \
entry_class(RBH_##entry); \
entry_class(entry); \
info_class INFO_TBL_CONST StgInfoTable info; \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
layout : { bitmap : (StgWord32)bitmap_ }, \
SRT_INFO(RBH,srt_,srt_off_,srt_len_), \
......@@ -157,7 +157,7 @@ INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \
entry_class, prof_descr, prof_type) \
entry_class(RBH_##entry); \
entry_class(entry); \
info_class INFO_TBL_CONST StgInfoTable info; \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
layout : { payload : {ptrs,nptrs} }, \
STD_INFO(RBH), \
......@@ -198,7 +198,7 @@ INFO_TABLE_SELECTOR(info, entry, offset, info_class, \
entry_class, prof_descr, prof_type) \
entry_class(RBH_##entry); \
entry_class(entry); \
info_class INFO_TBL_CONST StgInfoTable info; \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
layout : { selector_offset : offset }, \
STD_INFO(RBH), \
......
/*
Time-stamp: <Fri Dec 10 1999 17:15:01 Stardate: [-30]4028.38 software>
Time-stamp: <Tue Mar 28 2000 23:50:54 Stardate: [-30]4574.76 hwloidl>
$Id: Parallel.h,v 1.3 2000/03/31 03:09:35 hwloidl Exp $
Definitions for parallel machines.
Definitions for GUM i.e. running on a parallel machine.
This section contains definitions applicable only to programs compiled
to run on a parallel machine, i.e. on GUM. Some of these definitions
are also used when simulating parallel execution, i.e. on GranSim.
*/
/*
ToDo: Check the PAR specfic part of this file
Move stuff into Closures.h and ClosureMacros.h
Clean-up GRAN specific code
-- HWL
*/
#ifndef PARALLEL_H
#define PARALLEL_H
......@@ -32,6 +26,9 @@
//@node Basic definitions, GUM, Parallel definitions, Parallel definitions
//@subsection Basic definitions
/* This clashes with TICKY, but currently TICKY and PAR hate each other anyway */
#define _HS sizeofW(StgHeader)
/* SET_PAR_HDR and SET_STATIC_PAR_HDR now live in ClosureMacros.h */
/* Needed for dumping routines */
......@@ -39,8 +36,8 @@
# define NODE_STR_LEN 20
# define TIME_STR_LEN 120
# define TIME rtsTime
# define CURRENT_TIME msTime()
# define TIME_ON_PROC(p) msTime()
# define CURRENT_TIME (msTime() - startTime)
# define TIME_ON_PROC(p) (msTime() - startTime)
# define CURRENT_PROC thisPE
# define BINARY_STATS RtsFlags.ParFlags.ParStats.Binary
#elif defined(GRAN)
......@@ -77,10 +74,10 @@
#if defined(PAR)
/*
Symbolic constants for the packing code.
This constant defines how many words of data we can pack into a single
packet in the parallel (GUM) system.
Symbolic constants for the packing code.
This constant defines how many words of data we can pack into a single
packet in the parallel (GUM) system.
*/
//@menu
......@@ -144,23 +141,18 @@ extern rtsSpark *pending_sparks_base[];
extern nat spark_limit[];
extern rtsPackBuffer *PackBuffer; /* size: can be set via option */
extern rtsPackBuffer *buffer; /* HWL_ */
extern rtsPackBuffer *freeBuffer; /* HWL_ */
extern rtsPackBuffer *packBuffer; /* HWL_ */
extern rtsPackBuffer *buffer;
extern rtsPackBuffer *freeBuffer;
extern rtsPackBuffer *packBuffer;
extern rtsPackBuffer *gumPackBuffer;
extern int thisPE;
extern nat thisPE;
/* From Global.c */
/* From Global.c
extern GALA *freeGALAList;
extern GALA *freeIndirections;
extern GALA *liveIndirections;
extern GALA *liveRemoteGAs;
/*
extern HashTable *taskIDtoPEtable;
extern HashTable *LAtoGALAtable;
extern HashTable *pGAtoGALAtable;
*/
//@node Prototypes, Macros, Externs, GUM
......@@ -184,6 +176,13 @@ void initGAtables (void);
void RebuildLAGAtable (void);
StgWord PackGA (StgWord pe, int slot);
# if defined(DEBUG)
/* from Global.c */
/* highest_slot breaks the abstraction of the slot counter for GAs; it is
only used for sanity checking and should used nowhere else */
StgInt highest_slot (void);
# endif
//@node Macros, , Prototypes, GUM
//@subsubsection Macros
......@@ -194,14 +193,14 @@ StgWord PackGA (StgWord pe, int slot);
// ToDo: check which of these is actually needed!
# define PACK_HEAP_REQUIRED ((RtsFlags.ParFlags.packBufferSize - PACK_HDR_SIZE) / (PACK_GA_SIZE + _FHS) * (MIN_UPD_SIZE + 2))
# define PACK_HEAP_REQUIRED ((RtsFlags.ParFlags.packBufferSize - PACK_HDR_SIZE) / (PACK_GA_SIZE + _HS) * (MIN_UPD_SIZE + 2))
# define MAX_GAS (RtsFlags.ParFlags.packBufferSize / PACK_GA_SIZE)
# define PACK_GA_SIZE 3 /* Size of a packed GA in words */
/* Size of a packed fetch-me in words */
# define PACK_FETCHME_SIZE (PACK_GA_SIZE + FIXED_HS)
# define PACK_FETCHME_SIZE (PACK_GA_SIZE + _HS)
# define PACK_HDR_SIZE 1 /* Words of header in a packet */
......@@ -231,6 +230,41 @@ StgWord PackGA (StgWord pe, int slot);
/* At the moment, there is no activity profiling for GUM. This may change. */
# define SET_TASK_ACTIVITY(act) /* nothing */
/*
The following macros are only needed for sanity checking (see Sanity.c).
*/
/* NB: this is PVM specific and should be updated for MPI etc
in PVM a task id (tid) is split into 2 parts: the id for the
physical processor it is running on and an index of tasks running
on a processor; PVM_PE_MASK indicates which part of a tid holds the
id of the physical processor (the other part of the word holds the
index on that processor)
MAX_PVM_PES and MAX_PVM_TIDS are maximal values for these 2 components
in GUM we have an upper bound for the total number of PVM PEs allowed:
it's MAX_PE defined in Parallel.h
to check the slot field of a GA we call a fct highest_slot which just
returns the internal counter
*/
#define PVM_PE_MASK 0xfffc0000
#define MAX_PVM_PES MAX_PES
#define MAX_PVM_TIDS MAX_PES
#if 0
#define LOOKS_LIKE_TID(tid) (((tid & PVM_PE_MASK) != 0) && \
(((tid & PVM_PE_MASK) + (tid & ~PVM_PE_MASK)) < MAX_PVM_TIDS))
#define LOOKS_LIKE_SLOT(slot) (slot<=highest_slot())
#define LOOKS_LIKE_GA(ga) (LOOKS_LIKE_TID((ga)->payload.gc.gtid) && \
LOOKS_LIKE_SLOT((ga)->payload.gc.slot))
#else
rtsBool looks_like_tid(StgInt tid);
rtsBool looks_like_slot(StgInt slot);
rtsBool looks_like_ga(globalAddr *ga);
#define LOOKS_LIKE_TID(tid) looks_like_tid(tid)
#define LOOKS_LIKE_GA(ga) looks_like_ga(ga)
#endif /* 0 */
#endif /* PAR */
//@node GranSim, , GUM, Parallel definitions
......@@ -249,45 +283,15 @@ StgWord PackGA (StgWord pe, int slot);
//@node Types, Prototypes, GranSim, GranSim
//@subsubsection Types
typedef StgWord *StgBuffer;
typedef struct rtsPackBuffer_ {
StgInt /* nat */ id;
StgInt /* nat */ size;
StgInt /* nat */ unpacked_size;
StgTSO *tso;
StgClosure **buffer;
StgBuffer *buffer;
} rtsPackBuffer;
//@node Prototypes, Macros, Types, GranSim
//@subsubsection Prototypes
/* main packing functions */
/*
rtsPackBuffer *PackNearbyGraph(StgClosure* closure, StgTSO* tso, nat *packbuffersize);
rtsPackBuffer *PackOneNode(StgClosure* closure, StgTSO* tso, nat *packbuffersize);
void PrintPacket(rtsPackBuffer *buffer);
StgClosure *UnpackGraph(rtsPackBuffer* buffer);
*/
/* important auxiliary functions */
/*
OLD CODE -- HWL
void InitPackBuffer(void);
P_ AllocateHeap (W_ size);
P_ PackNearbyGraph (P_ closure, P_ tso, W_ *packbuffersize);
P_ PackOneNode (P_ closure, P_ tso, W_ *packbuffersize);
P_ UnpackGraph (P_ buffer);
void InitClosureQueue (void);
P_ DeQueueClosure(void);
void QueueClosure (P_ closure);
// rtsBool QueueEmpty();
void PrintPacket (P_ buffer);
*/
// StgInfoTable *get_closure_info(StgClosure* node, unsigned int /* nat */ *size, unsigned int /* nat */ *ptrs, unsigned int /* nat */ *nonptrs, unsigned int /* nat */ *vhs, char *info_hdr_ty);
// int /* rtsBool */ IS_BLACK_HOLE(StgClosure* node) ;
//@node Macros, , Prototypes, GranSim
//@subsubsection Macros
......@@ -308,7 +312,7 @@ void PrintPacket (P_ buffer);
# define MAX_GAS (RtsFlags.GranFlags.packBufferSize / PACK_GA_SIZE)
# define PACK_GA_SIZE 3 /* Size of a packed GA in words */
/* Size of a packed fetch-me in words */
# define PACK_FETCHME_SIZE (PACK_GA_SIZE + FIXED_HS)
# define PACK_FETCHME_SIZE (PACK_GA_SIZE + _HS)
# define PACK_HDR_SIZE 4 /* Words of header in a packet */
# define PACK_HEAP_REQUIRED \
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.47 2000/03/17 12:40:03 simonmar Exp $
* $Id: PrimOps.h,v 1.48 2000/03/31 03:09:35 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -729,50 +729,61 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
A par in the Haskell code is ultimately translated to a parzh macro
(with a case wrapped around it to guarantee that the macro is actually
executed; see compiler/prelude/PrimOps.lhs)
In GUM and SMP we only add a pointer to the spark pool.
In GranSim we call an RTS fct, forwarding additional parameters which
supply info on granularity of the computation, size of the result value
and the degree of parallelism in the sparked expression.
---------------------------------------------------------------------- */
#if defined(GRAN)
// hash coding changed from 2.10 to 4.00
#define parzh(r,node) parZh(r,node)
#define parZh(r,node) \
PARZh(r,node,1,0,0,0,0,0)
//@cindex _par_
#define parzh(r,node) PAR(r,node,1,0,0,0,0,0)
//@cindex _parAt_
#define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
//@cindex _parAtAbs_
#define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
//@cindex _parAtRel_
#define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
//@cindex _parAtForNow_
#define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
#define parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
{ \
rtsSparkQ result; \
if (closure_SHOULD_SPARK((StgClosure*)node)) { \
#define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \
{ \
if (closure_SHOULD_SPARK((StgClosure*)node)) { \
rtsSparkQ result; \
STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
if (local==2) { /* special case for parAtAbs */ \
STGCALL3(GranSimSparkAtAbs, result,(I_)where,identifier);\
} else if (local==3) { /* special case for parAtRel */ \
STGCALL3(GranSimSparkAtAbs, result,(I_)(CurrentProc+where),identifier); \
} else { \
STGCALL3(GranSimSparkAt, result,where,identifier); \
} \
} \
PEs p; \
\
STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \
switch (local) { \
case 2: p = where; /* parAtAbs means absolute PE no. expected */ \
break; \
case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\
break; \
default: p = where_is(where); /* parAt means closure expected */ \
break; \
} \
/* update GranSim state according to this spark */ \
STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier); \
} \
}
//@cindex _parLocal_
#define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
PARZh(r,node,rest,identifier,gran_info,size_info,par_info,1)
PAR(r,node,rest,identifier,gran_info,size_info,par_info,1)
//@cindex _parGlobal_
#define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
PARZh(r,node,rest,identifier,gran_info,size_info,par_info,0)
PAR(r,node,rest,identifier,gran_info,size_info,par_info,0)
#define PARZh(r,node,rest,identifier,gran_info,size_info,par_info,local) \
#define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \
{ \
if (closure_SHOULD_SPARK((StgClosure*)node)) { \
rtsSpark *result; \
......@@ -789,9 +800,8 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
#define noFollowzh(r,node) \
/* noFollow not yet implemented!! */
#endif /* GRAN */
#elif defined(SMP) || defined(PAR)
#if defined(SMP) || defined(PAR)
#define parzh(r,node) \
{ \
extern unsigned int context_switch; \
......@@ -801,7 +811,7 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
} \
r = context_switch = 1; \
}
#else
#else /* !GRAN && !SMP && !PAR */
#define parzh(r,node) r = 1
#endif
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.h,v 1.10 2000/03/30 12:03:31 simonmar Exp $
* $Id: RtsAPI.h,v 1.11 2000/03/31 03:09:35 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -84,6 +84,11 @@ rts_evalIO ( HaskellObj p, /*out*/HaskellObj *ret );
SchedulerStatus
rts_evalLazyIO ( HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret );
#if defined(PAR) || defined(SMP)
SchedulerStatus
rts_evalNothing(unsigned int stack_size);
#endif
void
rts_checkSchedStatus ( char* site, SchedulerStatus rc);
......
/* -----------------------------------------------------------------------------
* $Id: TSO.h,v 1.14 2000/03/20 09:42:49 andy Exp $
* $Id: TSO.h,v 1.15 2000/03/31 03:09:35 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -11,8 +11,11 @@
#define TSO_H
#if defined(GRAN) || defined(PAR)
#if DEBUG // && PARANOIA_LEVEL>999
// magic marker for TSOs; debugging only
#define TSO_MAGIC 4321
#endif
typedef struct {
StgInt pri;
......@@ -122,7 +125,8 @@ typedef enum {
BlockedOnWrite,
BlockedOnDelay
#if defined(PAR)
, BlockedOnGA // blocked on a remote closure represented by a Global Address
, BlockedOnGA // blocked on a remote closure represented by a Global Address
, BlockedOnGA_NoSend // same as above but without sending a Fetch message
#endif
} StgTSOBlockReason;
......@@ -135,9 +139,6 @@ typedef union {
#else
unsigned int delay;
#endif
#if defined(PAR)
globalAddr ga;
#endif
} StgTSOBlockInfo;
/*
......@@ -189,7 +190,7 @@ typedef struct StgTSO_ {
(a) smaller than a block, or
(b) a multiple of BLOCK_SIZE
tso->block_reason tso->block_info location
tso->why_blocked tso->block_info location
----------------------------------------------------------------------
NotBlocked NULL runnable_queue, or running
......@@ -202,6 +203,8 @@ typedef struct StgTSO_ {
BlockedOnRead NULL blocked_queue
BlockedOnWrite NULL blocked_queue
BlockedOnDelay NULL blocked_queue
BlockedOnGA closure TSO blocks on BQ of that closure
BlockedOnGA_NoSend closure TSO blocks on BQ of that closure
tso->link == END_TSO_QUEUE, if the thread is currently running.
......@@ -227,6 +230,13 @@ typedef struct StgTSO_ {
(StgTSO *)tso if threads are currently awaiting delivery of
exceptions to this thread.
The 2 cases BlockedOnGA and BlockedOnGA_NoSend are needed in a GUM
setup only. They mark a TSO that has entered a FETCH_ME or
FETCH_ME_BQ closure, respectively; only the first TSO hitting the
closure will send a Fetch message.
Currently we have no separate code for blocking on an RBH; we use the
BlockedOnBlackHole case for that. -- HWL
---------------------------------------------------------------------------- */
/* Workaround for a bug/quirk in gcc on certain architectures.
......
......@@ -705,11 +705,7 @@ hIsWritable handle =
isWritable _ = False
#ifndef __PARALLEL_HASKELL__
getBMode__ :: ForeignObj -> IO (BufferMode, Int)
#else
getBMode__ :: Addr -> IO (BufferMode, Int)
#endif
getBMode__ :: FILE_OBJECT -> IO (BufferMode, Int)
getBMode__ fo = do
rc <- getBufferMode fo -- ConcHask: SAFE, won't block
case (rc::Int) of
......@@ -827,13 +823,6 @@ hConnectHdl_ hW hR is_tty =
wantRWHandle "hConnectTo" hW $ \ hW_ ->
wantRWHandle "hConnectTo" hR $ \ hR_ -> do
setConnectedTo (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
#ifndef __PARALLEL_HASKELL__
#define FILE_OBJECT ForeignObj
#else
#define FILE_OBJECT Addr
#endif
\end{code}
As an extension, we also allow characters to be pushed back.
......@@ -1115,12 +1104,7 @@ Internal helper functions for Concurrent Haskell implementation
of IO:
\begin{code}
#ifndef __PARALLEL_HASKELL__
mayBlock :: ForeignObj -> IO Int -> IO Int