ghc/runtime/gum/ParInit.lc

   1 %****************************************************************************
   2 %
   3 \section[ParInit.lc]{Initialising the parallel RTS}
   4 %
   5 % (c) The Parade/AQUA Projects, Glasgow University, 1995.
   6 %     P. Trinder, January 17th 1995.
   7 % An extension based on Kevin Hammond's GRAPH for PVM version
   8 %
   9 %****************************************************************************
  10
  11 \begin{code}
  12 #ifdef PAR /* whole file */
  13
  14 #define NON_POSIX_SOURCE /* so says Solaris */
  15
  16 #include "rtsdefs.h"
  17 #include <setjmp.h>
  18 #include "LLC.h"
  19 #include "HLC.h"
  20 \end{code}
  21
  22 Global conditions defined here.
  23
  24 \begin{code}
  25 rtsBool
  26         OkToGC =                rtsFalse,       /* Set after initialisation     */
  27         IAmMainThread =         rtsFalse,       /* Set for the main thread      */
  28         GlobalStopPending =     rtsFalse,       /*  Terminate                   */
  29         GlobalGCPending =       rtsFalse;       /*  Start Global GC             */
  30 \end{code}
  31
  32 Task identifiers for various interesting global tasks.
  33
  34 \begin{code}
  35 GLOBAL_TASK_ID IOTask = 0,              /* The IO Task Id               */
  36                SysManTask = 0,          /* The System Manager Task Id   */
  37                GCManTask = 0,           /* The GC Manager Task Id       */
  38                StatsManTask = 0,        /* The Statistics Manager Task Id*/
  39                mytid = 0;               /* This PE's Task Id            */
  40 \end{code}
  41
  42 \begin{code}
  43 REAL_TIME       main_start_time;        /* When the program started     */
  44 REAL_TIME       main_stop_time;         /* When the program finished    */
  45 jmp_buf         exit_parallel_system;   /* How to abort from the RTS    */
  46 \end{code}
  47
  48 Flag handling.
  49
  50 \begin{code}
  51 rtsBool TraceSparks =    rtsFalse;              /* Enable the spark trace mode                  */
  52 rtsBool SparkLocally =   rtsFalse;              /* Use local threads if possible                */
  53 rtsBool DelaySparks =    rtsFalse;              /* Use delayed sparking                         */
  54 rtsBool LocalSparkStrategy =   rtsFalse;        /* Either delayed threads or local threads      */
  55 rtsBool GlobalSparkStrategy =   rtsFalse;       /* Export all threads                           */
  56
  57 rtsBool DeferGlobalUpdates =     rtsFalse;      /* Defer updating of global nodes               */
  58 rtsBool fishing = rtsFalse;                     /* We have no fish out in the stream            */
  59 \end{code}
  60
  61 \begin{code}
  62 void
  63 RunParallelSystem(program_closure)
  64 StgPtr program_closure;
  65 {
  66
  67     /* Return here when exiting the program. */
  68     if (setjmp(exit_parallel_system) != 0)
  69         return;
  70
  71     /* Show that we've started */
  72     if (IAmMainThread && ! RTSflags.ParFlags.outputDisabled)
  73         fprintf(stderr, "Starting main program...\n");
  74
  75     /* Record the start time for statistics purposes. */
  76     main_start_time = usertime();
  77     /* fprintf(stderr, "Start time is %u\n", main_start_time); */
  78
  79     /*
  80      * Start the main scheduler which will fish for threads on all but the PE with
  81      * the main thread
  82      */
  83
  84     ScheduleThreads(program_closure);
  85     myexit(1);
  86 }
  87 \end{code}
  88
  89 @myexit@ defines how to terminate the program.  If the exit code is
  90 non-zero (i.e. an error has occurred), the PE should not halt until
  91 outstanding error messages have been processed.  Otherwise, messages
  92 might be sent to non-existent Task Ids.  The infinite loop will actually
  93 terminate, since @STG_Exception@ will call @myexit@\tr{(0)} when
  94 it received a @PP_FINISH@ from the system manager task.
  95
  96 \begin{code}
  97 void
  98 myexit(n)                       /* NB: "EXIT" is set to "myexit" for parallel world */
  99 I_ n;
 100 {
 101     GlobalStopPending = rtsTrue;
 102     SendOp(PP_FINISH, SysManTask);
 103     if (n != 0)
 104       WaitForTermination();
 105     else
 106       WaitForPEOp(PP_FINISH, SysManTask);
 107     PEShutDown();
 108     fprintf(stderr,"PE %lx shutting down, %ld Threads run, %ld Sparks Ignored\n", (W_) mytid, threadId, sparksIgnored);
 109
 110     /* And actually terminate -- always with code 0 */
 111     longjmp(exit_parallel_system, 1);
 112 }
 113 \end{code}
 114
 115 \begin{code}
 116 void srand48 PROTO((long));
 117 time_t time PROTO((time_t *));
 118
 119 void
 120 initParallelSystem(STG_NO_ARGS)
 121 {
 122     /* Don't buffer standard channels... */
 123     setbuf(stdout,NULL);
 124     setbuf(stderr,NULL);
 125
 126     srand48(time(NULL) * getpid());     /*Initialise Random-number generator seed*/
 127
 128     OkToGC = rtsFalse;  /* Must not GC till we have set up the environment */
 129                         /* because C is hanging onto heap pointers */
 130                         /* maybe bogus for the new RTS? -- KH */
 131                         /* And for the GUM system? PWT */
 132     InitPackBuffer();
 133     InitMoreBuffers();
 134 }
 135 \end{code}
 136
 137 @SynchroniseSystem@ synchronises the reduction task with the system manager.
 138
 139 \begin{code}
 140 GLOBAL_TASK_ID *PEs;
 141
 142 void
 143 SynchroniseSystem(STG_NO_ARGS)
 144 {
 145     PACKET addr;
 146     int i;
 147
 148     _SetMyExceptionHandler(STG_Exception);
 149
 150     PEs = PEStartUp(nPEs);
 151
 152     /* Initialize global address tables */
 153     initGAtables();
 154
 155     /* Record the shortened the PE identifiers for LAGA etc. tables */
 156     for (i = 0; i < nPEs; ++i)
 157         registerTask(PEs[i]);
 158
 159 /*  pvm_notify( PvmTaskExit, PP_FAIL, 1, &SysManTask);  /? Setup an error handler */
 160
 161     /* Initialise the PE task array? */
 162 }
 163
 164 #endif /* PAR -- whole file */
 165 \end{code}