Commit c6ab4bfa authored by simonmar's avatar simonmar

[project @ 1999-08-25 16:11:43 by simonmar]

Support for thread{WaitRead,WaitWrite,Delay}.  These should behave
identically to the 3.02 implementations.

We now have the virtual timer on during all program runs, which ticks
at 50Hz by default.  This is used to implement threadDelay, so you
won't get any better granularity than the tick frequency
unfortunately.  It remains to be seen whether using the virtual timer
will have a measurable impact on performance for non-threadDelaying
programs.

All operations in the I/O subsystem should now be non-blocking with
respect to other running Haskell threads.  It remains to be seen
whether this will have a measurable performance impact on
non-concurrent programs (probably not).
parent 983f86ef
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.36 1999/08/25 10:23:51 simonmar Exp $
* $Id: PrimOps.h,v 1.37 1999/08/25 16:11:43 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -663,7 +663,9 @@ EF_(putMVarzh_fast);
Delay/Wait PrimOps
-------------------------------------------------------------------------- */
/* Hmm, I'll think about these later. */
EF_(waitReadzh_fast);
EF_(waitWritezh_fast);
EF_(delayzh_fast);
/* -----------------------------------------------------------------------------
Primitive I/O, error-handling PrimOps
......
/* -----------------------------------------------------------------------------
* $Id: Rts.h,v 1.6 1999/02/05 16:02:27 simonm Exp $
* $Id: Rts.h,v 1.7 1999/08/25 16:11:44 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -85,6 +85,4 @@ typedef enum {
#define stg_min(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _a : _b; })
#define stg_max(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _b : _a; })
#define UNUSED __attribute__((unused))
#endif RTS_H
/* -----------------------------------------------------------------------------
* $Id: TSO.h,v 1.7 1999/05/11 16:47:42 keithw Exp $
* $Id: TSO.h,v 1.8 1999/08/25 16:11:44 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -70,6 +70,29 @@ typedef enum {
ThreadFinished
} StgThreadReturnCode;
/*
* Threads may be blocked for several reasons. A blocked thread will
* have the reason in the why_blocked field of the TSO, and some
* further info (such as the closure the thread is blocked on, or the
* file descriptor if the thread is waiting on I/O) in the block_info
* field.
*/
typedef enum {
NotBlocked,
BlockedOnMVar,
BlockedOnBlackHole,
BlockedOnRead,
BlockedOnWrite,
BlockedOnDelay
} StgTSOBlockReason;
typedef union {
StgClosure *closure;
int fd;
unsigned int delay;
} StgTSOBlockInfo;
/*
* TSOs live on the heap, and therefore look just like heap objects.
* Large TSOs will live in their own "block group" allocated by the
......@@ -81,7 +104,8 @@ typedef struct StgTSO_ {
struct StgTSO_* link;
StgMutClosure * mut_link; /* TSO's are mutable of course! */
StgTSOWhatNext whatNext;
StgClosure * blocked_on;
StgTSOBlockReason why_blocked;
StgTSOBlockInfo block_info;
StgThreadID id;
StgTSOTickyInfo ticky;
StgTSOProfInfo prof;
......
/* -----------------------------------------------------------------------------
* $Id: Updates.h,v 1.11 1999/05/13 17:31:08 simonm Exp $
* $Id: Updates.h,v 1.12 1999/08/25 16:11:44 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -51,13 +51,13 @@
Awaken any threads waiting on this computation
-------------------------------------------------------------------------- */
extern void awaken_blocked_queue(StgTSO *q);
extern void awakenBlockedQueue(StgTSO *q);
#define AWAKEN_BQ(closure) \
if (closure->header.info == &BLACKHOLE_BQ_info) { \
StgTSO *bq = ((StgBlockingQueue *)closure)->blocking_queue;\
if (bq != (StgTSO *)&END_TSO_QUEUE_closure) { \
STGCALL1(awaken_blocked_queue, bq); \
STGCALL1(awakenBlockedQueue, bq); \
} \
}
......
......@@ -31,7 +31,9 @@ module Concurrent (
, fork -- :: a -> b -> b
, yield -- :: IO ()
{-threadDelay, threadWaitRead, threadWaitWrite,-}
, threadDelay -- :: Int -> IO ()
, threadWaitRead -- :: Int -> IO ()
, threadWaitWrite -- :: Int -> IO ()
-- MVars
, MVar -- abstract
......@@ -54,7 +56,8 @@ import Channel
import Semaphore
import SampleVar
import PrelConc
import PrelHandle ( topHandler )
import PrelHandle ( topHandler, threadDelay,
threadWaitRead, threadWaitWrite )
import PrelException
import PrelIOBase ( IO(..) )
import IO
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.60 1999/06/29 13:04:38 panne Exp $
* $Id: GC.c,v 1.61 1999/08/25 16:11:46 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -1842,8 +1842,9 @@ scavenge(step *step)
evac_gen = 0;
/* chase the link field for any TSOs on the same queue */
(StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
if (tso->blocked_on) {
tso->blocked_on = evacuate(tso->blocked_on);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole) {
tso->block_info.closure = evacuate(tso->block_info.closure);
}
/* scavenge this thread's stack */
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
......@@ -2195,8 +2196,9 @@ scavenge_mutable_list(generation *gen)
StgTSO *tso = (StgTSO *)p;
(StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
if (tso->blocked_on) {
tso->blocked_on = evacuate(tso->blocked_on);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole) {
tso->block_info.closure = evacuate(tso->block_info.closure);
}
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
......@@ -2571,8 +2573,9 @@ scavenge_large(step *step)
tso = (StgTSO *)p;
/* chase the link field for any TSOs on the same queue */
(StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
if (tso->blocked_on) {
tso->blocked_on = evacuate(tso->blocked_on);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole) {
tso->block_info.closure = evacuate(tso->block_info.closure);
}
/* scavenge this thread's stack */
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
......
/* -----------------------------------------------------------------------------
* $Id: HeapStackCheck.h,v 1.4 1999/08/25 16:11:48 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
* Prototypes for functions in HeapStackCheck.hc
*
* ---------------------------------------------------------------------------*/
EXTFUN(stg_gc_entertop);
EXTFUN(stg_gc_enter_1);
EXTFUN(stg_gc_enter_2);
......@@ -38,4 +47,5 @@ EXTFUN(stg_gen_yield);
EXTFUN(stg_yield_noregs);
EXTFUN(stg_yield_to_Hugs);
EXTFUN(stg_gen_block);
EXTFUN(stg_block_noregs);
EXTFUN(stg_block_1);
/* -----------------------------------------------------------------------------
* $Id: HeapStackCheck.hc,v 1.8 1999/05/24 10:58:09 simonmar Exp $
* $Id: HeapStackCheck.hc,v 1.9 1999/08/25 16:11:48 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -295,6 +295,10 @@ EXTFUN(stg_gc_seq_1)
/*-- No regsiters live (probably a void return) ----------------------------- */
/* If we change the policy for thread startup to *not* remove the
* return address from the stack, we can get rid of this little
* function/info table...
*/
INFO_TABLE_SRT_BITMAP(stg_gc_noregs_ret_info, stg_gc_noregs_ret, 0/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
RET_SMALL,, EF_, 0, 0);
......@@ -823,22 +827,11 @@ FN_(stg_gen_yield)
FE_
}
INFO_TABLE_SRT_BITMAP(stg_yield_noregs_info, stg_yield_noregs_ret, 0/*BITMAP*/,
0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/,
RET_SMALL,, EF_, 0, 0);
FN_(stg_yield_noregs_ret)
{
FB_
JMP_(ENTRY_CODE(Sp[0]));
FE_
}
FN_(stg_yield_noregs)
{
FB_
Sp--;
Sp[0] = (W_)&stg_yield_noregs_info;
Sp[0] = (W_)&stg_gc_noregs_ret_info;
YIELD_GENERIC;
FE_
}
......@@ -863,6 +856,15 @@ FN_(stg_gen_block)
FE_
}
FN_(stg_block_noregs)
{
FB_
Sp--;
Sp[0] = (W_)&stg_gc_noregs_ret_info;
BLOCK_GENERIC;
FE_
}
FN_(stg_block_1)
{
FB_
......
/* -----------------------------------------------------------------------------
* $Id: Itimer.c,v 1.4 1999/03/03 19:00:07 sof Exp $
* $Id: Itimer.c,v 1.5 1999/08/25 16:11:48 simonmar Exp $
*
* (c) The GHC Team, 1995-1999
*
......@@ -24,6 +24,7 @@
#include "Rts.h"
#include "Itimer.h"
#include "Schedule.h"
/* As recommended in the autoconf manual */
# ifdef TIME_WITH_SYS_TIME
......@@ -41,6 +42,34 @@
# include <windows.h>
#endif
lnat total_ticks = 0;
rtsBool do_prof_ticks = rtsFalse;
static void handle_tick(int unused STG_UNUSED);
/* -----------------------------------------------------------------------------
Tick handler
We use the ticker for two things: supporting threadDelay, and time
profiling.
-------------------------------------------------------------------------- */
static void
handle_tick(int unused STG_UNUSED)
{
total_ticks++;
#ifdef PROFILING
if (do_prof_ticks = rtsTrue) {
CCS_TICK(CCCS);
}
#endif
/* For threadDelay etc., see Select.c */
ticks_since_select++;
}
/*
* Handling timer events under cygwin32 is not done with signal/setitimer.
* Instead of the two steps of first registering a signal handler to handle
......@@ -132,19 +161,19 @@ initialize_virtual_timer(nat ms)
#if defined(mingw32_TARGET_OS) || (defined(cygwin32_TARGET_OS) && !defined(HAVE_SETITIMER))
int
install_vtalrm_handler(void (*handler)(int))
install_vtalrm_handler(void)
{
vtalrm_cback = handler;
vtalrm_cback = handle_tick;
return 0;
}
#else
int
install_vtalrm_handler(void (*handler)(int))
install_vtalrm_handler(void)
{
struct sigaction action;
action.sa_handler = handler;
action.sa_handler = handle_tick;
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
......
/* -----------------------------------------------------------------------------
* $Id: Itimer.h,v 1.3 1999/02/05 16:02:44 simonm Exp $
* $Id: Itimer.h,v 1.4 1999/08/25 16:11:48 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -7,9 +7,12 @@
*
* ---------------------------------------------------------------------------*/
# define TICK_FREQUENCY 50 /* ticks per second */
# define TICK_MILLISECS (1000/TICK_FREQUENCY) /* ms per tick */
extern rtsBool do_prof_ticks; /* profiling ticks on/off */
nat initialize_virtual_timer ( nat ms );
int install_vtalrm_handler ( void (*handler)(int) );
int install_vtalrm_handler ( void );
void block_vtalrm_signal ( void );
void unblock_vtalrm_signal ( void );
/* -----------------------------------------------------------------------------
* $Id: PrimOps.hc,v 1.28 1999/07/14 13:42:28 simonmar Exp $
* $Id: PrimOps.hc,v 1.29 1999/08/25 16:11:48 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -842,7 +842,8 @@ FN_(takeMVarzh_fast)
mvar->tail->link = CurrentTSO;
}
CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
CurrentTSO->blocked_on = (StgClosure *)mvar;
CurrentTSO->why_blocked = BlockedOnMVar;
CurrentTSO->block_info.closure = (StgClosure *)mvar;
mvar->tail = CurrentTSO;
BLOCK(R1_PTR, takeMVarzh_fast);
......@@ -860,7 +861,6 @@ FN_(takeMVarzh_fast)
FN_(putMVarzh_fast)
{
StgMVar *mvar;
StgTSO *tso;
FB_
/* args: R1 = MVar, R2 = value */
......@@ -874,15 +874,12 @@ FN_(putMVarzh_fast)
SET_INFO(mvar,&FULL_MVAR_info);
mvar->value = R2.cl;
/* wake up the first thread on the queue,
* it will continue with the takeMVar operation and mark the MVar
* empty again.
/* wake up the first thread on the queue, it will continue with the
* takeMVar operation and mark the MVar empty again.
*/
tso = mvar->head;
if (tso != (StgTSO *)&END_TSO_QUEUE_closure) {
PUSH_ON_RUN_QUEUE(tso);
mvar->head = tso->link;
tso->link = (StgTSO *)&END_TSO_QUEUE_closure;
if (mvar->head != (StgTSO *)&END_TSO_QUEUE_closure) {
ASSERT(mvar->head->why_blocked == BlockedOnMVar);
mvar->head = RET_STGCALL1(StgTSO *,unblockOne,mvar->head);
if (mvar->head == (StgTSO *)&END_TSO_QUEUE_closure) {
mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure;
}
......@@ -924,5 +921,50 @@ FN_(makeStableNamezh_fast)
RET_P(sn_obj);
}
/* -----------------------------------------------------------------------------
Thread I/O blocking primitives
-------------------------------------------------------------------------- */
FN_(waitReadzh_fast)
{
FB_
/* args: R1.i */
ASSERT(CurrentTSO->why_blocked == NotBlocked);
CurrentTSO->why_blocked = BlockedOnRead;
CurrentTSO->block_info.fd = R1.i;
PUSH_ON_BLOCKED_QUEUE(CurrentTSO);
JMP_(stg_block_noregs);
FE_
}
FN_(waitWritezh_fast)
{
FB_
/* args: R1.i */
ASSERT(CurrentTSO->why_blocked == NotBlocked);
CurrentTSO->why_blocked = BlockedOnWrite;
CurrentTSO->block_info.fd = R1.i;
PUSH_ON_BLOCKED_QUEUE(CurrentTSO);
JMP_(stg_block_noregs);
FE_
}
FN_(delayzh_fast)
{
FB_
/* args: R1.i */
ASSERT(CurrentTSO->why_blocked == NotBlocked);
CurrentTSO->why_blocked = BlockedOnDelay;
/* Add on ticks_since_select, since these will be subtracted at
* the next awaitEvent call.
*/
CurrentTSO->block_info.delay = R1.i + ticks_since_select;
PUSH_ON_BLOCKED_QUEUE(CurrentTSO);
JMP_(stg_block_noregs);
FE_
}
#endif /* COMPILER */
/* -----------------------------------------------------------------------------
* $Id: ProfRts.h,v 1.3 1999/02/05 16:02:47 simonm Exp $
* $Id: ProfRts.h,v 1.4 1999/08/25 16:11:49 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -23,9 +23,6 @@ void print_ccs (FILE *, CostCentreStack *);
void report_ccs_profiling( void );
# define TICK_FREQUENCY 50 /* ticks per second */
# define TICK_MILLISECS (1000/TICK_FREQUENCY) /* ms per tick */
# define DEFAULT_INTERVAL TICK_FREQUENCY
extern rtsBool time_profiling;
......
/* -----------------------------------------------------------------------------
* $Id: Profiling.c,v 1.7 1999/06/29 13:04:40 panne Exp $
* $Id: Profiling.c,v 1.8 1999/08/25 16:11:49 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -45,7 +45,7 @@ rtsBool time_profiling = rtsFalse;
/* figures for the profiling report.
*/
static lnat total_alloc, total_ticks;
static lnat total_alloc, total_prof_ticks;
/* Globals for opening the profiling log file
*/
......@@ -183,9 +183,7 @@ initProfiling (void)
ccs = next;
}
/* profiling is the only client of the VTALRM system at the moment,
* so just install the profiling tick handler. */
install_vtalrm_handler(handleProfTick);
/* Start ticking */
startProfTimer();
};
......@@ -196,7 +194,7 @@ endProfiling ( void )
}
void
heapCensus ( bdescr *bd UNUSED )
heapCensus ( bdescr *bd STG_UNUSED )
{
/* nothing yet */
}
......@@ -512,7 +510,7 @@ report_ccs_profiling( void )
stopProfTimer();
total_ticks = 0;
total_prof_ticks = 0;
total_alloc = 0;
count_ticks(CCS_MAIN);
......@@ -535,8 +533,8 @@ report_ccs_profiling( void )
fprintf(prof_file, "\n\n");
fprintf(prof_file, "\ttotal time = %11.2f secs (%lu ticks @ %d ms)\n",
total_ticks / (StgFloat) TICK_FREQUENCY,
total_ticks, TICK_MILLISECS);
total_prof_ticks / (StgFloat) TICK_FREQUENCY,
total_prof_ticks, TICK_MILLISECS);
fprintf(prof_file, "\ttotal alloc = %11s bytes",
ullong_format_string((ullong) total_alloc * sizeof(W_),
......@@ -596,7 +594,7 @@ reportCCS(CostCentreStack *ccs, nat indent)
fprintf(prof_file, "%8ld %4.1f %4.1f %8ld %5ld",
ccs->scc_count,
total_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_ticks * 100),
total_prof_ticks == 0 ? 0.0 : (ccs->time_ticks / (StgFloat) total_prof_ticks * 100),
total_alloc == 0 ? 0.0 : (ccs->mem_alloc / (StgFloat) total_alloc * 100),
ccs->sub_scc_count, ccs->sub_cafcc_count);
......@@ -628,7 +626,7 @@ count_ticks(CostCentreStack *ccs)
if (!ccs_to_ignore(ccs)) {
total_alloc += ccs->mem_alloc;
total_ticks += ccs->time_ticks;
total_prof_ticks += ccs->time_ticks;
}
for (i = ccs->indexTable; i != NULL; i = i->next)
count_ticks(i->ccs);
......
/* -----------------------------------------------------------------------------
* $Id: Proftimer.c,v 1.4 1999/08/04 17:03:41 panne Exp $
* $Id: Proftimer.c,v 1.5 1999/08/25 16:11:49 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -16,8 +16,6 @@
#include "Itimer.h"
#include "Proftimer.h"
lnat total_ticks = 0;
nat current_interval = 1; /* Current interval number --
stored in AGE */
......@@ -26,21 +24,11 @@ nat interval_ticks = DEFAULT_INTERVAL; /* No of ticks in an interval */
nat previous_ticks = 0; /* ticks in previous intervals */
nat current_ticks = 0; /* ticks in current interval */
void
initProfTimer(nat ms)
{
if (initialize_virtual_timer(ms)) {
fflush(stdout);
fprintf(stderr, "Can't initialize virtual timer.\n");
stg_exit(EXIT_FAILURE);
}
};
void
stopProfTimer(void)
{ /* Stops time profile */
if (time_profiling) {
initProfTimer(0);
do_prof_ticks = rtsFalse;
}
};
......@@ -48,19 +36,8 @@ void
startProfTimer(void)
{ /* Starts time profile */
if (time_profiling) {
initProfTimer(TICK_MILLISECS);
do_prof_ticks = rtsTrue;
}
};
/* For a small collection of signal handler prototypes, see
http://web2.airmail.net/sjbaker1/software/signal_collection.html */
void
handleProfTick(int unused)
{
(void)unused; /* no warnings, please */
CCS_TICK(CCCS);
total_ticks++;
};
#endif /* PROFILING */
/* -----------------------------------------------------------------------------
* $Id: Proftimer.h,v 1.3 1999/08/04 17:03:41 panne Exp $
* $Id: Proftimer.h,v 1.4 1999/08/25 16:11:50 simonmar Exp $
*
* (c) The GHC Team, 1998
*
......@@ -7,6 +7,8 @@
*
* ---------------------------------------------------------------------------*/
extern lnat total_prof_ticks;
extern void initProfTimer(nat ms);
extern void stopProfTimer(void);
extern void startProfTimer(void);
......
/* -----------------------------------------------------------------------------
* $Id: RtsFlags.c,v 1.14 1999/05/20 10:23:42 simonmar Exp $
* $Id: RtsFlags.c,v 1.15 1999/08/25 16:11:50 simonmar Exp $
*
* (c) The AQUA Project, Glasgow University, 1994-1997
* (c) The GHC Team, 1998-1999
......@@ -97,23 +97,7 @@ void initRtsFlagsDefaults(void)
RtsFlags.ProfFlags.doHeapProfile = rtsFalse;
#endif
/* there really shouldn't be a threads limit for concurrent mandatory threads.
For now, unlimitied means less than 64k (there's a storage overhead) -- SOF
*/
#if defined(CONCURRENT) && !defined(GRAN)
RtsFlags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */
RtsFlags.ConcFlags.maxThreads = 65536;
RtsFlags.ConcFlags.stkChunkSize = 1024;
RtsFlags.ConcFlags.maxLocalSparks = 65536;
#endif /* CONCURRENT only */
#if GRAN
RtsFlags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */
RtsFlags.ConcFlags.maxThreads = 32;
RtsFlags.ConcFlags.stkChunkSize = 1024;
RtsFlags.ConcFlags.maxLocalSparks = 500;
#endif /* GRAN */
#ifdef PAR
RtsFlags.ParFlags.parallelStats = rtsFalse;
RtsFlags.ParFlags.granSimStats = rtsFalse;
......@@ -279,16 +263,11 @@ usage_text[] = {
" -C<secs> Context-switch interval in seconds",
" (0 or no argument means switch as often as possible)",
" the default is .01 sec; resolution is .01 sec",
" -e<size> Size of spark pools (default 100)",
# ifdef PAR
" -q Enable activity profile (output files in ~/<program>*.gr)",
" -qb Enable binary activity profile (output file /tmp/<program>.gb)",
" -Q<size> Set pack-buffer size (default: 1024)",
# else
" -q[v] Enable quasi-parallel profile (output file <program>.qp)",
# endif
" -t<num> Set maximum number of advisory threads per PE (default 32)",
" -o<num> Set stack chunk size (default 1024)",
# ifdef PAR
" -d Turn on PVM-ish debugging",
" -O Disable output for performance measurement",
......@@ -735,16 +714,6 @@ error = rtsTrue;
}
break;
case 't':
if (rts_argv[arg][2] != '\0') {
RtsFlags.ConcFlags.maxThreads
= strtol(rts_argv[arg]+2, (char **) NULL, 10);
} else {
fprintf(stderr, "setupRtsFlags: missing size for -t\n");
error = rtsTrue;
}
break;
/* =========== PARALLEL =========================== */
case 'e':
PAR_BUILD_ONLY(
......
/* -----------------------------------------------------------------------------
* $Id: RtsFlags.h,v 1.14 1999/06/25 09:18:49 simonmar Exp $
* $Id: RtsFlags.h,v 1.15 1999/08/25 16:11:50 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -85,6 +85,7 @@ struct COST_CENTRE_FLAGS {
#ifdef PROFILING
struct PROFILING_FLAGS {
unsigned int doHeapProfile;
# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */
# define HEAP_BY_CC 1
# define HEAP_BY_MOD 2
......@@ -118,7 +119,6 @@ struct PROFILING_FLAGS {
struct CONCURRENT_FLAGS {
int ctxtSwitchTime; /* in milliseconds */
int maxThreads;
};
#ifdef PAR
......
/* -----------------------------------------------------------------------------
* $Id: RtsStartup.c,v 1.17 1999/07/06 15:33:23 simonmar Exp $
* $Id: RtsStartup.c,v 1.18 1999/08/25 16:11:50 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -15,6 +15,8 @@
#include "StablePriv.h" /* initStablePtrTable */
#include "Schedule.h" /* initScheduler */
#include "Stats.h" /* initStats */
#include "Signals.h"
#include "Itimer.h"
#include "Weak.h"
#include "Ticky.h"
......@@ -110,15 +112,18 @@ startupHaskell(int argc, char *argv[])
initProfiling();
#endif
/* start the ticker */
install_vtalrm_handler();
initialize_virtual_timer(TICK_MILLISECS);
/* Initialise the scheduler */
initScheduler();
/* Initialise the stats department */
initStats();
#if 0
/* Initialise the user signal handler set */
initUserSignals();
#endif
/* When the RTS and Prelude live in separate DLLs,
we need to patch up the char- and int-like tables
......@@ -171,6 +176,9 @@ shutdownHaskell(void)
/* clean up things from the storage manager's point of view */
exitStorage();
/* stop the ticker */
initialize_virtual_timer(0);
#if defined(PROFILING) || defined(DEBUG)
endProfiling();
#endif
......
/* -----------------------------------------------------------------------------
* $Id: RtsUtils.c,v 1.8 1999/03/17 13:19:23 simonm Exp $
* $Id: RtsUtils.c,v 1.9 1999/08/25 16:11:51 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -27,7 +27,7 @@ void barf(char *s, ...)
{
va_list ap;
va_start(ap,s);
fflush(stdout);
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
if (prog_argv != NULL && prog_argv[0] != NULL) {
fprintf(stderr, "%s: fatal error: ", prog_argv[0]);
} else {
......@@ -43,7 +43,7 @@ void belch(char *s, ...)
{
va_list ap;
va_start(ap,s);
fflush(stdout);
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
vfprintf(stderr, s, ap);
fprintf(stderr, "\n");
}
......@@ -56,7 +56,7 @@ stgMallocBytes (int n, char *msg)
char *space;
if ((space = (char *) malloc((size_t) n)) == NULL) {
fflush(stdout);
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
MallocFailHook((W_) n, msg); /*msg*/
stg_exit(EXIT_FAILURE);
}
......@@ -69,7 +69,7 @@ stgReallocBytes (void *p, int n, char *msg)