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