/*
 *
 * Copyright 1998-1999, University of Notre Dame.
 * Authors: Jeffrey M. Squyres, Kinis L. Meyer with M. D. McNally 
 *          and Andrew Lumsdaine
 *
 * This file is part of the Notre Dame LAM implementation of MPI.
 *
 * You should have received a copy of the License Agreement for the
 * Notre Dame LAM implementation of MPI along with the software; see
 * the file LICENSE.  If not, contact Office of Research, University
 * of Notre Dame, Notre Dame, IN 46556.
 *
 * Permission to modify the code and to distribute modified code is
 * granted, provided the text of this NOTICE is retained, a notice that
 * the code was modified is included with the above COPYRIGHT NOTICE and
 * with the COPYRIGHT NOTICE in the LICENSE file, and that the LICENSE
 * file is distributed with the modified code.
 *
 * LICENSOR MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED.
 * By way of example, but not limitation, Licensor MAKES NO
 * REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS FOR ANY
 * PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE COMPONENTS
 * OR DOCUMENTATION WILL NOT INFRINGE ANY PATENTS, COPYRIGHTS, TRADEMARKS
 * OR OTHER RIGHTS.  
 *
 * Additional copyrights may follow.
 *
 *	Ohio Trollius
 *	Copyright 1997 The Ohio State University
 *	NJN
 *
 *	$Id: laminit.c,v 6.17 1999/09/12 05:07:24 jsquyres Exp $
 *
 *	Function:	- LAM specific initialization for MPI
 */

#include <stdlib.h>
#include <string.h>
#include <unistd.h>

#include <app_mgmt.h>
#include <blktype.h>
#include <laminternal.h>
#include <mpi.h>
#include <mpisys.h>
#include <mpitrace.h>
#include <net.h>
#include <preq.h>
#include <rpisys.h>
#include <terror.h>
#include <typical.h>
#include <t_types.h>
#if LAM_WANT_IMPI
#include <impi.h>
#endif
#include <debug.h>

/*
 * public variables
 */
struct _comm		lam_mpi_comm_world;
struct _comm		lam_mpi_comm_self;

struct _group		lam_mpi_group_empty;
struct _op		lam_mpi_max, lam_mpi_min;
struct _op		lam_mpi_sum, lam_mpi_prod;
struct _op		lam_mpi_land, lam_mpi_band;
struct _op		lam_mpi_lor, lam_mpi_bor;
struct _op		lam_mpi_lxor, lam_mpi_bxor;
struct _op		lam_mpi_maxloc, lam_mpi_minloc;
struct _op		lam_mpi_replace;

struct _dtype		lam_mpi_char, lam_mpi_byte;
struct _dtype		lam_mpi_int, lam_mpi_logic;
struct _dtype		lam_mpi_short, lam_mpi_long;
struct _dtype		lam_mpi_float, lam_mpi_double;
struct _dtype		lam_mpi_long_double;
struct _dtype		lam_mpi_cplex, lam_mpi_packed;
struct _dtype		lam_mpi_unsigned_char;
struct _dtype		lam_mpi_unsigned_short;
struct _dtype		lam_mpi_unsigned;
struct _dtype		lam_mpi_unsigned_long;
struct _dtype		lam_mpi_ub, lam_mpi_lb;
struct _dtype		lam_mpi_float_int, lam_mpi_double_int;
struct _dtype		lam_mpi_long_int, lam_mpi_2int;
struct _dtype		lam_mpi_short_int, lam_mpi_dblcplex;
struct _dtype		lam_mpi_integer, lam_mpi_real;
struct _dtype		lam_mpi_dblprec, lam_mpi_character;
struct _dtype		lam_mpi_2real, lam_mpi_2dblprec;
struct _dtype		lam_mpi_2integer, lam_mpi_longdbl_int;
struct _dtype		lam_mpi_wchar, lam_mpi_long_long_int;
struct _dtype		lam_mpi_unsigned_long_long;

struct _errhdl		lam_mpi_errors_are_fatal;
struct _errhdl		lam_mpi_errors_return;

MPI_Comm		lam_comm_parent = MPI_COMM_NULL;
struct _proc		*lam_myproc;
LIST			*lam_comms = 0;
LIST			*lam_ports = 0;
float8			lam_clockskew = 0.0;
int			lam_f77init = 0;
int			lam_c2c = 0;
int			lam_ger = 0;
int			lam_homog = 0;
struct jobid_t		lam_jobid = { 0, 0 };
int			lam_universe_size = -1;
int			lam_appnum = -1;
int		        lam_maxtag = LAM_MAXTAG;

MPI_Fint		*MPI_F_STATUS_IGNORE;
MPI_Fint		*MPI_F_STATUSES_IGNORE;


#if LAM_WANT_IMPI
struct _gps             gimpid;
#endif

/*
 * external functions
 */
extern int		lam_rtrstore(int4 nodeid, int4 lnum, int4 pid, 
				     CONST char *buffer, int4 length);
extern int		lpattach(CONST char *name);
extern void		_lam_atexit();

/*
 * private variables
 */
static int fl_debug = 0;


/*
 * public functions
 */
int                     lam_get_proc_array(struct _gps **procs, int *world_n, 
					   int *cid, int *procs_n,
					   int is_impi);
/*
 * private functions
 */
static int		get_singleton_idx();


/*
 *	lam_linit
 *
 *	Function:	- initialize the process
 *	Accepts:	- program name
 *			- # processes in local world (returned)
 *			- # processes in parent world (returned)
 *			- CID to use for parent intercomm (returned)
 *			- parent and new worlds process GPS array (returned)
 *			- root in parent comm if any (returned)
 *	Returns:	- 0 or LAMERROR
 */
int
lam_linit(name, world_n, parent_n, cid, worlds, root)

char			*name;
int			*world_n;
int			*parent_n;
int			*cid;
struct _gps		**worlds;
int			*root;

{
    	struct pstate	pstate;			/* for getting kenya index */
	char		*trworld;		/* world trace */
	int		trwlen;			/* length of world trace */
	char            *env;
	struct _gps	*procs;			/* process GPS array */
	struct _gps	*p;			/* favourite pointer */
	struct nmsg	nhead;			/* network message header */
	struct _proc	*proc;			/* process entry */
	int		i;
	int	        procs_n;		/* # processes in total */
/*
 * Attach process to the kernel and turn it into an MPI process.
 */
	DBUG("In laminit\n");

	if (kenter(name, 0)) return(LAMERROR);
	if (_kio.ki_rtf & RTF_FORKED) {
		_kio.ki_rtf &= ~RTF_TRON;
	}
	_kio.ki_rtf |= RTF_MPI;
/*
 * If process was not launched with mpirun, it will not be set to 
 * catch signals.  Catching signal is 1) a good thing, and 2) the mpirun
 * default, so we should set it here by default.
 */
	if ((_kio.ki_rtf & RTF_MPIRUN) == 0)
	  _kio.ki_rtf |= RTF_MPISIGS;
	if (lpattach(name)) return(LAMERROR);
	lam_flinit = 1;

	if (getenv("LAM_MPI_PAUSE")) {
	    kpause();
	}

	DBUG("Before lam_get_proc_array\n");
	procs_n = 0; 
	if (lam_get_proc_array(&procs, world_n, cid, &procs_n, 0)
	    == LAMERROR) {
	  free((char *) procs);
	  return(LAMERROR);
	}

/*
 * Set various runtime flags.
 */
	lam_c2c = _kio.ki_rtf & RTF_MPIC2C;
	lam_ger = _kio.ki_rtf & RTF_MPIGER;
	lam_homog = _kio.ki_rtf & RTF_HOMOG;
/* 
 * If started by mpirun, send back my real PID and IDX to give
 * mpirun the ability to run shell scripts and debuggers.
 */
	LAM_ZERO_ME(nhead);
	if (_kio.ki_rtf & RTF_MPIRUN) {
	    if ((env = getenv("LAMRANK")) == 0) {
		free((char *) procs);
		return(LAMERROR);
	    }
/*
 * Get our process (kenya) index.
 */
	    if (rpstate(LOCAL, SELECT_PID, getpid(), &pstate, 1) < 1) {
		free((char *) procs);
		return(LAMERROR);
	    }
/*
 * The event is -(mpirun's pid). This will distinguish it from user
 * events. The type is 2 to distinguish it from "wait" messages which
 * the same event and type 1.
 */
	    nhead.nh_node = _kio.ki_jobid.jid_node;
	    nhead.nh_event = (-_kio.ki_jobid.jid_pid) & 0xBFFFFFFF;
	    nhead.nh_type = 2;
	    nhead.nh_flags = DINT4DATA;
	    nhead.nh_length = 0;
	    nhead.nh_data[0] = stoi((unsigned char*) env);
	    nhead.nh_data[1] = getpid();
	    nhead.nh_data[2] = pstate.ps_index;

	    if (nsend(&nhead)) {
		free((char *) procs);
		return(LAMERROR);
	    }
	}
/*
 * If spawned or started by mpirun, receive the list of GPS.  Local
 * world GPS's are first followed by the parents (if any).  Otherwise if
 * the number of processes is one assume a singleton init, else assume one
 * process per node and pids are not needed.
 */
	if ((_kio.ki_parent > 0) || (_kio.ki_rtf & RTF_MPIRUN)) {

		nhead.nh_event = (-getpid()) & 0xBFFFFFFF;
		nhead.nh_type = BLKMPIINIT;
		nhead.nh_flags = DINT4DATA;
		nhead.nh_length = procs_n * sizeof(struct _gps);
		nhead.nh_msg = (char *) procs;

		if (nrecv(&nhead)) {
			free((char *) procs);
			return(LAMERROR);
		}
/*
 * If spawned save the intercommunicator context ID, spawning root,
 * universe size and application number.  
 */
		if (_kio.ki_parent > 0) {
			*cid = (int) nhead.nh_data[1];
			*root = (int) nhead.nh_data[2];
			lam_universe_size = (int) nhead.nh_data[3];
			lam_appnum = (int) nhead.nh_data[4];
		}
	} else {
		if (procs_n == 1) {
			procs->gps_node = getnodeid();
			procs->gps_pid = getpid();
			procs->gps_idx = get_singleton_idx(procs->gps_pid);
			if (procs->gps_idx < 0)	return(LAMERROR);
		} else {
			for (i = 0, p = procs; i < procs_n; ++i, ++p) {
				p->gps_node = i;
				p->gps_pid = getpid();
				p->gps_idx = 0;
			}
		}
	}

	if (_kio.ki_jobid.jid_node != 0) {
	  lam_jobid.jid_node = _kio.ki_jobid.jid_node;
	  lam_jobid.jid_pid = _kio.ki_jobid.jid_pid;
	} else {
	  lam_jobid.jid_node = procs->gps_node;
	  lam_jobid.jid_pid = procs->gps_pid;
	}
/*
 * Set the global ranks in the local world and add the local world
 * processes to the process list while finding out my identity.
 */
	for (i = 0, p = procs; i < *world_n; ++i, ++p) {
		p->gps_grank = i;
		proc = lam_procadd(p);
		if (proc == 0) return(LAMERROR);

		if ((p->gps_node == getnodeid()) && (p->gps_pid == getpid())) {
			lam_myproc = proc;
		}

		if (_kio.ki_parent > 0) {
			proc->p_mode |= LAM_PCLIENT;
		}
	}
/*
 * Add the parents (if any) to the process list.
 */
	for (i = 0; i < _kio.ki_parent; ++i, ++p) {
		proc = lam_procadd(p);
		if (proc == 0) {
			return(LAMERROR);
		}
		proc->p_mode |= LAM_PCLIENT;
	}  
/*
 * interface specific initialization
 */
	if (RPI_SPLIT(_rpi_lamd_init, _rpi_c2c_init, ())) {
		return(LAMERROR);
	}
/*
 * Synchronize clocks across the nodes.
 */
	if (_kio.ki_rtf & RTF_TRACE) {
		if (lam_clocksync(procs_n, procs, &lam_clockskew))
			return(LAMERROR);
	}
/*
 * Global rank zero records the world trace.
 */
	if ((_kio.ki_rtf & RTF_TRACE)
			&& (lam_myproc->p_gps.gps_grank == 0)) {

		trwlen = 2 * sizeof(int4) + (*world_n) * sizeof(struct _gps);

		trworld = (char *) malloc((unsigned) trwlen);
		if (trworld == 0) return(LAMERROR);

		((int4 *) trworld)[0] = LAM_TRMAGIC;
		((int4 *) trworld)[1] = *world_n;
		memcpy(trworld + 2 * sizeof(int4), (char *) procs,
					(*world_n) * sizeof(struct _gps));

		mltoti4(trworld, trwlen / sizeof(int4));

		if (lam_rtrstore(LOCAL, TRWORLD, lam_myproc->p_gps.gps_pid,
				trworld, trwlen)) {
			free(trworld);
			return(LAMERROR);
		}

		free(trworld);
	}

	*parent_n = _kio.ki_parent;
	*worlds = procs;

	return(0);

}

/*
 *	get_singleton_idx
 *
 *	Function:	- get kenya index of singleton MPI process
 *	Accepts:	- process pid
 *	Returns:	- kenya index or LAMERROR
 */
static int
get_singleton_idx(pid)

int			pid;

{
	struct pstate	state;			/* state returned from kenyad */
	
	if (rpstate(LOCAL, SELECT_PID, pid, &state, 1) != 1) {
		return(LAMERROR);
	}

	return(state.ps_index);
}

int
lam_get_proc_array(procs, world_n, cid, procs_n, is_impi)

struct _gps     	**procs;	     	/* process GPS array */
int			*world_n;
int			*cid;
int                     *procs_n;
int                     is_impi;

{
/*
 *  This subroutine is called twice if it is an IMPI job 
 */
  DBUG("In get_proc_array\n");

/*
 * Get the # of processes in the world.
 * Allocate the array of process GPS.
 */
  
  if (!is_impi) {
    if ((_kio.ki_parent > 0) || (_kio.ki_rtf & RTF_MPIRUN)) {
      *world_n = _kio.ki_world;
    } else {
      *world_n = getenv("LAMWORLDNODES") ? getncomp() : 1;
    }
    
    DBUG("IN laminit, the world is size %d\n", *world_n);
    
  }
  else {
    
#if LAM_WANT_IMPI
    /* 
     * But if this is an IMPI job, that number is possibly wrong --
     * let's check and see if we need to get a new one (from the
     * IMPI server) expand the world number to include all of impi
     * world as well even though the impid will be the proxy entry
     * for them
     */

    DBUG("IN laminit -- IMPI, the world_n is  %d\n", *world_n);
    DBUG("IN laminit -- IMPI, the impi_nprocs is  %d\n",  impi_server_info.nprocs);
        
    *cid = impi_server_info.min_cid;
    lam_maxtag = impi_server_info.max_tag;
    
    DBUG("IMPID is node %d idx %d pid %d\n", gimpid.gps_node,
	   gimpid.gps_idx, gimpid.gps_pid);
    DBUG("Done with initial IMPI setup\n");
#endif
  }
  
  *procs_n = *world_n + _kio.ki_parent;
  
  *procs = (struct _gps *)
    malloc((unsigned) *procs_n * sizeof(struct _gps));

    DBUG("IN laminit, the procs_n is size %d\n", *procs_n);
  
  if (*procs == 0)
    return(LAMERROR);
  else
    return 0;
}

