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 OutputDisabled = rtsFalse;              /* Disable output for performance purposes      */
  53 rtsBool SparkLocally =   rtsFalse;              /* Use local threads if possible                */
  54 rtsBool DelaySparks =    rtsFalse;              /* Use delayed sparking                         */
  55 rtsBool LocalSparkStrategy =   rtsFalse;        /* Either delayed threads or local threads      */
  56 rtsBool GlobalSparkStrategy =   rtsFalse;       /* Export all threads                           */
  57
  58 rtsBool ParallelStats =  rtsFalse;              /* Gather parallel statistics                   */
  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 && !OutputDisabled)
  75         fprintf(stderr, "Starting main program...\n");
  76
  77
  78     /* Record the start time for statistics purposes. */
  79     main_start_time = usertime();
  80     /* fprintf(stderr, "Start time is %u\n", main_start_time); */
  81
  82     /*
  83      * Start the main scheduler which will fish for threads on all but the PE with
  84      * the main thread
  85      */
  86
  87     ScheduleThreads(program_closure);
  88     myexit(1);
  89 }
  90 \end{code}
  91
  92 @myexit@ defines how to terminate the program.  If the exit code is
  93 non-zero (i.e. an error has occurred), the PE should not halt until
  94 outstanding error messages have been processed.  Otherwise, messages
  95 might be sent to non-existent Task Ids.  The infinite loop will actually
  96 terminate, since @STG_Exception@ will call @myexit@\tr{(0)} when
  97 it received a @PP_FINISH@ from the system manager task.
  98
  99 \begin{code}
 100 void
 101 myexit(n)                       /* NB: "EXIT" is set to "myexit" for parallel world */
 102 I_ n;
 103 {
 104     GlobalStopPending = rtsTrue;
 105     SendOp(PP_FINISH, SysManTask);
 106     if (n != 0)
 107       WaitForTermination();
 108     else
 109       WaitForPEOp(PP_FINISH, SysManTask);
 110     PEShutDown();
 111     fprintf(stderr,"Processor %lx shutting down, %ld Threads run\n", mytid, threadId);
 112
 113     /* And actually terminate -- always with code 0 */
 114     longjmp(exit_parallel_system, 1);
 115 }
 116 \end{code}
 117
 118 \begin{code}
 119 void srand48 PROTO((long));
 120 time_t time PROTO((time_t *));
 121
 122 void
 123 initParallelSystem(STG_NO_ARGS)
 124 {
 125
 126   /* Don't buffer standard channels... */
 127   setbuf(stdout,NULL);
 128   setbuf(stderr,NULL);
 129
 130   srand48(time(NULL) * getpid());       /*Initialise Random-number generator seed*/
 131
 132   OkToGC = rtsFalse;            /* Must not GC till we have set up the environment */
 133                                 /* because C is hanging onto heap pointers */
 134                                 /* maybe bogus for the new RTS? -- KH */
 135                                 /* And for the GUM system? PWT */
 136 }
 137 \end{code}
 138
 139 @SynchroniseSystem@ synchronises the reduction task with the system manager,
 140 and gathers information about which PEs are actually in use.
 141
 142 \begin{code}
 143 GLOBAL_TASK_ID *PEs;
 144
 145 void
 146 SynchroniseSystem(STG_NO_ARGS)
 147 {
 148     PACKET addr;
 149     int i;
 150
 151     _SetMyExceptionHandler(STG_Exception);
 152
 153     PEs = PEStartUp(nPEs);
 154
 155     /* Initialize global address tables */
 156     initGAtables();
 157
 158     /* Record the shortened the PE identifiers for LAGA etc. tables */
 159     for (i = 0; i < nPEs; ++i)
 160         registerTask(PEs[i]);
 161
 162     addr = WaitForPEOp(PP_INIT, ANY_GLOBAL_TASK);
 163     SysManTask = Sender_Task(addr);
 164
 165 /*  pvm_notify( PvmTaskExit, PP_FAIL, 1, &SysManTask);  /* Setup an error handler */
 166
 167     /* Initialise the PE task array? */
 168 }
 169
 170 #endif /* PAR -- whole file */
 171 \end{code}