[project @ 2000-12-05 12:09:43 by sewardj]
[ghc-hetmet.git] / ghc / rts / Schedule.c
index 786015c..f0c6019 100644 (file)
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.78 2000/08/25 13:12:07 simonmar Exp $
+ * $Id: Schedule.c,v 1.83 2000/12/04 12:31:21 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -214,6 +214,12 @@ Capability MainRegTable;       /* for non-SMP, we have one global capability */
 StgTSO *CurrentTSO;
 #endif
 
+/*  This is used in `TSO.h' and gcc 2.96 insists that this variable actually 
+ *  exists - earlier gccs apparently didn't.
+ *  -= chak
+ */
+StgTSO dummy_tso;
+
 rtsBool ready_to_gc;
 
 /* All our current task ids, saved in case we need to kill them later.
@@ -1241,6 +1247,7 @@ resumeThread( StgInt tok )
   if (tso == END_TSO_QUEUE) {
     barf("resumeThread: thread not found");
   }
+  tso->link = END_TSO_QUEUE;
 
 #ifdef SMP
   while (free_capabilities == NULL) {
@@ -1352,7 +1359,7 @@ createThread_(nat size, rtsBool have_lock)
   tso = (StgTSO *)allocate(size);
   TICK_ALLOC_TSO(size-TSO_STRUCT_SIZEW, 0);
 
-  SET_HDR(tso, &TSO_info, CCS_SYSTEM);
+  SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM);
 #if defined(GRAN)
   SET_GRAN_HDR(tso, ThisPE);
 #endif
@@ -2251,9 +2258,9 @@ unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node)
         see comments on RBHSave closures above */
     case CONSTR:
       /* check that the closure is an RBHSave closure */
-      ASSERT(get_itbl((StgClosure *)bqe) == &RBH_Save_0_info ||
-            get_itbl((StgClosure *)bqe) == &RBH_Save_1_info ||
-            get_itbl((StgClosure *)bqe) == &RBH_Save_2_info);
+      ASSERT(get_itbl((StgClosure *)bqe) == &stg_RBH_Save_0_info ||
+            get_itbl((StgClosure *)bqe) == &stg_RBH_Save_1_info ||
+            get_itbl((StgClosure *)bqe) == &stg_RBH_Save_2_info);
       break;
 
     default:
@@ -2751,7 +2758,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
    * returns to the next return address on the stack.
    */
   if ( LOOKS_LIKE_GHC_INFO((void*)*sp) ) {
-    *(--sp) = (W_)&dummy_ret_closure;
+    *(--sp) = (W_)&stg_dummy_ret_closure;
   }
 
   while (1) {
@@ -2770,7 +2777,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
        */
       ap = (StgAP_UPD *)allocate(sizeofW(StgPAP) + 2);
       TICK_ALLOC_UPD_PAP(3,0);
-      SET_HDR(ap,&PAP_info,cf->header.prof.ccs);
+      SET_HDR(ap,&stg_PAP_info,cf->header.prof.ccs);
              
       ap->n_args = 2;
       ap->fun = cf->handler;   /* :: Exception -> IO a */
@@ -2791,7 +2798,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
        * unblockAsyncExceptions_ret stack frame.
        */
       if (!cf->exceptions_blocked) {
-       *(sp--) = (W_)&unblockAsyncExceptionszh_ret_info;
+       *(sp--) = (W_)&stg_unblockAsyncExceptionszh_ret_info;
       }
       
       /* Ensure that async exceptions are blocked when running the handler.
@@ -2829,7 +2836,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
       
     case UPDATE_FRAME:
       {
-       SET_HDR(ap,&AP_UPD_info,su->header.prof.ccs /* ToDo */); 
+       SET_HDR(ap,&stg_AP_UPD_info,su->header.prof.ccs /* ToDo */); 
        TICK_ALLOC_UP_THK(words+1,0);
        
        IF_DEBUG(scheduler,
@@ -2858,13 +2865,13 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
        /* We want a PAP, not an AP_UPD.  Fortunately, the
         * layout's the same.
         */
-       SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
+       SET_HDR(ap,&stg_PAP_info,su->header.prof.ccs /* ToDo */);
        TICK_ALLOC_UPD_PAP(words+1,0);
        
        /* now build o = FUN(catch,ap,handler) */
        o = (StgClosure *)allocate(sizeofW(StgClosure)+2);
        TICK_ALLOC_FUN(2,0);
-       SET_HDR(o,&catch_info,su->header.prof.ccs /* ToDo */);
+       SET_HDR(o,&stg_catch_info,su->header.prof.ccs /* ToDo */);
        o->payload[0] = (StgClosure *)ap;
        o->payload[1] = cf->handler;
        
@@ -2885,13 +2892,13 @@ raiseAsync(StgTSO *tso, StgClosure *exception)
        StgSeqFrame *sf = (StgSeqFrame *)su;
        StgClosure* o;
        
-       SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
+       SET_HDR(ap,&stg_PAP_info,su->header.prof.ccs /* ToDo */);
        TICK_ALLOC_UPD_PAP(words+1,0);
        
        /* now build o = FUN(seq,ap) */
        o = (StgClosure *)allocate(sizeofW(StgClosure)+1);
        TICK_ALLOC_SE_THK(1,0);
-       SET_HDR(o,&seq_info,su->header.prof.ccs /* ToDo */);
+       SET_HDR(o,&stg_seq_info,su->header.prof.ccs /* ToDo */);
        o->payload[0] = (StgClosure *)ap;
        
        IF_DEBUG(scheduler,
@@ -3030,34 +3037,34 @@ printThreadBlockage(StgTSO *tso)
 {
   switch (tso->why_blocked) {
   case BlockedOnRead:
-    fprintf(stderr,"blocked on read from fd %d", tso->block_info.fd);
+    fprintf(stderr,"is blocked on read from fd %d", tso->block_info.fd);
     break;
   case BlockedOnWrite:
-    fprintf(stderr,"blocked on write to fd %d", tso->block_info.fd);
+    fprintf(stderr,"is blocked on write to fd %d", tso->block_info.fd);
     break;
   case BlockedOnDelay:
-    fprintf(stderr,"blocked until %d", tso->block_info.target);
+    fprintf(stderr,"is blocked until %d", tso->block_info.target);
     break;
   case BlockedOnMVar:
-    fprintf(stderr,"blocked on an MVar");
+    fprintf(stderr,"is blocked on an MVar");
     break;
   case BlockedOnException:
-    fprintf(stderr,"blocked on delivering an exception to thread %d",
+    fprintf(stderr,"is blocked on delivering an exception to thread %d",
            tso->block_info.tso->id);
     break;
   case BlockedOnBlackHole:
-    fprintf(stderr,"blocked on a black hole");
+    fprintf(stderr,"is blocked on a black hole");
     break;
   case NotBlocked:
-    fprintf(stderr,"not blocked");
+    fprintf(stderr,"is not blocked");
     break;
 #if defined(PAR)
   case BlockedOnGA:
-    fprintf(stderr,"blocked on global address; local FM_BQ is %p (%s)",
+    fprintf(stderr,"is blocked on global address; local FM_BQ is %p (%s)",
            tso->block_info.closure, info_type(tso->block_info.closure));
     break;
   case BlockedOnGA_NoSend:
-    fprintf(stderr,"blocked on global address (no send); local FM_BQ is %p (%s)",
+    fprintf(stderr,"is blocked on global address (no send); local FM_BQ is %p (%s)",
            tso->block_info.closure, info_type(tso->block_info.closure));
     break;
 #endif
@@ -3089,7 +3096,7 @@ printAllThreads(void)
 
   sched_belch("all threads:");
   for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
-    fprintf(stderr, "\tthread %d is ", t->id);
+    fprintf(stderr, "\tthread %d ", t->id);
     printThreadStatus(t);
     fprintf(stderr,"\n");
   }
@@ -3145,9 +3152,9 @@ print_bq (StgClosure *node)
       break;
     case CONSTR:
       fprintf(stderr," %s (IP %p),",
-             (get_itbl(bqe) == &RBH_Save_0_info ? "RBH_Save_0" :
-              get_itbl(bqe) == &RBH_Save_1_info ? "RBH_Save_1" :
-              get_itbl(bqe) == &RBH_Save_2_info ? "RBH_Save_2" :
+             (get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" :
+              get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" :
+              get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" :
               "RBH_Save_?"), get_itbl(bqe));
       break;
     default:
@@ -3199,9 +3206,9 @@ print_bq (StgClosure *node)
       break;
     case CONSTR:
       fprintf(stderr," %s (IP %p),",
-             (get_itbl(bqe) == &RBH_Save_0_info ? "RBH_Save_0" :
-              get_itbl(bqe) == &RBH_Save_1_info ? "RBH_Save_1" :
-              get_itbl(bqe) == &RBH_Save_2_info ? "RBH_Save_2" :
+             (get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" :
+              get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" :
+              get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" :
               "RBH_Save_?"), get_itbl(bqe));
       break;
     default: