/* -----------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.2 1998/12/02 13:28:44 simonm Exp $
+ * $Id: Schedule.c,v 1.5 1999/01/21 10:31:50 simonm Exp $
*
* Scheduler
*
{
StgTSO *tso;
+ /* catch ridiculously small stack sizes */
+ if (stack_size < MIN_STACK_WORDS + TSO_STRUCT_SIZEW) {
+ stack_size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
+ }
+
tso = (StgTSO *)allocate(stack_size);
+ TICK_ALLOC_TSO(stack_size-sizeofW(StgTSO),0);
- initThread(tso, stack_size);
+ initThread(tso, stack_size - TSO_STRUCT_SIZEW);
return tso;
}
void
initThread(StgTSO *tso, nat stack_size)
{
- stack_size -= TSO_STRUCT_SIZEW;
-
- /* catch ridiculously small stack sizes */
- if (stack_size < MIN_STACK_WORDS) {
- stack_size = MIN_STACK_WORDS;
- }
-
SET_INFO(tso,&TSO_info);
tso->whatNext = ThreadEnterGHC;
tso->state = tso_state_runnable;
/* put a stop frame on the stack */
tso->sp -= sizeofW(StgStopFrame);
- SET_HDR(stgCast(StgClosure*,tso->sp),
- (StgInfoTable *)&stg_stop_thread_info,
- CCS_MAIN);
- tso->su = stgCast(StgUpdateFrame*,tso->sp);
+ SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_MAIN);
+ tso->su = (StgUpdateFrame*)tso->sp;
- IF_DEBUG(scheduler,belch("Initialised thread %lld, stack size = %lx words\n",
+ IF_DEBUG(scheduler,belch("Initialised thread %ld, stack size = %lx words\n",
tso->id, tso->stack_size));
/* Put the new thread on the head of the runnable queue.
return;
}
- IF_DEBUG(scheduler, belch("Killing thread %lld.", tso->id));
+ IF_DEBUG(scheduler, belch("Killing thread %ld.", tso->id));
tso->whatNext = ThreadKilled; /* changed to ThreadComplete in schedule() */
tso->link = END_TSO_QUEUE; /* Just to be on the safe side... */
int words = (stgCast(StgPtr,su) - stgCast(StgPtr,sp)) - 1;
nat i;
StgAP_UPD* ap = stgCast(StgAP_UPD*,allocate(AP_sizeW(words)));
+ TICK_ALLOC_THK(words+1,0);
/* First build an AP_UPD consisting of the stack chunk above the
* current update frame, with the top word on the stack as the
/* now build o = FUN(catch,ap,handler) */
o = stgCast(StgClosure*, allocate(sizeofW(StgClosure)+2));
+ TICK_ALLOC_THK(2,0);
SET_HDR(o,&catch_info,su->header.prof.ccs /* ToDo */);
payloadCPtr(o,0) = stgCast(StgClosure*,ap);
payloadCPtr(o,1) = cf->handler;
/* now build o = FUN(seq,ap) */
o = stgCast(StgClosure*, allocate(sizeofW(StgClosure)+1));
+ TICK_ALLOC_THK(1,0);
SET_HDR(o,&seq_info,su->header.prof.ccs /* ToDo */);
payloadCPtr(o,0) = stgCast(StgClosure*,ap);
ccalling_threads = CurrentTSO;
in_ccall_gc = rtsTrue;
IF_DEBUG(scheduler,
- fprintf(stderr, "Re-entry, thread %lld did a _ccall_gc\n",
+ fprintf(stderr, "Re-entry, thread %d did a _ccall_gc\n",
CurrentTSO->id););
} else {
in_ccall_gc = rtsFalse;
} else {
context_switch = 0;
}
- IF_DEBUG(scheduler, belch("Running thread %lld...\n", t->id));
+ IF_DEBUG(scheduler, belch("Running thread %ld...\n", t->id));
+
+ /* Be friendly to the storage manager: we're about to *run* this
+ * thread, so we better make sure the TSO is mutable.
+ */
+ recordMutable((StgMutClosure *)t);
/* Run the current thread */
switch (t->whatNext) {
switch (ret) {
case HeapOverflow:
- IF_DEBUG(scheduler,belch("Thread %lld stopped: HeapOverflow\n", t->id));
+ IF_DEBUG(scheduler,belch("Thread %ld stopped: HeapOverflow\n", t->id));
threadPaused(t);
PUSH_ON_RUN_QUEUE(t);
GarbageCollect(GetRoots);
break;
case StackOverflow:
- IF_DEBUG(scheduler,belch("Thread %lld stopped, StackOverflow\n", t->id));
+ IF_DEBUG(scheduler,belch("Thread %ld stopped, StackOverflow\n", t->id));
{
nat i;
/* enlarge the stack */
/* ToDo: or maybe a timer expired when we were in Hugs?
* or maybe someone hit ctrl-C
*/
- belch("Thread %lld stopped to switch to Hugs\n", t->id);
+ belch("Thread %ld stopped to switch to Hugs\n", t->id);
} else {
- belch("Thread %lld stopped, timer expired\n", t->id);
+ belch("Thread %ld stopped, timer expired\n", t->id);
}
);
threadPaused(t);
break;
case ThreadBlocked:
- IF_DEBUG(scheduler,belch("Thread %lld stopped, blocking\n", t->id));
+ IF_DEBUG(scheduler,belch("Thread %ld stopped, blocking\n", t->id));
threadPaused(t);
/* assume the thread has put itself on some blocked queue
* somewhere.
break;
case ThreadFinished:
- IF_DEBUG(scheduler,belch("Thread %lld finished\n", t->id));
+ IF_DEBUG(scheduler,belch("Thread %ld finished\n", t->id));
deleteThread(t);
t->whatNext = ThreadComplete;
break;
if (in_ccall_gc) {
CurrentTSO = ccalling_threads;
ccalling_threads = ccalling_threads->link;
+ /* remember to stub the link field of CurrentTSO */
+ CurrentTSO->link = END_TSO_QUEUE;
}
if ((*MainTSO)->whatNext == ThreadComplete) {
/* we finished successfully, fill in the return value */
IF_DEBUG(scheduler, fprintf(stderr,"increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
dest = (StgTSO *)allocate(new_tso_size);
+ TICK_ALLOC_TSO(new_tso_size-sizeofW(StgTSO),0);
/* copy the TSO block and the old stack into the new area */
memcpy(dest,tso,TSO_STRUCT_SIZE);
/* and relocate the update frame list */
relocate_TSO(tso, dest);
- IF_DEBUG(sanity,checkTSO(tso,0)); /* Step 0 because we're not GC'ing. */
+ /* Mark the old one as dead so we don't try to scavenge it during
+ * garbage collection (the TSO will likely be on a mutables list in
+ * some generation, but it'll get collected soon enough).
+ */
+ tso->whatNext = ThreadKilled;
+ dest->mut_link = NULL;
+
+ IF_DEBUG(sanity,checkTSO(tso));
#if 0
IF_DEBUG(scheduler,printTSO(dest));
#endif
tso = q;
q = tso->link;
PUSH_ON_RUN_QUEUE(tso);
- IF_DEBUG(scheduler,belch("Waking up thread %lld", tso->id));
+ IF_DEBUG(scheduler,belch("Waking up thread %ld", tso->id));
}
}
projects / ghc-hetmet.git / blobdiff