[project @ 2003-09-12 16:32:13 by sof]
[ghc-hetmet.git] / ghc / rts / Schedule.c
index 09fb05b..c58584f 100644 (file)
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.162 2003/02/22 04:51:53 sof Exp $
+ * $Id: Schedule.c,v 1.173 2003/08/15 12:43:57 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -91,7 +91,6 @@
 #include "Interpreter.h"
 #include "Exception.h"
 #include "Printer.h"
-#include "Main.h"
 #include "Signals.h"
 #include "Sanity.h"
 #include "Stats.h"
@@ -218,14 +217,15 @@ static StgThreadID next_thread_id = 1;
 /* The smallest stack size that makes any sense is:
  *    RESERVED_STACK_WORDS    (so we can get back from the stack overflow)
  *  + sizeofW(StgStopFrame)   (the stg_stop_thread_info frame)
- *  + 1                       (the realworld token for an IO thread)
  *  + 1                       (the closure to enter)
+ *  + 1                              (stg_ap_v_ret)
+ *  + 1                              (spare slot req'd by stg_ap_v_ret)
  *
  * A thread with this stack will bomb immediately with a stack
  * overflow, which will increase its stack size.  
  */
 
-#define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 2)
+#define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 3)
 
 
 #if defined(GRAN)
@@ -590,7 +590,7 @@ schedule( void )
 #endif // SMP
 
     /* check for signals each time around the scheduler */
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
     if (signals_pending()) {
       RELEASE_LOCK(&sched_mutex); /* ToDo: kill */
       startSignalHandlers();
@@ -657,7 +657,7 @@ schedule( void )
 
        if ( !EMPTY_RUN_QUEUE() ) { goto not_deadlocked; }
 
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
        /* If we have user-installed signal handlers, then wait
         * for signals to arrive rather then bombing out with a
         * deadlock.
@@ -1495,8 +1495,9 @@ run_thread:
  * Singleton fork(). Do not copy any running threads.
  * ------------------------------------------------------------------------- */
 
-StgInt forkProcess(StgTSO* tso) {
-
+StgInt
+forkProcess(StgTSO* tso)
+{
 #ifndef mingw32_TARGET_OS
   pid_t pid;
   StgTSO* t,*next;
@@ -1512,7 +1513,7 @@ StgInt forkProcess(StgTSO* tso) {
     
   } else { /* child */
   /* wipe all other threads */
-  run_queue_hd = run_queue_tl = tso;
+  run_queue_hd = run_queue_tl = END_TSO_QUEUE;
   tso->link = END_TSO_QUEUE;
 
   /* When clearing out the threads, we need to ensure
@@ -1572,7 +1573,8 @@ StgInt forkProcess(StgTSO* tso) {
  * Locks: sched_mutex held.
  * ------------------------------------------------------------------------- */
    
-void deleteAllThreads ( void )
+void
+deleteAllThreads ( void )
 {
   StgTSO* t, *next;
   IF_DEBUG(scheduler,sched_belch("deleting all threads"));
@@ -1670,11 +1672,7 @@ suspendThread( StgRegTable *reg,
 
 StgRegTable *
 resumeThread( StgInt tok,
-             rtsBool concCall
-#if !defined(RTS_SUPPORTS_THREADS)
-              STG_UNUSED
-#endif
-             )
+             rtsBool concCall STG_UNUSED )
 {
   StgTSO *tso, **prev;
   Capability *cap;
@@ -1766,11 +1764,8 @@ labelThread(StgPtr tso, char *label)
 
   /* Caveat: Once set, you can only set the thread name to "" */
   len = strlen(label)+1;
-  buf = malloc(len);
-  if (buf == NULL) {
-    fprintf(stderr,"insufficient memory for labelThread!\n");
-  } else
-    strncpy(buf,label,len);
+  buf = stgMallocBytes(len * sizeof(char), "Schedule.c:labelThread()");
+  strncpy(buf,label,len);
   /* Update will free the old memory for us */
   updateThreadLabel((StgWord)tso,buf);
 }
@@ -2363,7 +2358,7 @@ waitThread_(StgMainThread* m
 
   IF_DEBUG(scheduler, fprintf(stderr, "== scheduler: main thread (%d) finished\n", 
                              m->tso->id));
-  free(m);
+  stgFree(m);
 
   // Postcondition: sched_mutex still held
   return stat;
@@ -2538,7 +2533,7 @@ GetRoots(evac_fn evac)
   markSparkQueue(evac);
 #endif
 
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
   // mark the signal handlers (signals should be already blocked)
   markSignalHandlers(evac);
 #endif
@@ -2623,7 +2618,7 @@ performGCWithRoots(void (*get_roots)(evac_fn))
 static StgTSO *
 threadStackOverflow(StgTSO *tso)
 {
-  nat new_stack_size, new_tso_size, diff, stack_words;
+  nat new_stack_size, new_tso_size, stack_words;
   StgPtr new_sp;
   StgTSO *dest;
 
@@ -2664,8 +2659,7 @@ threadStackOverflow(StgTSO *tso)
   memcpy(new_sp, tso->sp, stack_words * sizeof(W_));
 
   /* relocate the stack pointers... */
-  diff = (P_)new_sp - (P_)tso->sp; /* In *words* */
-  dest->sp    = new_sp;
+  dest->sp         = new_sp;
   dest->stack_size = new_stack_size;
        
   /* Mark the old TSO as relocated.  We have to check for relocated
@@ -3109,6 +3103,9 @@ unblockThread(StgTSO *tso)
 
   case BlockedOnRead:
   case BlockedOnWrite:
+#if defined(mingw32_TARGET_OS)
+  case BlockedOnDoProc:
+#endif
     {
       /* take TSO off blocked_queue */
       StgBlockingQueueElement *prev = NULL;
@@ -3147,7 +3144,7 @@ unblockThread(StgTSO *tso)
          goto done;
        }
       }
-      barf("unblockThread (I/O): TSO not found");
+      barf("unblockThread (delay): TSO not found");
     }
 
   default:
@@ -3236,6 +3233,9 @@ unblockThread(StgTSO *tso)
 
   case BlockedOnRead:
   case BlockedOnWrite:
+#if defined(mingw32_TARGET_OS)
+  case BlockedOnDoProc:
+#endif
     {
       StgTSO *prev = NULL;
       for (t = blocked_queue_hd; t != END_TSO_QUEUE; 
@@ -3272,7 +3272,7 @@ unblockThread(StgTSO *tso)
          goto done;
        }
       }
-      barf("unblockThread (I/O): TSO not found");
+      barf("unblockThread (delay): TSO not found");
     }
 
   default:
@@ -3629,6 +3629,11 @@ printThreadBlockage(StgTSO *tso)
   case BlockedOnWrite:
     fprintf(stderr,"is blocked on write to fd %d", tso->block_info.fd);
     break;
+#if defined(mingw32_TARGET_OS)
+    case BlockedOnDoProc:
+    fprintf(stderr,"is blocked on proc (request: %d)", tso->block_info.async_result->reqID);
+    break;
+#endif
   case BlockedOnDelay:
     fprintf(stderr,"is blocked until %d", tso->block_info.target);
     break;