Commit 20fc2f0c authored by hwloidl's avatar hwloidl

[project @ 2001-03-22 03:51:08 by hwloidl]

-*- outline -*-
Time-stamp: <Thu Mar 22 2001 03:50:16 Stardate: [-30]6365.79 hwloidl>

This commit covers changes in GHC to get GUM (way=mp) and GUM/GdH (way=md)
working. It is a merge of my working version of GUM, based on GHC 4.06,
with GHC 4.11. Almost all changes are in the RTS (see below).

GUM is reasonably stable, we used the 4.06 version in large-ish programs for
recent papers. Couple of things I want to change, but nothing urgent.
GUM/GdH has just been merged and needs more testing. Hope to do that in the
next weeks. It works in our working build but needs tweaking to run.
GranSim doesn't work yet (*sigh*). Most of the code should be in, but needs
more debugging.

ToDo: I still want to make the following minor modifications before the release
- Better wrapper skript for parallel execution [ghc/compiler/main]
- Update parallel docu: started on it but it's minimal [ghc/docs/users_guide]
- Clean up [nofib/parallel]: it's a real mess right now (*sigh*)
- Update visualisation tools (minor things only IIRC) [ghc/utils/parallel]
- Add a Klingon-English glossary

* RTS:

Almost all changes are restricted to ghc/rts/parallel and should not
interfere with the rest. I only comment on changes outside the parallel
dir:

- Several changes in Schedule.c (scheduling loop; createThreads etc);
  should only affect parallel code
- Added ghc/rts/hooks/ShutdownEachPEHook.c
- ghc/rts/Linker.[ch]: GUM doesn't know about Stable Names (ifdefs)!!
- StgMiscClosures.h: END_TSO_QUEUE etc now defined here (from StgMiscClosures.hc)
                     END_ECAF_LIST was missing a leading stg_
- SchedAPI.h: taskStart now defined in here; it's only a wrapper around
              scheduleThread now, but might use some init, shutdown later
- RtsAPI.h: I have nuked the def of rts_evalNothing

* Compiler:

- ghc/compiler/main/DriverState.hs
  added PVM-ish flags to the parallel way
  added new ways for parallel ticky profiling and distributed exec

- ghc/compiler/main/DriverPipeline.hs
  added a fct run_phase_MoveBinary which is called with way=mp after linking;
  it moves the bin file into a PVM dir and produces a wrapper script for
  parallel execution
  maybe cleaner to add a MoveBinary phase in DriverPhases.hs but this way
  it's less intrusive and MoveBinary makes probably only sense for mp anyway

* Nofib:

- nofib/spectral/Makefile, nofib/real/Makefile, ghc/tests/programs/Makefile:
  modified to skip some tests if HWL_NOFIB_HACK is set; only tmp to record
  which test prgs cause problems in my working build right now
parent 982fe3c7
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgClosure.lhs,v 1.45 2001/03/06 10:13:35 simonmar Exp $
% $Id: CgClosure.lhs,v 1.46 2001/03/22 03:51:08 hwloidl Exp $
%
\section[CgClosure]{Code generation for closures}
......@@ -320,12 +320,7 @@ closureCodeBody binder_info closure_info cc all_args body
--
arg_regs = case entry_conv of
DirectEntry lbl arity regs -> 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"
other -> [] -- "(HWL ignored; no args passed in regs)"
num_arg_regs = length arg_regs
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.55 2001/03/15 11:26:27 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.56 2001/03/22 03:51:08 hwloidl Exp $
--
-- GHC Driver
--
......@@ -195,6 +195,7 @@ genPipeline todo stop_flag persistent_output lang filename
| otherwise = [ ] -- just pass this file through to the linker
-- ToDo: this is somewhat cryptic
not_valid = throwDyn (OtherError ("invalid option combination"))
----------- ----- ---- --- -- -- - - -
......@@ -240,7 +241,8 @@ genPipeline todo stop_flag persistent_output lang filename
StopBefore phase -> phase
DoMkDependHS -> Ln
DoLink -> Ln
annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
annotated_pipeline = annotatePipeline (pipeline ++ [Ln]) stop_phase
phase_ne p (p1,_,_) = (p1 /= p)
----------- ----- ---- --- -- -- - - -
......@@ -677,6 +679,91 @@ run_phase SplitAs basename _suff _input_fn _output_fn
mapM_ assemble_file [1..n]
return True
-----------------------------------------------------------------------------
-- MoveBinary sort-of-phase
-- After having produced a binary, move it somewhere else and generate a
-- wrapper script calling the binary. Currently, we need this only in
-- a parallel way (i.e. in GUM), because PVM expects the binary in a
-- central directory.
-- This is called from doLink below, after linking. I haven't made it
-- a separate phase to minimise interfering with other modules, and
-- we don't need the generality of a phase (MoveBinary is always
-- done after linking and makes only sense in a parallel setup) -- HWL
run_phase_MoveBinary input_fn
= do
top_dir <- readIORef v_TopDir
pvm_root <- getEnv "PVM_ROOT"
pvm_arch <- getEnv "PVM_ARCH"
let
pvm_executable_base = "=" ++ input_fn
pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
sysMan = top_dir ++ "/ghc/rts/parallel/SysMan";
-- nuke old binary; maybe use configur'ed names for cp and rm?
system ("rm -f " ++ pvm_executable)
-- move the newly created binary into PVM land
system ("cp -p " ++ input_fn ++ " " ++ pvm_executable)
-- generate a wrapper script for running a parallel prg under PVM
writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
return True
-- generates a Perl skript starting a parallel prg under PVM
mk_pvm_wrapper_script :: String -> String -> String -> String
mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
[
"eval 'exec perl -S $0 ${1+\"$@\"}'",
" if $running_under_some_shell;",
"# =!=!=!=!=!=!=!=!=!=!=!",
"# This script is automatically generated: DO NOT EDIT!!!",
"# Generated by Glasgow Haskell Compiler",
"# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
"#",
"$pvm_executable = '" ++ pvm_executable ++ "';",
"$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
"$SysMan = '" ++ sysMan ++ "';",
"",
{- ToDo: add the magical shortcuts again iff we actually use them -- HWL
"# first, some magical shortcuts to run "commands" on the binary",
"# (which is hidden)",
"if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
" local($cmd) = $1;",
" system("$cmd $pvm_executable");",
" exit(0); # all done",
"}", -}
"",
"# Now, run the real binary; process the args first",
"$ENV{'PE'} = $pvm_executable_base;", -- ++ pvm_executable_base,
"$debug = '';",
"$nprocessors = 0; # the default: as many PEs as machines in PVM config",
"@nonPVM_args = ();",
"$in_RTS_args = 0;",
"",
"args: while ($a = shift(@ARGV)) {",
" if ( $a eq '+RTS' ) {",
" $in_RTS_args = 1;",
" } elsif ( $a eq '-RTS' ) {",
" $in_RTS_args = 0;",
" }",
" if ( $a eq '-d' && $in_RTS_args ) {",
" $debug = '-';",
" } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
" $nprocessors = $1;",
" } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
" $nprocessors = $1;",
" } else {",
" push(@nonPVM_args, $a);",
" }",
"}",
"",
"local($return_val) = 0;",
"# Start the parallel execution by calling SysMan",
"system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
"$return_val = $?;",
"# ToDo: fix race condition moving files and flushing them!!",
"system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
"exit($return_val);"
]
-----------------------------------------------------------------------------
-- Linking
......@@ -743,6 +830,12 @@ doLink o_files = do
#endif
)
)
-- parallel only: move binary to another dir -- HWL
ways_ <- readIORef v_Ways
when (WayPar `elem` ways_) (do
success <- run_phase_MoveBinary output_fn
if success then return ()
else throwDyn (OtherError ("cannot move binary to PVM dir")))
-----------------------------------------------------------------------------
-- Making a DLL
......
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.33 2001/03/12 14:06:47 simonpj Exp $
-- $Id: DriverState.hs,v 1.34 2001/03/22 03:51:08 hwloidl Exp $
--
-- Settings for the driver
--
......@@ -507,14 +507,45 @@ way_details =
(WayUnreg, Way "u" "Unregisterised"
unregFlags ),
-- optl's below to tell linker where to find the PVM library -- HWL
(WayPar, Way "mp" "Parallel"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
, "-package concurrent"
, "-optc-w"
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
, "-optl-lpvm3"
, "-optl-lgpvm3"
, "-fvia-C" ]),
(WayGran, Way "mg" "Gransim"
-- at the moment we only change the RTS and could share compiler and libs!
(WayPar, Way "mt" "Parallel ticky profiling"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
, "-optc-DPAR_TICKY"
, "-package concurrent"
, "-optc-w"
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
, "-optl-lpvm3"
, "-optl-lgpvm3"
, "-fvia-C" ]),
(WayPar, Way "md" "Distributed"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-D__DISTRIBUTED_HASKELL__"
, "-optc-DPAR"
, "-optc-DDIST"
, "-package concurrent"
, "-optc-w"
, "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
, "-optl-lpvm3"
, "-optl-lgpvm3"
, "-fvia-C" ]),
(WayGran, Way "mg" "GranSim"
[ "-fgransim"
, "-D__GRANSIM__"
, "-optc-DGRAN"
......
-----------------------------------------------------------------------
-- $Id: primops.txt,v 1.18 2001/02/28 00:01:02 qrczak Exp $
-- $Id: primops.txt,v 1.19 2001/03/22 03:51:08 hwloidl Exp $
--
-- Primitive Operations
--
......@@ -787,8 +787,6 @@ primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp
ForeignObj# -> Int# -> Word64#
primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Char# #)
......@@ -1152,7 +1150,6 @@ primop TouchOp "touch#" GenPrimOp
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
------------------------------------------------------------------------
--- Weak pointers ---
------------------------------------------------------------------------
......@@ -1183,7 +1180,6 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp
has_side_effects = True
out_of_line = True
------------------------------------------------------------------------
--- Stable pointers and names ---
------------------------------------------------------------------------
......@@ -1302,6 +1298,7 @@ primop ParAtForNowOp "parAtForNow#" GenPrimOp
-- copyable# and noFollow# have no corresponding entry in
-- PrelGHC.hi-boot, so I don't know whether they should still
-- be here or not. JRS, 15 Jan 01
-- not implemented; please, keep the comment as reminder -- HWL 12/3/01
--
--primop CopyableOp "copyable#" GenPrimOp
-- a -> Int#
......
......@@ -43,6 +43,7 @@ sequential execution, then fine.
<Para>
A Parallel Haskell program implies multiple processes running on
multiple processors, under a PVM (Parallel Virtual Machine) framework.
An MPI interface is under development but not fully functional, yet.
</Para>
<Para>
......@@ -51,8 +52,12 @@ fun&rdquo; than about &ldquo;speed.&rdquo; That will change.
</Para>
<Para>
Again, check Simon's Web page for publications about Parallel Haskell
(including &ldquo;GUM&rdquo;, the key bits of the runtime system).
Check the <ULink URL="http://www.cee.hw.ac.uk/~dsg/gph/">GPH Page</Ulink>
for more information on &ldquo;GPH&rdquo; (Haskell98 with extensions for
parallel execution), the latest version of &ldquo;GUM&rdquo; (the runtime
system to enable parallel executions) and papers on research issues. A
list of publications about GPH and about GUM is also available from Simon's
Web Page.
</Para>
<Para>
......@@ -151,10 +156,10 @@ you'd like to see this with your very own eyes, just run GHC with the
</Sect3>
<Sect3 id="sec-scheduling-policy">
<Title>Scheduling policy for concurrent/parallel threads
<IndexTerm><Primary>Scheduling&mdash;concurrent/parallel</Primary></IndexTerm>
<IndexTerm><Primary>Concurrent/parallel scheduling</Primary></IndexTerm></Title>
<Sect3>
<Title>Scheduling policy for concurrent threads
<IndexTerm><Primary>Scheduling&mdash;concurrent</Primary></IndexTerm>
<IndexTerm><Primary>Concurrent scheduling</Primary></IndexTerm></Title>
<Para>
Runnable threads are scheduled in round-robin fashion. Context
......@@ -179,6 +184,19 @@ of the currently active threads are completed.
</Sect3>
<Sect3>
<Title>Scheduling policy for parallel threads
<IndexTerm><Primary>Scheduling&mdash;parallel</Primary></IndexTerm>
<IndexTerm><Primary>Parallel scheduling</Primary></IndexTerm></Title>
<Para>
In GUM we use an unfair scheduler, which means that a thread continues to
perform graph reduction until it blocks on a closure under evaluation, on a
remote closure or until the thread finishes.
</Para>
</Sect3>
</Sect2>
</Sect1>
......
This diff is collapsed.
/* ----------------------------------------------------------------------------
* $Id: ClosureTypes.h,v 1.14 2001/01/29 17:23:41 simonmar Exp $
* $Id: ClosureTypes.h,v 1.15 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -79,6 +79,8 @@
#define EVACUATED 64
#define N_CLOSURE_TYPES 65
#define REMOTE_REF 65
#define N_CLOSURE_TYPES 66
#endif /* CLOSURETYPES_H */
/* -----------------------------------------------------------------------------
* $Id: Hooks.h,v 1.3 1999/02/05 16:02:22 simonm Exp $
* $Id: Hooks.h,v 1.4 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -17,3 +17,7 @@ extern void PatErrorHdrHook (long fd);
extern void defaultsHook (void);
extern void PreTraceHook (long fd);
extern void PostTraceHook (long fd);
#if defined(PAR)
extern void InitEachPEHook (void);
extern void ShutdownEachPEHook (void);
#endif
\ No newline at end of file
/* ----------------------------------------------------------------------------
* $Id: InfoMacros.h,v 1.13 2000/08/17 15:19:17 rrt Exp $
* $Id: InfoMacros.h,v 1.14 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -78,23 +78,27 @@ INFO_TABLE_SRT(info, /* info-table label */ \
type, /* closure type */ \
info_class, entry_class, /* C storage classes */ \
prof_descr, prof_type) /* profiling info */ \
entry_class(RBH_##entry); \
entry_class(stg_RBH_##entry); \
entry_class(entry); \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
info_class INFO_TBL_CONST StgInfoTable stg_RBH_##info = { \
layout : { payload : {ptrs,nptrs} }, \
PROF_INFO(prof_type, prof_descr) \
SRT_INFO(RBH,srt_,srt_off_,srt_len_), \
INCLUDE_RBH_INFO(info), \
INIT_ENTRY(RBH_##entry), \
INIT_ENTRY(stg_RBH_##entry), \
INIT_VECTOR \
} ; \
StgFunPtr RBH_##entry (void) { JMP_(RBH_entry); } ; \
StgFunPtr stg_RBH_##entry (void) { \
FB_ \
JMP_(stg_RBH_entry); \
FE_ \
} ; \
info_class INFO_TBL_CONST StgInfoTable info = { \
layout : { payload : {ptrs,nptrs} }, \
PROF_INFO(prof_type, prof_descr) \
SRT_INFO(type,srt_,srt_off_,srt_len_), \
INCLUDE_RBH_INFO(RBH_##info), \
INCLUDE_RBH_INFO(stg_RBH_##info), \
INIT_ENTRY(entry), \
INIT_VECTOR \
}
......@@ -128,26 +132,31 @@ INFO_TABLE_SRT(info, /* info-table label */ \
INFO_TABLE_SRT_BITMAP(info, entry, bitmap_, srt_, srt_off_, srt_len_, \
type, info_class, entry_class, \
prof_descr, prof_type) \
entry_class(RBH_##entry); \
entry_class(stg_RBH_##entry); \
entry_class(entry); \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
info_class INFO_TBL_CONST StgInfoTable stg_RBH_##info = { \
layout : { bitmap : (StgWord32)bitmap_ }, \
PROF_INFO(prof_type, prof_descr) \
SRT_INFO(RBH,srt_,srt_off_,srt_len_), \
INCLUDE_RBH_INFO(info), \
INIT_ENTRY(RBH_##entry), \
INIT_ENTRY(stg_RBH_##entry), \
INIT_VECTOR \
}; \
StgFunPtr RBH_##entry (void) { JMP_(RBH_entry); } ; \
StgFunPtr stg_RBH_##entry (void) { \
FB_ \
JMP_(stg_RBH_entry); \
FE_ \
} ; \
info_class INFO_TBL_CONST StgInfoTable info = { \
layout : { bitmap : (StgWord32)bitmap_ }, \
PROF_INFO(prof_type, prof_descr) \
SRT_INFO(type,srt_,srt_off_,srt_len_), \
INCLUDE_RBH_INFO(RBH_##info), \
INCLUDE_RBH_INFO(stg_RBH_##info), \
INIT_ENTRY(entry), \
INIT_VECTOR \
}
#else
#define \
......@@ -171,23 +180,27 @@ INFO_TABLE_SRT_BITMAP(info, entry, bitmap_, srt_, srt_off_, srt_len_, \
#define \
INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \
entry_class, prof_descr, prof_type) \
entry_class(RBH_##entry); \
entry_class(stg_RBH_##entry); \
entry_class(entry); \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
ED_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable stg_RBH_##info = { \
layout : { payload : {ptrs,nptrs} }, \
PROF_INFO(prof_type, prof_descr) \
STD_INFO(RBH), \
INCLUDE_RBH_INFO(info), \
INIT_ENTRY(RBH_##entry), \
INCLUDE_RBH_INFO(info), \
INIT_ENTRY(stg_RBH_##entry), \
INIT_VECTOR \
}; \
StgFunPtr RBH_##entry (void) { JMP_(RBH_entry); } ; \
info_class INFO_TBL_CONST StgInfoTable info = { \
} ; \
StgFunPtr stg_RBH_##entry (void) { \
FB_ \
JMP_(stg_RBH_entry); \
FE_ \
} ; \
info_class INFO_TBL_CONST StgInfoTable info = { \
layout : { payload : {ptrs,nptrs} }, \
PROF_INFO(prof_type, prof_descr) \
STD_INFO(type), \
INCLUDE_RBH_INFO(RBH_##info), \
INCLUDE_RBH_INFO(stg_RBH_##info), \
INIT_ENTRY(entry), \
INIT_VECTOR \
}
......@@ -215,23 +228,27 @@ INFO_TABLE(info, entry, ptrs, nptrs, type, info_class, \
#define \
INFO_TABLE_SELECTOR(info, entry, offset, info_class, \
entry_class, prof_descr, prof_type) \
entry_class(RBH_##entry); \
entry_class(stg_RBH_##entry); \
entry_class(entry); \
ED_RO_ StgInfoTable info; \
info_class INFO_TBL_CONST StgInfoTable RBH_##info = { \
info_class INFO_TBL_CONST StgInfoTable stg_RBH_##info = { \
layout : { selector_offset : offset }, \
PROF_INFO(prof_type, prof_descr) \
STD_INFO(RBH), \
INCLUDE_RBH_INFO(info), \
INIT_ENTRY(RBH_##entry), \
INIT_ENTRY(stg_RBH_##entry), \
INIT_VECTOR \
}; \
StgFunPtr RBH_##entry (void) { JMP_(RBH_entry); } ; \
StgFunPtr stg_RBH_##entry (void) { \
FB_ \
JMP_(stg_RBH_entry); \
FE_ \
} ; \
info_class INFO_TBL_CONST StgInfoTable info = { \
layout : { selector_offset : offset }, \
PROF_INFO(prof_type, prof_descr) \
STD_INFO(THUNK_SELECTOR), \
INCLUDE_RBH_INFO(RBH_##info), \
INCLUDE_RBH_INFO(stg_RBH_##info), \
INIT_ENTRY(entry), \
INIT_VECTOR \
}
......
/* ----------------------------------------------------------------------------
* $Id: InfoTables.h,v 1.20 2001/03/02 16:12:18 simonmar Exp $
* $Id: InfoTables.h,v 1.21 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -140,6 +140,7 @@ extern StgWord16 closure_flags[];
#define closure_HNF(c) ( closureFlags(c) & _HNF)
#define closure_BITMAP(c) ( closureFlags(c) & _BTM)
#define closure_NON_SPARK(c) ( (closureFlags(c) & _NS))
#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS))
#define closure_STATIC(c) ( closureFlags(c) & _STA)
#define closure_THUNK(c) ( closureFlags(c) & _THU)
......
/*
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 $
Time-stamp: <Tue Mar 06 2001 00:09:10 Stardate: [-30]6285.03 hwloidl>
$Id: Parallel.h,v 1.4 2001/03/22 03:51:09 hwloidl Exp $
Definitions for GUM i.e. running on a parallel machine.
......@@ -131,7 +131,7 @@ extern nat advisory_thread_count;
extern rtsBool InGlobalGC; /* Are we in the midst of performing global GC */
static ullong startTime; /* start of comp; in RtsStartup.c */
extern ullong startTime; /* start of comp; in RtsStartup.c */
/* the spark pools proper */
extern rtsSpark *pending_sparks_hd[]; /* ptr to start of a spark pool */
......@@ -289,7 +289,7 @@ typedef struct rtsPackBuffer_ {
StgInt /* nat */ size;
StgInt /* nat */ unpacked_size;
StgTSO *tso;
StgBuffer *buffer;
StgWord *buffer;
} rtsPackBuffer;
//@node Macros, , Prototypes, GranSim
......
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.75 2001/02/28 00:01:03 qrczak Exp $
* $Id: PrimOps.h,v 1.76 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -742,8 +742,6 @@ extern void stg_exit(I_ n) __attribute__ ((noreturn));
Stable Name / Stable Pointer PrimOps
-------------------------------------------------------------------------- */
#ifndef PAR
EXTFUN_RTS(makeStableNamezh_fast);
#define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
......@@ -762,8 +760,6 @@ EXTFUN_RTS(makeStableNamezh_fast);
#define eqStablePtrzh(r,sp1,sp2) \
(r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK)))
#endif
/* -----------------------------------------------------------------------------
Concurrency/Exception PrimOps.
-------------------------------------------------------------------------- */
......@@ -793,7 +789,7 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
#if defined(GRAN)
//@cindex _par_
#define parzh(r,node) PAR(r,node,1,0,0,0,0,0)
#define parzh(r,node) parAny(r,node,1,0,0,0,0,0)
//@cindex _parAt_
#define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
......@@ -833,13 +829,13 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
//@cindex _parLocal_
#define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
PAR(r,node,rest,identifier,gran_info,size_info,par_info,1)
parAny(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) \
PAR(r,node,rest,identifier,gran_info,size_info,par_info,0)
parAny(r,node,rest,identifier,gran_info,size_info,par_info,0)
#define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \
#define parAny(r,node,rest,identifier,gran_info,size_info,par_info,local) \
{ \
if (closure_SHOULD_SPARK((StgClosure*)node)) { \
rtsSpark *result; \
......@@ -887,8 +883,6 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
Weak Pointer PrimOps.
-------------------------------------------------------------------------- */
#ifndef PAR
EXTFUN_RTS(mkWeakzh_fast);
EXTFUN_RTS(finalizzeWeakzh_fast);
......@@ -903,14 +897,11 @@ EXTFUN_RTS(finalizzeWeakzh_fast);
#define sameWeakzh(w1,w2) ((w1)==(w2))
#endif
/* -----------------------------------------------------------------------------
Foreign Object PrimOps.
-------------------------------------------------------------------------- */
#ifndef PAR
#define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
#define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo)
......@@ -942,9 +933,6 @@ EXTFUN_RTS(mkForeignObjzh_fast);
#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#endif
#endif
/* -----------------------------------------------------------------------------
Constructor tags
-------------------------------------------------------------------------- */
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.h,v 1.20 2001/02/09 12:09:33 simonmar Exp $
* $Id: RtsAPI.h,v 1.21 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -95,11 +95,6 @@ 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);
......
/*
Time-stamp: <Mon Nov 22 1999 21:29:44 Stardate: [-30]3939.47 hwloidl>
Time-stamp: <Mon Mar 05 2001 22:39:27 Stardate: [-30]6284.72 hwloidl>
RTS specific types.
*/
......@@ -68,6 +68,9 @@ typedef struct gala {
#elif defined(GRAN)
// GlobalTaskId is dummy in GranSim;
// we define it to have cleaner code in the RTS
typedef int GlobalTaskId;
typedef lnat rtsTime;
typedef StgWord PEs;
......
/* -----------------------------------------------------------------------------
* $Id: SchedAPI.h,v 1.12 2000/12/04 12:31:20 simonmar Exp $
* $Id: SchedAPI.h,v 1.13 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team 1998
*
......@@ -32,6 +32,9 @@ StgTSO *createThread(nat stack_size, StgInt pri);
#else
StgTSO *createThread(nat stack_size);
#endif
#if defined(PAR) || defined(SMP)
void taskStart(void);
#endif
void scheduleThread(StgTSO *tso);
static inline void pushClosure (StgTSO *tso, StgClosure *c) {
......
/* -----------------------------------------------------------------------------
* $Id: StgMiscClosures.h,v 1.37 2001/02/15 14:27:36 sewardj Exp $
* $Id: StgMiscClosures.h,v 1.38 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -78,12 +78,17 @@ extern DLL_IMPORT_RTS const StgInfoTable stg_gc_unbx_r1_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_gc_f1_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_gc_d1_info;
/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */
#define END_TSO_QUEUE ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure)
/* this is the NIL ptr for a list CAFs */
#define END_ECAF_LIST ((StgCAF *)(void*)&stg_END_TSO_QUEUE_closure)
#if defined(PAR) || defined(GRAN)
/* this is the NIL ptr for a blocking queue */
# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&END_TSO_QUEUE_closure)
# define END_BQ_QUEUE ((StgBlockingQueueElement *)(void*)&stg_END_TSO_QUEUE_closure)
/* this is the NIL ptr for a blocked fetch queue (as in PendingFetches in GUM) */
# define END_BF_QUEUE ((StgBlockedFetch *)(void*)&END_TSO_QUEUE_closure)
# define END_BF_QUEUE ((StgBlockedFetch *)(void*)&stg_END_TSO_QUEUE_closure)
#endif
/* ToDo?: different name for end of sleeping queue ? -- HWL */
/* info tables */
......@@ -107,6 +112,9 @@ extern DLL_IMPORT_RTS const StgInfoTable stg_SE_CAF_BLACKHOLE_info;
#if defined(PAR) || defined(GRAN)
extern DLL_IMPORT_RTS const StgInfoTable stg_RBH_info;
#endif
#if defined(PAR)
extern DLL_IMPORT_RTS const StgInfoTable stg_FETCH_ME_BQ_info;
#endif
extern DLL_IMPORT_RTS const StgInfoTable stg_BCO_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_EVACUATED_info;
extern DLL_IMPORT_RTS const StgInfoTable stg_FOREIGN_info;
......
/* -----------------------------------------------------------------------------
* $Id: TSO.h,v 1.19 2000/12/14 15:19:47 sewardj Exp $
* $Id: TSO.h,v 1.20 2001/03/22 03:51:09 hwloidl Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -12,8 +12,7 @@
#if defined(GRAN) || defined(PAR)
#if DEBUG // && PARANOIA_LEVEL>999
// magic marker for TSOs; debugging only
#if DEBUG
#define TSO_MAGIC 4321
#endif
......@@ -53,6 +52,17 @@ typedef struct {
} StgTSOParInfo;
#endif /* PAR */
#if defined(DIST)
typedef struct {
StgThreadPriority priority;
StgInt revalTid; /* ToDo: merge both into 1 word */
StgInt revalSlot;
} StgTSODistInfo;
#else /* !DIST */
typedef struct {
} StgTSODistInfo;
#endif /* DIST */
#if defined(GRAN)
typedef StgTSOStatBuf StgTSOGranInfo;
#else /* !GRAN */
......@@ -108,6 +118,16 @@ typedef enum {
ThreadFinished
} StgThreadReturnCode;
/*
* We distinguish between the various classes of threads in the system.
*/
typedef enum {
AdvisoryPriority,
MandatoryPriority,
RevalPriority
} StgThreadPriority;
/*
* Threads may be blocked for several reasons. A blocked thread will
* have the reason in the why_blocked field of the TSO, and some
......@@ -164,7 +184,8 @@ typedef struct StgTSO_ {
StgTSOProfInfo prof;