/*
 *
 * 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/RBD
 *
 *	$Id: lamupdown.c,v 6.8 1999/08/26 20:55:19 jsquyres Exp $
 *
 *	Function:	- take top level info down
 *			- take error info up
 */

#include <stdlib.h>

#include <mpi.h>
#include <mpisys.h>
#include <rpisys.h>
#include <blktype.h>

/*
 * global variables
 */
int			lam_topfunc = 0;
int			lam_toproot;
int			lam_toprootgps;

/*
 * private data
 */
static int              *funcs = 0;
static int              num_funcs = 0; /* points to next available slot */
static int              max_funcs = 0;
static int              inc_funcs = 1;

/*
 *	lam_setfunc
 *
 *	Function:	- set top level function
 *	Accepts:	- local function type
 */
void
lam_setfunc(locfunc)

int			locfunc;

{
  /* Grow the stack if necessary */

  if (max_funcs <= num_funcs) {
    if (max_funcs == 0)
      funcs = malloc(sizeof(int) * inc_funcs);
    else
      funcs = realloc(funcs, sizeof(int) * (max_funcs + inc_funcs));

    max_funcs += inc_funcs;
  }

  /* Save the function in the next available slot */

  lam_topfunc = locfunc;
  funcs[num_funcs] = locfunc;
  num_funcs++;
}

/*
 *	lam_resetfunc
 *
 *	Function:	- reset function at top level
 *	Accepts:	- local function type
 */
void
lam_resetfunc(locfunc)

int			locfunc;

{
  struct _fyiproc	*p;			/* favourite pointer */
  p = (struct _fyiproc *) _kio.ki_fyi;
  
  if (num_funcs > 0) {
    if (locfunc == -1 || funcs[num_funcs - 1] == locfunc) {
      num_funcs--;

      if (num_funcs > 0)
	lam_topfunc = funcs[num_funcs - 1];
      else
	lam_topfunc = p->fyp_func = 0;
    }
  }
}

/*
 *	lam_numfuncs
 *
 *	Function:	- get the size of the stack
 *	Returns:	- size of the stack
 */
int
lam_numfuncs()
{
  return num_funcs;
}


/*
 *	lam_getfunc
 *
 *	Function:	- get top level function
 *	Returns:	- top level function
 */
int
lam_getfunc()

{
  if (num_funcs > 0)
    return funcs[num_funcs - 1];
  else
    return 0;
}

/*
 *	lam_setparam
 *
 *	Function:	- set top level parameters
 *	Accepts:	- local function type
 *			- root global/local rank (collective comm.)
 *			- root node/index GPS (collective comm.)
 */
void
lam_setparam(locfunc, root, rootgps)

int			locfunc;
int			root;
int			rootgps;

{
	if (lam_topfunc == locfunc) {
		lam_toproot = root;
		lam_toprootgps = rootgps;
	}
}

/*
 *	lam_getparam
 *
 *	Function:	- get top level parameters
 *	Accepts:	- ptr root ranks
 *			- ptr root GPS
 */
void
lam_getparam(proot, prootgps)

int			*proot;
int			*prootgps;

{
	*proot = lam_toproot;
	*prootgps = lam_toprootgps;
}

/*
 *	lam_mkerr
 *
 *	Function:	- form an error code
 *	Accepts:	- error class
 *			- error value
 *	Returns:	- error code
 */
int
lam_mkerr(class, error)

int			class;
int			error;

{
	int		errcode;

	errcode = ((error & 0xFFFF) << 8) | (lam_topfunc & 0xFF);
	errcode = (errcode << 8) | (class & 0xFF);
	return(errcode);
}

/*
 *	lam_bkerr
 *
 *	Function:	- break error code into components
 *	Accepts:	- error code
 *			- ptr class (returned value)
 *			- ptr function (returned value)
 *			- ptr error (returned value)
 */
void
lam_bkerr(errcode, class, func, error)

int			errcode;
int			*class;
int			*func;
int			*error;

{
	*class = errcode & 0xFF;
	errcode >>= 8;
	*func = errcode & 0xFF;
	errcode >>= 8;
	*error = errcode & 0xFFFF;
}

/*
 *	lam_errfunc
 *
 *	Function:	- handle MPI errors according to error mode
 *			- pass error up to top level
 *			- call error handler at top level
 *	Accepts:	- communicator
 *			- local function type
 *			- error code
 *	Returns:	- error code
 */
int
lam_errfunc(errcomm, locfunc, errcode)

MPI_Comm		errcomm;
int			locfunc;
int			errcode;

{
	MPI_Comm	comm;			/* communicator */
	int		class;			/* error class */
	int		func;			/* function type */
	int		error;			/* errno value */
/*
 * This catches some cases where errors are returned in F77 wrappers
 * before the call is made to the C version of the MPI function.  
 */
	lam_initerr_m();

	lam_bkerr(errcode, &class, &func, &error);

	if (func == locfunc) {

		comm = (errcomm) ? errcomm : MPI_COMM_WORLD;

		if (comm->c_window) {
			return(lam_err_win(comm->c_window, class, error, ""));
		} else {
			return(lam_err_comm(comm, class, error, ""));
		}
	}

	return(errcode);
}

/*
 *	lam_printfunc
 *
 *	Function:	- print out the call stack without destroying it
 */
void
lam_printfunc()
{
  int i, myrank;

  if (num_funcs > 0) {
    myrank = lam_myproc->p_gps.gps_grank;
    printf("Rank %d: Call stack within LAM:\n", myrank);
    for (i = --num_funcs; i >= 0; i--)
      printf("Rank %d:  - %s()\n", myrank, blktype(funcs[i]));
    printf("Rank %d:  - main()\n", myrank);
  }
}


/*
 *	lam_nukefunc
 *
 *	Function:	- reset top function (cleanup)
 */
void
lam_nukefunc()

{
  lam_topfunc = 0;
  if (max_funcs > 0) {
    max_funcs = 0;
    num_funcs = 0;
    free(funcs);
    funcs = (int*) 0;
  }

  lam_topfunc = 0;
  ((struct _fyiproc *) _kio.ki_fyi)->fyp_func = 0;
}

/*
 *	lam_err_comm
 *
 *	Function:	- handle MPI error on a communicator
 *	Accepts:	- communicator
 *			- error class
 *			- errno value
 *			- error message
 *	Returns:	- error class
 */
int
lam_err_comm(comm, errclass, error, errmsg)

MPI_Comm		comm;
int			errclass;
int			error;
char			*errmsg;

{
/*
 * Catch the uninitialized case when an error is returned in an F77
 * wrapper before the call is made to the C version of the function.  
 */
	lam_initerr_m();
/*
 * If the top function is zero then the error has already been handled.
 */
	if (lam_topfunc == 0) {
	    return(errclass);
	}

	if (comm == MPI_COMM_NULL) {
		comm = MPI_COMM_WORLD;
	}
/*
 * Compatibility with lam_errfunc() style error handling.  Check if the
 * errorclass has encoded information and if so break it down.
 */
	if (errclass & 0xFFFFFF00) {
		error = (errclass >> 16) & 0xFFFF;
		errclass &= 0xFF;
	}
/*
 * If this is a window communicator invoke the window error handler.
 */
	if (comm->c_window) {
		return(lam_err_win(comm->c_window, errclass, error, errmsg));
	}
/*
 * Invoke communicator error handler taking care with language calling
 * convention.
 */
	if (comm->c_errhdl->eh_flags & LAM_LANGF77) {
		(comm->c_errhdl->eh_func)(&comm->c_f77handle,
						&errclass, error, errmsg);
	} else if (comm->c_errhdl->eh_func) {
		(comm->c_errhdl->eh_func)(&comm, &errclass, error, errmsg);
	} else {
		lam_comm_errfatal(&comm, &errclass, error, errmsg);
	}

	lam_nukefunc();

	return(errclass);
}

/*
 *	lam_err_win
 *
 *	Function:	- handle MPI error on a window
 *	Accepts:	- window
 *			- error class
 *			- errno value
 *			- error message
 *	Returns:	- error class
 */
int
lam_err_win(win, errclass, error, errmsg)

MPI_Win			win;
int			errclass;
int			error;
char			*errmsg;

{
/*
 * Catch the uninitialized case when an error is returned in an F77
 * wrapper before the call is made to the C version of the function.  
 */
	lam_initerr_m();
/*
 * If the top function is zero then the error has already been handled.
 */
	if (lam_topfunc == 0) {
	    return(errclass);
	}
/*
 * Compatibility with lam_errfunc() style error handling.  Check if the
 * errorclass has encoded information and if so break it down.
 */
	if (errclass & 0xFFFFFF00) {
		error = (errclass >> 16) & 0xFFFF;
		errclass &= 0xFF;
	}

	if (win->w_errhdl->eh_flags & LAM_LANGF77) {
		(win->w_errhdl->eh_func)(&win->w_f77handle,
					&errclass, error, errmsg);
	} else if (win->w_errhdl->eh_func) {
		(win->w_errhdl->eh_func)(&win, &errclass, error, errmsg);
	} else {
		lam_win_errfatal(&win, &errclass, error, errmsg);
	}

	lam_nukefunc();
	
	return(errclass);
}
