home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / mp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-09  |  10.2 KB  |  445 lines
  1. /* mp.c
  2.  *
  3.  * COPYRIGHT (c) 1990 by AT&T Bell Laboratories.
  4.  *
  5.  * Routines to deal with multiple processors.  These routines are
  6.  * essentially no-ops on all machines except for the SGI.  Routines
  7.  * will be added for Mach based systems in the future.
  8.  */
  9. #ifdef THINK_C
  10. #include <unix.h>
  11. #endif THINK_C
  12. #ifdef SGI
  13. #include <sys/types.h>
  14. #include <sys/prctl.h>
  15. #include <unistd.h>
  16. #endif SGI
  17. #include <signal.h>
  18. #include "ml_state.h"
  19. #include "ml_types.h"
  20. #include "sync.h"
  21. #include "request.h"
  22. #include "cause.h"
  23. #include "prim.h"
  24.  
  25. #define RETURN(r) {        \
  26.    MLState->ml_arg = (r);  \
  27.    return;}
  28.  
  29. extern void state_init();
  30. extern void callgc0();
  31.  
  32. #define refcell(z)    \
  33.     ML_val_t z[2] = {(ML_val_t)MAKE_DESC(1, TAG_array), INT_CtoML(0)}
  34.  
  35. refcell(active_procs0);
  36. #define active_procs (active_procs0[1])
  37.  
  38. static double state_vectors[((sizeof(MLState_t)*MAX_PROCS)+7)/8];
  39. #if (MAX_PROCS > 1)
  40. volatile int should_exit = FALSE;
  41. #else /* (MAX_PROCS == 1) */
  42. int should_exit = FALSE;
  43. #endif
  44. MLState_t *MLproc = (MLState_t *)state_vectors;
  45. MLState_ptr Exporters_State = (MLState_ptr)0;
  46.  
  47. spin_lock_t MLproc_lock;
  48. spin_lock_t siginfo_lock;
  49.  
  50. #if (MAX_PROCS > 1)
  51. /******************************************************/
  52. /* OS-dependent routines for processes                */
  53. /******************************************************/
  54. #ifdef SGI
  55. /****************/
  56. /* SGI Solution */
  57. /****************/
  58. void block(p)
  59.      pid_t p;
  60. {
  61.   int error,res;
  62.  
  63.   if ((res = blockproc(p)) == -1) {
  64.     error = oserror();
  65.     chatting("blockproc failed with error %d on proc %d\n",error,p);
  66.     die("%s\n",strerror(error));
  67.   }
  68. }
  69.  
  70. void unblock(p)
  71.      pid_t p;
  72. {
  73.   int error,res;
  74.  
  75.   if ((res = unblockproc(p)) == -1) {
  76.     error = oserror();
  77.     chatting("unblockproc failed with error %d on proc %d\n",error,p);
  78.     die("%s\n",strerror(error));
  79.   }
  80. }
  81.   
  82. void signalproc(p) 
  83.      pid_t p;
  84. {
  85.   kill(p,SIGUSR1);
  86. }
  87.  
  88. int new_proc(child_state)
  89.      MLState_t *child_state;
  90. {
  91.   int ret, error;
  92.   extern void proc_body();
  93.  
  94.   ret = sproc(proc_body,PR_SALL,child_state);
  95.   if (ret == -1) {
  96.     error = oserror();
  97.     chatting("[warning acquireProc: %s]\n",strerror(error));
  98.   } 
  99.   return ret;
  100. }
  101. #endif SGI
  102.  
  103. #else /* (MAX_PROCS == 1) */
  104. /**************************/
  105. /* Uni-processor solution */
  106. /**************************/
  107. int new_proc(child_state)
  108.      MLState_t *child_state;
  109. {
  110.   /* always fails */
  111.   return (-1);
  112. }
  113.  
  114. void block()
  115. {
  116.   die("block called on non-mp system\n");
  117. }
  118.  
  119. void unblock()
  120. {
  121.   die("unblock called on non-mp system\n");
  122. }
  123.  
  124. void signalproc()
  125. {
  126.   die("signalproc called on non-mp system\n");
  127. }
  128. #endif /* (MAX_PROCS > 1) */
  129.  
  130. void
  131. dump_proc_states()
  132. {
  133.   int i,j;
  134.   MLState_t *p;
  135.  
  136.   for (i=0; i < MAX_PROCS; i++) {
  137.     p = &(MLproc[i]);
  138.     chatting("ml_allocptr   = %x\n",p->ml_allocptr);
  139.     chatting("ml_limitptr   = %x\n",p->ml_limitptr);
  140.     chatting("ml_storeptr   = %x\n",p->ml_storeptr);
  141.     for (j=0; j < NROOTS; j++) 
  142.       chatting("ml_roots[%d] = %x\n",j,p->ml_roots[j]);
  143.     chatting("inML          = %x\n",p->inML);
  144.     chatting("request       = %x\n",p->request);
  145.     chatting("handlerPending= %x\n",p->handlerPending);
  146.     chatting("inSigHandler  = %x\n",p->inSigHandler);
  147.     chatting("maskSignals   = %x\n",p->maskSignals);
  148.     chatting("NumPendingSigs= %x\n",p->NumPendingSigs);
  149.     chatting("ioWaitFlag    = %x\n",p->ioWaitFlag);
  150.     chatting("GCpending     = %x\n",p->GCpending);
  151.     chatting("self          = %x\n",p->self);
  152.     chatting("state         = %x\n",p->state);
  153.     chatting("alloc_boundary= %x\n",p->alloc_boundary);
  154.     chatting("---------------------------------------\n");
  155.   }
  156. }
  157.  
  158. /* mp_shutdown : sets should_exit, wakes up any suspended procs, and
  159.  * signals running procs so they'll all exit.
  160.  */
  161. void
  162. mp_shutdown(MLState, exit_value)
  163.      MLState_ptr MLState;
  164.      int exit_value;
  165. {
  166.   int i;
  167.   MLState_ptr p;
  168.  
  169. #if (MAX_PROCS > 1)
  170.   if (!should_exit) {
  171.     should_exit = TRUE;
  172.     for (i=0; i < MAX_PROCS; i++) {
  173.       p = &(MLproc[i]);
  174.       if (p->state == MLPROC_SUSPENDED) {
  175.     unblock(p->self);
  176.       } else if ((p->state == MLPROC_RUNNING) && 
  177.          (p->self != MLState->self)) {
  178.     signalproc(p->self);
  179.       }
  180.     }
  181.   }
  182. #endif
  183.   exit(exit_value);
  184. }
  185.  
  186. /* check_suspended : checks to make sure every other proc is not running.
  187.  * raises an exception otherwise.
  188.  */
  189. void
  190. check_suspended(MLState)
  191.      MLState_ptr MLState;
  192. {
  193.   int i;
  194.   MLState_ptr p;
  195.  
  196.   for (i=0; i < MAX_PROCS; i++) {
  197.     p = &(MLproc[i]);
  198.     if ((p != MLState) && (p->state == MLPROC_RUNNING))  {
  199.       chatting("[warning: procs are running!!!]\n");
  200.       raise_syserror(MLState,0);
  201.     }
  202.   }
  203. }
  204.  
  205.  
  206. /* release_proc : unit -> 'a */
  207. void
  208. ml_release_proc (MLState)
  209.      MLState_ptr MLState;
  210. {
  211.   int i;
  212.   extern void turn_off_signals();
  213.  
  214. #ifdef MP_DEBUG
  215.   pchatting(MLState,"[entering release_proc]\n");
  216. #endif MP_DEBUG
  217.   while (!try_spin_lock(MLproc_lock)) {
  218.     if (MLState->GCpending)
  219.       MLState->mask=CONT_ARGS_MASK;
  220.       callgc0(MLState, CAUSE_GC, 0, CONT_ARGS_MASK);
  221.   }
  222. #ifdef MP_DEBUG
  223.   pchatting(MLState, "[have lock]\n");
  224. #endif MP_DEBUG
  225.   if (active_procs != INT_CtoML(1)) {
  226.     active_procs = INT_CtoML(INT_MLtoC(active_procs) - 1);
  227.     turn_off_signals(MLState);
  228.     MLState->state = MLPROC_SUSPENDED;
  229.     for (i=0; i < NROOTS; i++)
  230.       MLState->ml_roots[i] = ML_unit;
  231.     MLState->ml_varptr = ML_unit;
  232.     MLState->handlerPending = FALSE;
  233.     MLState->inSigHandler = FALSE;
  234.     MLState->maskSignals = FALSE;
  235.     MLState->NumPendingSigs = 0;
  236.     MLState->ioWaitFlag = 0;
  237.     MLState->GCpending = FALSE;
  238.     MLState->mask = 0;
  239.     MLState->amount = 0;
  240.     MLState->SigCode = 0;
  241.     MLState->SigCount = 0;
  242.     for (i=0; i < NUM_ML_SIGS; i++)
  243.       MLState->SigTbl[i] = 0;
  244.     MLState->fault_exn = ML_unit;
  245. #ifdef MP_DEBUG  
  246.     pchatting(MLState,"[releasing lock and suspending self]\n");
  247. #endif MP_DEBUG
  248.     spin_unlock(MLproc_lock);
  249.     block(MLState->self);
  250.  
  251.     if (should_exit)
  252.       mp_shutdown(MLState, 0);
  253.  
  254. /* must install any C handlers necessary to deal with signals again -- in case
  255.  * they've changed since we've been asleep. 
  256.  */
  257.     setup_signals (MLState, FALSE); 
  258.  
  259. #ifdef MP_DEBUG
  260.     pchatting(MLState,"[resumed]\n");
  261. #endif MP_DEBUG
  262.   } else {
  263.     spin_unlock(MLproc_lock);
  264.     RETURN(ML_unit);
  265.   }
  266. }
  267.  
  268.  
  269. void
  270. init_proc_state (p)
  271.      MLState_ptr p;
  272. {
  273.   int i;
  274.   
  275.   p->ml_allocptr = 0;
  276.   p->ml_limitptr = 0;
  277.   p->ml_storeptr = 0;
  278.   for (i=0; i < NROOTS; i++)
  279.     p->ml_roots[i] = ML_unit;
  280.   p->ml_varptr = ML_unit;
  281.   p->inML = FALSE;
  282.   p->request = REQ_RUN;
  283.   p->handlerPending = FALSE;
  284.   p->inSigHandler = FALSE;
  285.   p->maskSignals = FALSE;
  286.   p->NumPendingSigs = 0;
  287.   p->ioWaitFlag = 0;
  288.   p->GCpending = FALSE;
  289.   p->self = 0;
  290.   p->state = MLPROC_NO_PROC;
  291.   p->alloc_boundary = 0;
  292.   p->max_allocptr = 0;
  293.   p->mask = 0;
  294.   p->amount = 0;
  295.   p->SigCode = 0;
  296.   p->SigCount = 0;
  297.   for (i=0; i < NUM_ML_SIGS; i++)
  298.     p->SigTbl[i] = 0;
  299.   p->fault_exn = ML_unit;
  300. }
  301.  
  302. MLState_ptr mp_init (restarted)
  303.      int restarted;
  304. {
  305.   int i;
  306.   MLState_ptr MLState,p;
  307.  
  308.   should_exit = FALSE;
  309.   active_procs = INT_CtoML(1);
  310.   sync_init(restarted);
  311.   MLproc_lock = runtime_spin_lock();
  312.   siginfo_lock = runtime_spin_lock();
  313.   if (!restarted) {
  314.     MLState = (MLState_t *)(&(MLproc[0]));
  315.     init_proc_state(MLState);
  316.     MLState->ml_storeptr = (int)STORLST_nil;
  317.   } else {
  318.     MLState = Exporters_State;
  319.   }
  320.  
  321.   /* Initialize other proc's states */
  322.   for (i=0; i < MAX_PROCS; i++) {
  323.     p = (&(MLproc[i]));
  324.     if (p != MLState) {
  325.       init_proc_state(p);
  326.       p->ml_storeptr = (int)STORLST_nil;
  327.     }
  328.   }
  329.   MLState->state = MLPROC_RUNNING;
  330.   MLState->self = getpid();
  331.   MLState->request = REQ_RETURN;
  332.   return MLState;
  333. }
  334.  
  335.  
  336. /* Find pointer to own state vector:  Note this is very
  337.    expensive (involves a system call -- getpid) so it should
  338.    be avoided at all costs.  In the future we might replace
  339.    this with a [tricky] machine-dependent way of finding the
  340.    per-proc state (like using the stack of the proc.)
  341. */
  342. MLState_ptr find_self ()
  343. {
  344. #if (MAX_PROCS > 1)
  345.   int i;
  346.   int id = getpid();
  347.  
  348.   for (i=0; MLproc[i].self != id; i++);
  349.   return (&(MLproc[i]));
  350. #else
  351.   return (&(MLproc[0]));
  352. #endif /* (MAX_PROCS > 1) */
  353. }
  354.  
  355. /* acquire_proc : ('a * (unit -> unit)) -> bool */
  356. void
  357. ml_acquire_proc(MLState,arg)
  358.      MLState_ptr MLState;
  359.      ML_val_t arg;
  360. {
  361. #if (MAX_PROCS > 1)
  362.   volatile ML_val_t var_value = REC_SEL(arg,0);
  363.   volatile ML_val_t fn = REC_SEL(arg,1);
  364. #else /* (MAX_PROCS == 1) */
  365.   ML_val_t var_value = REC_SEL(arg,0);
  366.   ML_val_t fn = REC_SEL(arg,1);
  367. #endif 
  368.   int i;
  369.   MLState_ptr p;
  370.  
  371. #ifdef MP_DEBUG
  372.   pchatting(MLState,"[entering acquire_proc]\n");
  373. #endif MP_DEBUG
  374.   if (active_procs == INT_CtoML(MAX_PROCS)) {
  375. #ifdef MP_DEBUG
  376.     pchatting(MLState,"[active_procs maxed]\n");
  377. #endif MP_DEBUG
  378.     RETURN(ML_false);
  379.   }
  380.   while (!try_spin_lock(MLproc_lock)) {
  381.     if (MLState->GCpending) {
  382.       MLState->mask = CONT_ARGS_MASK;
  383.       callgc0(MLState, CAUSE_GC, 0, CONT_ARGS_MASK);
  384.       var_value = REC_SEL((REC_SEL(MLState->ml_arg,1)),0);
  385.       fn = REC_SEL((REC_SEL(MLState->ml_arg, 1)),1);
  386.     }
  387.   }
  388. #ifdef MP_DEBUG
  389.   pchatting(MLState,"[got lock]\n");
  390. #endif MP_DEBUG
  391.   i = 0;
  392.   while ((i < MAX_PROCS) && (MLproc[i].state != MLPROC_SUSPENDED)) i++;
  393.   if (i == MAX_PROCS) {
  394.     i = 0;
  395.     while ((i < MAX_PROCS) && (MLproc[i].state != MLPROC_NO_PROC)) i++;
  396.     if (i == MAX_PROCS) {
  397.       spin_unlock(MLproc_lock);
  398. #ifdef MP_DEBUG
  399.       pchatting(MLState,"[lock released, no procs]\n");
  400. #endif MP_DEBUG
  401.       RETURN(ML_false);
  402.     }
  403.   }
  404.   active_procs = INT_incr(active_procs,1);
  405.   p = &(MLproc[i]);
  406.   p->ml_exncont = PTR_CtoML(handle_v+1);
  407.   p->ml_arg = ML_unit;
  408.   p->ml_cont = PTR_CtoML(return_c);
  409.   p->ml_closure = fn;
  410.   p->ml_pc = CODE_ADDR(fn);
  411.   p->request = REQ_RUN;
  412.   p->ml_varptr = var_value;
  413.   if (p->state == MLPROC_NO_PROC) {
  414.     p->state = MLPROC_RUNNING;
  415.     if (((p->self) = new_proc(p)) != -1) {
  416.       /* implicit handoff of MLproc_lock to child
  417.      so that handlers for GC signals may be 
  418.      installed before someone butts in. */
  419. #ifdef MP_DEBUG
  420.       pchatting(MLState,"[new proc %d]\n",p->self);
  421. #endif MP_DEBUG
  422.       RETURN(ML_true);
  423.     } else {
  424.       p->self = 0;
  425.       p->state = MLPROC_NO_PROC;
  426.       active_procs = INT_CtoML(INT_MLtoC(active_procs) - 1);
  427.       spin_unlock(MLproc_lock);
  428.       RETURN(ML_false);
  429.     }
  430.   } else {
  431.     p->state = MLPROC_RUNNING;
  432.     unblock(p->self);
  433.     spin_unlock(MLproc_lock);
  434.     RETURN(ML_true);
  435.   }
  436. }
  437.  
  438. void
  439. ml_max_procs(MLState,arg)
  440.      MLState_ptr MLState;
  441.      ML_val_t    arg;
  442. {
  443.   RETURN(INT_CtoML(MAX_PROCS));
  444. }
  445.