process.c

fortran并行计算包

/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*  
 *  (C) 2003 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

#include "pmutilconf.h"
#ifdef NEEDS_POSIX_FOR_SIGACTION
#define _POSIX_SOURCE
#endif

#include <stdio.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif

#include "pmutil.h"
#include "ioloop.h"
#include "process.h"
#include "env.h"
/* Use the memory defintions from mpich2/src/include */
#include "mpimem.h"
#ifdef HAVE_ERRNO_H
#include <errno.h>
#endif

#include <sys/wait.h>
#if defined(USE_SIGNAL) || defined(USE_SIGACTION)
#include <signal.h>
#else
#error no signal choice
#endif
#ifdef NEEDS_STRSIGNAL_DECL
extern char *strsignal(int);
#endif

/* There is only one universe */
ProcessUniverse pUniv;

/* This is the home of the common debug flag */
int MPIE_Debug = 0;

/* A unique ID for each forked process, up to 2 billion.  This is 
   global to this file so that MPIE_SetupSingleton and MPIE_ForkProcess
   can both access it */
static       int UniqId = 0; 

/* Local, forward references */
static void MPIE_InstallSigHandler( int sig, void (*handler)(int) );

/*
  Fork numprocs processes, with the current PMI groupid and kvsname 
  This is called for the initial processes and as the result of 
  an PMI "spawn" command 
  
  world indicates which comm world this is, starting from zero
 */
/*@
  MPIE_ForkProcesses - Create new processes for a comm_world

  Input Parameters:
+ pWorld - Pointer to a 'ProcessWorld' structure, containing one or more
           'ProcessApp' structures.  Each 'ProcessApp' specifies how many
	   processes to create.
. envp   - Environment to provide to each process
. preamble - Routine executed before the fork for each created process
. preambldData - Data passed to the preamble function
- other - other

  Output Effects:
  The 'ProcessState' fields are allocated and filled in with the process id
  and other information.

  Callbacks:
+ preamble - called before fork
. postfork - called after fork, but before exec, in the forked child
- postamble - called after fork in the parent (the process that executed
     the fork).  

  A typical use of the 'preamble' function is to open a file descriptor
  that is then inherited by the forked process.  The 'postfork' and
  'postamble' can close any unneeded file descriptors

  Returns:
  The number of created processes.

  @*/
int MPIE_ForkProcesses( ProcessWorld *pWorld, char *envp[],
			int (*preamble)(void*,ProcessState*), 
			void *preambleData,
			int (*postfork)(void*,void*,ProcessState*), 
			void *postforkData,
			int (*postamble)(void*,void*,ProcessState*), 
			void *postambleData
			)
{
    pid_t         pid;
    ProcessApp   *app;
    ProcessState *pState=0;
    int          wRank = 0;    /* Rank in this comm world of the process */
    int          i, rc;
    int          nProcess = 0;

    app = pWorld->apps;
    while (app) {
	/* Allocate process state if necessary */
	if (!app->pState) {
	    pState = (ProcessState *)MPIU_Malloc( 
		app->nProcess * sizeof(ProcessState) );
	    if (!pState) {
		return -1;
	    }
	    app->pState = pState;
	}
	pState = app->pState;

	for (i=0; i<app->nProcess; i++) {
	    pState[i].app                   = app;
	    pState[i].wRank                 = wRank++;
	    pState[i].id                    = UniqId++;
	    pState[i].initWithEnv           = 1;  /* Default is to use env
						    to initialize connection */
	    pState[i].status                = PROCESS_UNINITIALIZED;
	    pState[i].exitStatus.exitReason = EXIT_NOTYET;
	    pState[i].pid                   = -1;

	    /* Execute any preamble */
	    if (preamble) {
		rc = (*preamble)( preambleData, &pState[i] );
	    }

	    pid = fork();
	    if (pid < 0) {
		/* Error creating process */
		return -1;
	    }
	    if (pid == 0) {
		/* Child */
		/* exec the process (this call only returns if there is an 
		   error */
		if (postfork) {
		    rc = (*postfork)( preambleData, postforkData, &pState[i] );
		}
		rc = MPIE_ExecProgram( &pState[i], envp );
		if (rc) {
		    MPIU_Internal_error_printf( "mpiexec fork failed\n" );
		    /* FIXME: kill children */
		    exit(1);
		}
	    }
	    else {
		/* Parent */
		nProcess++;
		/* Add this to the live processes in the Universe */
		pUniv.nLive++;

		pState[i].pid    = pid;
		pState[i].status = PROCESS_ALIVE;

		if (postamble) {
		    rc = (*postamble)( preambleData, postambleData, 
				       &pState[i] );
		    if (rc) {
			MPIU_Internal_error_printf( 
				      "mpiexec postamble failed\n" );
			/* FIXME: kill children */
			exit(1);
		    }
		}
	    }
	}
	
	app = app->nextApp;
    }
    return nProcess;
}

/*@
  MPIE_ProcessGetExitStatus - Return an integer exit status based on the
  return status of all processes in the process universe; returns the
  maximum value seen.

  Output Parameter:
. signaled - 0 if the process was `not` signaled, otherwise the signal 
  that terminated the process.

  Return Value:
  Maximum of the return status of all processes.
  
  @*/
int MPIE_ProcessGetExitStatus( int *signaled )
{
    ProcessWorld *world;
    ProcessApp   *app;
    ProcessState *pState;
    int          i, rc = 0, sig = 0;

    DBG_PRINTF(("Getting exit status\n"));
    world = pUniv.worlds;
    while (world) {
	app = world->apps;
	while (app) {
	    pState = app->pState;
	    for (i=0; i<app->nProcess; i++) {
		if (pState[i].exitStatus.exitStatus > rc) {
		    rc = pState[i].exitStatus.exitStatus;
		}
		if (pState[i].exitStatus.exitReason == EXIT_SIGNALLED) {
		    sig = 1;
		}
	    }
	    app = app->nextApp;
	}
	world = world->nextWorld;
    }

    DBG_PRINTF(("Done getting exit status\n" ));
    *signaled = sig;
    return rc;
}
/*
 * exec the indicated program with the indicated environment
 */
#ifndef MAXPATHLEN
#define MAXPATHLEN 1024
#endif
#define MAX_CLIENT_ARG 50
#define MAX_CLIENT_ENV 200
/* MAXNAMELEN is used for sizing the char arrays used for 
 * defining environment variables */
#define MAXNAMELEN 1024


int MPIE_ExecProgram( ProcessState *pState, char *envp[] )
{
    int j, rc, nj;
    ProcessApp *app;

    /* Provide local variables in which to hold new environment variables. */
    char env_pmi_rank[MAXNAMELEN];
    char env_pmi_id[MAXNAMELEN];
    char env_pmi_size[MAXNAMELEN];
    char env_pmi_debug[MAXNAMELEN];
    char env_appnum[MAXNAMELEN];
    char env_universesize[MAXNAMELEN];
    char pathstring[MAXPATHLEN+10];
    char *(client_env[MAX_CLIENT_ENV]);
    char *(client_arg[MAX_CLIENT_ARG]);

    app = pState->app;

    /* build environment for client. */
    j = MPIE_EnvSetup( pState, envp, client_env, MAX_CLIENT_ENV-7 );
    if (j < 0) {
	MPIU_Error_printf( "Failure setting up environment\n" );
    }
    nj = j;  /* nj is the first entry of client_env that will be set by
		this routine */
    DBG_PRINTF( ( "Setup env (j=%d)\n", j ) );

    if (j == MAX_CLIENT_ENV-7) {
	MPIU_Error_printf( "Environment is too large (max is %d)\n",
			   MAX_CLIENT_ENV-7);
	exit(-1);
    }

    DBG_PRINTF( ( "Creating pmi env\n" ) );
    if (pState->initWithEnv) {
	MPIU_Snprintf( env_pmi_rank, MAXNAMELEN, "PMI_RANK=%d", 
		       pState->wRank );
	client_env[j++] = env_pmi_rank;
	MPIU_Snprintf( env_pmi_size, MAXNAMELEN, "PMI_SIZE=%d", 
		       app->pWorld->nProcess );
	client_env[j++] = env_pmi_size;
	MPIU_Snprintf( env_pmi_debug, MAXNAMELEN, "PMI_DEBUG=%d", MPIE_Debug );
	client_env[j++] = env_pmi_debug; 
    }
    else {
	/* We must also communicate the ID to the process.  
	   This id is saved in the pState so that we can match it 
	   when it comes back to us (it is the same as the rank 
	   in the simple case) */
	MPIU_Snprintf( env_pmi_id, sizeof(env_pmi_id), "PMI_ID=%d",
		       pState->id );
	client_env[j++] = env_pmi_id;
    }

    MPIU_Snprintf( env_appnum, MAXNAMELEN, "MPI_APPNUM=%d", app->myAppNum );
    client_env[j++] = env_appnum;
    MPIU_Snprintf( env_universesize, MAXNAMELEN, "MPI_UNIVERSE_SIZE=%d", 
		   pUniv.size );
    client_env[j++] = env_universesize;
    client_env[j]   = 0;

    for ( j = nj; client_env[j]; j++ )
	if (putenv( client_env[j] )) {
	    MPIU_Internal_sys_error_printf( "mpiexec", errno, 
			     "Could not set environment %s", client_env[j] );
	    exit( 1 );
	}
    
    DBG_PRINTF( ( "Setup env, starting with wdir\n" ) );
    /* change working directory if specified, replace argv[0], 
       and exec client */
    if (app->wdir) {
	rc = chdir( app->wdir );
	if (rc < 0) {
	    MPIU_Error_printf( "Unable to set working directory to %s\n",
			       app->wdir);
	    rc = chdir( getenv( "HOME" ) );
	    if (rc < 0) {
		MPIU_Error_printf( "Unable to set working directory to %s\n",
				   getenv( "HOME" ) );
		exit( 1 );
	    }
	}
    }

    DBG_PRINTF( ( "Setup command-line args\n" ) );
    /* Set up the command-line arguments */
    client_arg[0] = (char *)app->exename;
    for (j=0; j<app->nArgs; j++) {
	client_arg[1+j] = (char *)app->args[j];
    }
    /* The argv array is null-terminated */
    client_arg[1+j] = 0;

    /* pathname argument should be used here */
    if (app->path) {
	/* Set up the search path */
	MPIU_Snprintf( pathstring, sizeof(pathstring)-1, "PATH=%s", 
		       app->path );
	/* Some systems require that the path include the path to
	   certain files or libraries, for example cygwin1.dll for
	   Cygwin */
#ifdef NEEDS_BIN_IN_PATH
	MPIU_Strnapp( pathstring, ":/bin", sizeof(pathstring)-1 );
#endif
	putenv( pathstring );

    }
    DBG_PRINTF( ( "Exec the application %s\n", app->exename ) );
    rc = execvp( app->exename, client_arg );

    if ( rc < 0 ) {
	MPIU_Internal_sys_error_printf( "mpiexec", errno, 
					"mpiexec could not exec %s\n", 
					app->exename );
	exit( 1 );
    }
    return 0;
}

/*@
  MPIE_FindProcessByPid - Given a pid, return a pointer to the process state

  Notes:
  This searches through all processes in the process universe.  Returns
  null if no corresponding process is found.

  @*/
ProcessState *MPIE_FindProcessByPid( pid_t pid )
{
    ProcessWorld *world;
    ProcessApp   *app;
    ProcessState *pState;
    int           i;
    int           np = 100000; /* FIXME: Should initialize with the
				  number of created processes */

    world = pUniv.worlds;
    while (world) {
	app = world->apps;
	while (app) {
	    pState = app->pState;
	    np -= app->nProcess;
	    if (np < 0) {
		/* This is a panic exit, used becaue we may call this
		   from within the signal handler */
		return 0;
	    }

	    /* It is possible for pState to be uninitialized if not all apps
	       have been started yet via MPIE_ForkProcesses and we are called
	       from handle_sigchild. */
	    if (pState) {
		for (i=0; i<app->nProcess; i++) {
		    if (pState[i].pid == pid) return &pState[i];
		}
	    }
	    app = app->nextApp;
	}
	world = world->nextWorld;
    }
    return 0;
}

/*
 * Given a pointer to a process state structure, and the process status
 * returned by a 'wait' call, set the fields in the process state to
 * indicate the reason for the process exit
 */
static int nExited = 0;
void MPIE_ProcessSetExitStatus( ProcessState *pState, int prog_stat )
{
    int rc = 0, sigval = 0;
    if (WIFEXITED(prog_stat)) {
	rc = WEXITSTATUS(prog_stat);
	    }
    if (WIFSIGNALED(prog_stat)) {
	sigval = WTERMSIG(prog_stat);
    }
    pState->exitStatus.exitStatus = rc;
    pState->exitStatus.exitSig    = sigval;
    pState->exitStatus.exitOrder  = nExited++;
    if (sigval) 
	pState->exitStatus.exitReason = EXIT_SIGNALLED;
    else {
	if (pState->status >= PROCESS_ALIVE &&
	    pState->status <= PROCESS_COMMUNICATING) 
	    pState->exitStatus.exitReason = EXIT_NOFINALIZE;
	else 
	    pState->exitStatus.exitReason = EXIT_NORMAL;
    }
}

/* ------------------------------------------------------------------------- */
/* SIGNALS and CHILDREN                                                      */
/* ------------------------------------------------------------------------- */

/*
 * POSIX requires a SIGCHLD handler (SIG_IGN is invalid for SIGCHLD in
 * POSIX).  Thus, we have to perform the waits within the signal handler.
 * Because there may be a race condition with recording the pids in the 
 * ProcessState structure, we provide an "unexpected child" structure to
 * hold information about processes that are not yet registered.  A clean
 * up handler records the state of those processes when we're ready to 
 * exit.
 *
 * Because signals are not queued, this handler processes all completed
 * processes.  
 *
 * We must perform the wait in the handler because if we do not, we loose 
 * the exit status information (it is no longer available after the
 * signal handler exits).
 */
/* inHandler and skipHandler are used to control the SIGCHLD handler and
   to avoid (or at least narrow) race conditions */
static volatile int inHandler = 0;
/* skip handler is set if we are planning to wait for processes with the
   "wait" system call in a separate routine.  */
static volatile int skipHandler = 0;

/* The "unexpected" structure is used to record any processes that
   exit before we've recorded their pids.  This is unlikely, but may
   happen if a process fails to exec (e.g., the fork succeeds but the 
   exec immediately fails).  This ensures that we can handle SIGCHLD
   events without loosing information about the child processes */
#define MAXUNEXPECTEDPIDS 1024
static struct {
    pid_t  pid;
    int    stat;
} unexpectedExit[MAXUNEXPECTEDPIDS];
static int nUnexpected = 0;
	 
static void handle_sigchild( int sig )
{
    int prog_stat, pid;
    int foundChild = 0;
    ProcessState *pState;

    /* Set a flag to indicate that we're in the handler, and check 
       to see if we should ignore the signal */
    if (inHandler) return;
    inHandler = 1;

    if (skipHandler) {
	/* Someone else wants to wait on the processes, so we
	   return now. */
	inHandler = 0;
#ifndef SA_RESETHAND
	/* If we can't clear the "reset handler bit", we must 
	   re-install the handler here */
	MPIE_InstallSigHandler( SIGCHLD, handle_sigchild );
#endif
	return;
    }

    DBG_PRINTF( ("Entering sigchild handler\n") );
    DBG_EPRINTF((stderr, "Waiting for any child on signal\n") );

    /* Since signals may be coallesced, we process all children that
       have exited */
    while (1) {
	/* Find out about any children that have exited.  Note that
	   we don't check for EINTR because we're within a 
	   signal handler. */
	pid = waitpid( (pid_t)(-1), &prog_stat, WNOHANG );
    
	if (pid <= 0) {
	    /* Note that it may not be an error if no child