/****************************************************************
 *								*
 *	Copyright 2001, 2014 Fidelity Information Services, Inc	*
 *								*
 *	This source code contains the intellectual property	*
 *	of its copyright holder(s), and is made available	*
 *	under a license.  If you do not know the terms of	*
 *	the license, please stop and do not read further.	*
 *								*
 ****************************************************************/

#include "mdef.h"

#include "gtm_string.h"
#include <stdarg.h>
#include <errno.h>
#ifdef GTM_PTHREAD
#  include <pthread.h>
#endif
#include "gtm_stdlib.h"

#include "stringpool.h"
#include "copy.h"
#include <rtnhdr.h>
#include "stack_frame.h"
#include "op.h"
#include "lv_val.h"		/* needed for "fgncal.h" */
#include "fgncal.h"
#include "gtmci.h"
#include "gtmxc_types.h"
#include "mvalconv.h"
#include "gt_timer.h"
#include "callg.h"
#include "callintogtmxfer.h"
#include "min_max.h"
#include "have_crit.h"

/******************************************************************************
 *
 * This routine is called by generated code with the following arguments:
 *
 *	n	argument count (int4)
 *	dst	destination (mval *), that is, result for extrinsic function call
 *		null pointer means that this is a routine call
 *	package	package name (mval *)
 *	extref	external reference name (mval *)
 *	mask	call-by refrence mask (int4)
 *			If bit=1, then call by reference,
 *			otherwise, call by value.
 *		lsb is first argument, etc.
 *			Implies all call-by-reference arguments must be in the first 32 arguments.
 *	argcnt	argument count (int4).  Number of input parameters.
 *		always equal to argument count n - 5
 *	arg0	the first input paramter (mval *)
 *	arg1	the second input parameter (mval *)
 *	...	...
 *	argi	the last input parameter, i = argcnt - 1
 *
 *	example:
 *		d &mathpak.bessel(p1,p2,.p3)
 *
 *	would result in the following call:
 *
 *	op_fnfgncal(8, 0, mval*("mathpak"), mval*("bessel"), 4, 3, mval*(p1), mval*(p2), mval*(p3))
 *
 *	where, mval*(val) indicates the address of an mval that has the string value val.
 *
 *	If the extref has a routine name, than the extref looks like an M source
 *	reference.  E.g.:
 *		s x=&$foo^bar
 *		entryref-->"foo.bar"*
 *
 *
 *	This routine is platform independent (at least for UNIX).
 *	It requires two platform specific routines:
 *
 *		lookup package
 *		Return package_handle if success, NULL otherwise.
 *
 *		void * fgn_getpak(char *package_name, int error_severity)
 *		{
 *			lookup package
 *			If not found, return NULL;
 *			store any system specific information in package_handle
 *			return package_handle;
 *		}
 *
 *		lookup function
 *		return function address if success, NULL otherwise
 *
 *		typedef int (*fgnfnc)();
 *
 *		fgnfnc fgn_getrtn(void *package_handle, mstr *entry_name)
 *		{
 *			lookup entry_name
 *			If not found return NULL;
 *			return function address;
 *		}
 *
 ******************************************************************************/

GBLREF stack_frame      *frame_pointer;
GBLREF unsigned char    *msp;
GBLREF spdesc 		stringpool;
GBLREF int    		(*callintogtm_vectortable[])();
GBLREF int		mumps_status;
GBLREF volatile int4	gtmMallocDepth;
#ifdef GTM_PTHREAD
GBLREF boolean_t	gtm_jvm_process;
GBLREF pthread_t	gtm_main_thread_id;
GBLREF boolean_t	gtm_main_thread_id_set;
#endif

LITREF mval		skiparg;

error_def(ERR_JNI);
error_def(ERR_MAXSTRLEN);
error_def(ERR_TEXT);
error_def(ERR_UNIMPLOP);
error_def(ERR_XCVOIDRET);
error_def(ERR_ZCARGMSMTCH);
error_def(ERR_ZCCTENV);
error_def(ERR_ZCMAXPARAM);
error_def(ERR_ZCNOPREALLOUTPAR);
error_def(ERR_ZCRTENOTF);
error_def(ERR_ZCSTATUSRET);
error_def(ERR_ZCUSRRTN);
error_def(ERR_ZCVECTORINDX);

STATICDEF int		call_table_initialized = 0;
/* The following are one-letter mnemonics for Java argument types (capital letters to denote output direction):
 * 						boolean	int	long	float	double	String	byte[] */
STATICDEF char		gtm_jtype_chars[] = {	'b',	'i',	'l',	'f',	'd',	'j',	'a',
						'B',	'I',	'L',	'F',	'D',	'J',	'A' };
STATICDEF int		gtm_jtype_start_idx = gtm_jboolean,	/* Value of first gtm_j... type for calculation of table indices. */
	  		gtm_jtype_count = gtm_jbyte_array - gtm_jboolean + 1;	/* Number of types supported with Java call-outs. */

STATICFNDCL void	extarg2mval(void *src, enum gtm_types typ, mval *dst, boolean_t java, boolean_t starred);
STATICFNDCL int		extarg_getsize(void *src, enum gtm_types typ, mval *dst);
STATICFNDCL void	op_fgnjavacal(mval *dst, mval *package, mval *extref, uint4 mask, int4 argcnt, int4 entry_argcnt,
				struct extcall_package_list *package_ptr, struct extcall_entry_list *entry_ptr, va_list var);

/* Routine to convert external return values to mval's */
STATICFNDEF void extarg2mval(void *src, enum gtm_types typ, mval *dst, boolean_t java, boolean_t starred)
{
	gtm_int_t		s_int_num;
	gtm_long_t		str_len, s_long_num;
	gtm_uint_t		uns_int_num;
	gtm_ulong_t		uns_long_num;
	char			*cp;
	struct extcall_string	*sp;

	if (java)
	{
		switch (typ)
		{
			case gtm_notfound:
				break;
			case gtm_void:
				break;
			case gtm_status:
				/* Note: reason for double cast is to first turn ptr to same sized int, then big int to little int
				 * (on 64 bit platforms). This avoids a warning msg with newer 64 bit gcc compilers.
				 */
				s_int_num = (gtm_int_t)(intszofptr_t)src;
				if (0 != s_int_num)
					rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_ZCSTATUSRET);
				MV_FORCE_MVAL(dst, s_int_num);
				break;
			case gtm_jboolean:
			case gtm_jint:
				if (starred)
					s_int_num = *((gtm_int_t *)src);
				else
					s_int_num = (gtm_int_t)(intszofptr_t)src;
				MV_FORCE_MVAL(dst, s_int_num);
				break;
			case gtm_jlong:
#				ifdef GTM64
				if (starred)
					s_long_num = *((gtm_long_t *)src);
				else
					s_long_num = (gtm_long_t)src;
				MV_FORCE_LMVAL(dst, s_long_num);
#				else
				i82mval(dst, *(gtm_int64_t *)src);
#				endif
				break;
			case gtm_jfloat:
				float2mval(dst, *((float *)src));
				break;
			case gtm_jdouble:
				double2mval(dst, *((double *)src));
				break;
			case gtm_jstring:
			case gtm_jbyte_array:
				sp = (struct extcall_string *)src;
				dst->mvtype = MV_STR;
				if (sp->len > MAX_STRLEN)
					rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MAXSTRLEN);
				dst->str.len = (mstr_len_t)sp->len;
				if ((0 < sp->len) && (NULL != sp->addr))
				{
					dst->str.addr = sp->addr;
					s2pool(&dst->str);
					/* In case of GTMByteArray or GTMString, the buffer is allocated in xc_gateway.c (since the
					 * user might need to return a bigger buffer than the original array size will allow (in
					 * case of a string the content is immutable). So, if we have determined that the provided
					 * value buffer is legitimate (non-null and non-empty), we free it on the GT.M side. */
					free(sp->addr);
				}
				break;
			default:
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
				break;
		}
		return;
	}
	/* The following switch is for non-Java call-outs. */
	switch (typ)
	{
		case gtm_notfound:
			break;
		case gtm_void:
			break;
		case gtm_status:
			/* Note: reason for double cast is to first turn ptr to same sized int, then big int to little int
			 * (on 64 bit platforms). This avoids a warning msg with newer 64 bit gcc compilers.
			 */
			s_int_num = (gtm_int_t)(intszofptr_t)src;
			if (0 != s_int_num)
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_ZCSTATUSRET);
			MV_FORCE_MVAL(dst, s_int_num);
			break;
		case gtm_int:
			s_int_num = (gtm_int_t)(intszofptr_t)src;
			MV_FORCE_MVAL(dst, s_int_num);
			break;
		case gtm_uint:
			uns_int_num = (gtm_uint_t)(intszofptr_t)src;
			MV_FORCE_UMVAL(dst, uns_int_num);
			break;
		case gtm_int_star:
			s_int_num = *((gtm_int_t *)src);
			MV_FORCE_MVAL(dst, s_int_num);
			break;
		case gtm_uint_star:
			uns_int_num = *((gtm_uint_t *)src);
			MV_FORCE_UMVAL(dst, uns_int_num);
			break;
		case gtm_long:
			s_long_num = (gtm_long_t)src;
			MV_FORCE_LMVAL(dst, s_long_num);
			break;
		case gtm_ulong:
			uns_long_num = (gtm_ulong_t)src;
			MV_FORCE_ULMVAL(dst, uns_long_num);
			break;
		case gtm_long_star:
			s_long_num = *((gtm_long_t *)src);
			MV_FORCE_LMVAL(dst, s_long_num);
			break;
		case gtm_ulong_star:
			uns_long_num = *((gtm_ulong_t *)src);
			MV_FORCE_ULMVAL(dst, uns_long_num);
			break;
		case gtm_string_star:
			sp = (struct extcall_string *)src;
			dst->mvtype = MV_STR;
			if (sp->len > MAX_STRLEN)
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MAXSTRLEN);
			dst->str.len = (mstr_len_t)sp->len;
			if ((0 < sp->len) && (NULL != sp->addr))
			{
				dst->str.addr = sp->addr;
				s2pool(&dst->str);
			}
			break;
		case gtm_float_star:
			float2mval(dst, *((float *)src));
			break;
		case gtm_char_star:
			cp = (char *)src;
			assert(((INTPTR_T)cp < (INTPTR_T)stringpool.base) || ((INTPTR_T)cp > (INTPTR_T)stringpool.top));
			dst->mvtype = MV_STR;
			str_len = STRLEN(cp);
			if (str_len > MAX_STRLEN)
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MAXSTRLEN);
			dst->str.len = (mstr_len_t)str_len;
			dst->str.addr = cp;
			s2pool(&dst->str);
			break;
		case gtm_char_starstar:
			if (!src)
				dst->mvtype = 0;
			else
				extarg2mval(*((char **)src), gtm_char_star, dst, java, starred);
			break;
		case gtm_double_star:
			double2mval(dst, *((double *)src));
			break;
		default:
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
			break;
	}
	return;
}

/* Subroutine to calculate stringpool requirements for an external argument */
STATICFNDEF int extarg_getsize(void *src, enum gtm_types typ, mval *dst)
{
	char			*cp, **cpp;
	struct extcall_string	*sp;

	if (!src)
		return 0;
	switch(typ)
	{	/* The following group of cases either return nothing or use the numeric part of the mval */
		case gtm_notfound:
		case gtm_void:
		case gtm_double_star:
		case gtm_status:
		case gtm_int:
		case gtm_uint:
		case gtm_long:
		case gtm_ulong:
		case gtm_float_star:
		case gtm_int_star:
		case gtm_uint_star:
		case gtm_long_star:
		case gtm_ulong_star:
		case gtm_jboolean:
		case gtm_jint:
		case gtm_jlong:
		case gtm_jfloat:
		case gtm_jdouble:
			return 0;
		case gtm_char_starstar:
			cpp = (char **)src;
			if (*cpp)
				return STRLEN(*cpp);
			else
				return 0;
		case gtm_char_star:
			cp = (char *)src;
			return STRLEN(cp);
		case gtm_jstring:
		case gtm_jbyte_array:
		case gtm_string_star:
			sp = (struct extcall_string *)src;
			if ((0 < sp->len)
			    && ((INTPTR_T)sp->addr < (INTPTR_T)stringpool.free)
			    && ((INTPTR_T)sp->addr >= (INTPTR_T)stringpool.base))
			{	/* The stuff is already in the stringpool */
				assert(dst->str.addr == sp->addr);
				dst->str.addr = sp->addr;
				sp->addr = NULL;	/* Prevent subsequent s2pool */
				return 0;
			} else  if (NULL == sp->addr)
				sp->len = 0;
			return (int)(sp->len);
			break;
		default:
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
			break;
	}

	return 0; /* This should never get executed, added to make compiler happy */
}

STATICFNDEF void op_fgnjavacal(mval *dst, mval *package, mval *extref, uint4 mask, int4 argcnt, int4 entry_argcnt,
    struct extcall_package_list *package_ptr, struct extcall_entry_list *entry_ptr, va_list var)
{
	boolean_t	error_in_xc = FALSE;
	char		*free_string_pointer, *free_string_pointer_start, jtype_char;
	char		str_buffer[MAX_NAME_LENGTH], *tmp_buff_ptr, *jni_err_buf;
	char		*types_descr_ptr, *types_descr_dptr, *xtrnl_table_name;
	gparam_list	*param_list;
	gtm_long_t	*free_space_pointer;
	int		i, j, save_mumps_status;
	int4 		m1, m2, n, space_n;
	INTPTR_T	status;
	mval		*v;
	va_list		var_copy;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
#	ifdef GTM_PTHREAD
	assert(gtm_jvm_process == gtm_main_thread_id_set);
	gtm_jvm_process = TRUE;
	if (!gtm_main_thread_id_set)
	{
		gtm_main_thread_id = pthread_self();
		gtm_main_thread_id_set = TRUE;
	}
#	endif
	/* This is how many parameters we will use for callg, including the implicit ones described below. So, better make
	 * sure we are not trying to pass more than callg can handle.
	 */
	if (MAX_ACTUALS < argcnt + 3)
		rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_ZCMAXPARAM);
	VAR_COPY(var_copy, var);
	/* Compute size of parameter block */
	n = entry_ptr->parmblk_size + (3 * SIZEOF(void *));	/* This is enough for the parameters and the fixed length entries */
	mask >>= 2;						/* Bypass the class and method arguments. */
	/* The first byte of the first argument (types_descr_ptr) stores the number of expected arguments, according to the external
	 * calls table; the second byte describes the expected return type, and subsequent bytes---the expected argument types using
	 * a one-character mnemonic which gets deciphered in the JNI layer. Note that in case of an error the xc_gateway.c module
	 * would set the first byte to 0xFF, followed by an address at which the error message is stored. For that reason, we
	 * allocate more space than we might strictly need for the arguments, return type, and type descriptor.
	 */
	types_descr_ptr = (char *)malloc(MAX(SIZEOF(char) * (argcnt + 2), SIZEOF(char *) * 2));
	types_descr_dptr = types_descr_ptr;
	*types_descr_dptr = (char)entry_argcnt;
	types_descr_dptr++;
	if (dst)
	{	/* Record the expected return type. */
		switch (entry_ptr->return_type)
		{
			case gtm_status:
				*types_descr_dptr = 'i';
				break;
			case gtm_jlong:
				*types_descr_dptr = 'l';
				break;
			default:
				*types_descr_dptr = 'v';
		}
	} else
		*types_descr_dptr = 'v';
	types_descr_dptr++;
	assert(2 * gtm_jtype_count == SIZEOF(gtm_jtype_chars));
	for (i = argcnt + 2, j = -2, m1 = entry_ptr->input_mask, m2 = entry_ptr->output_mask, space_n = 0; 0 < i; i--, j++)
	{	/* Enforce mval values and record expected argument types. */
		v = va_arg(var, mval *);
		if (0 > j)
		{
			MV_FORCE_STR(v);
			n += SIZEOF(void *) + v->str.len + 1;
			continue;
		}
		if (MASK_BIT_ON(m1))
		{
			MV_FORCE_DEFINED_UNLESS_SKIPARG(v);
		}
		/* Estimate how much allocation we are going to need for arguments which require more than pointer-size space. */
		if (MASK_BIT_ON(m1) && ((gtm_jstring == entry_ptr->parms[j]) || (gtm_jbyte_array == entry_ptr->parms[j])))
		{
			if (MV_DEFINED(v))
			{
				MV_FORCE_STR(v);
				n += SIZEOF(gtm_long_t) + SIZEOF(void *) + v->str.len + 1;  /* length + pointer + string + '\0' */
			} else
				n += SIZEOF(gtm_long_t) + SIZEOF(void *) + 1;		    /* length + pointer + '\0' */
			space_n += SIZEOF(gtm_long_t) + SIZEOF(void *);
		}
#		ifdef GTM64
		else if (MASK_BIT_ON(m2) || (gtm_jfloat == entry_ptr->parms[j]) || (gtm_jdouble == entry_ptr->parms[j]))
		{	/* Account for a pointer space, since floats and doubles cannot be passed by value. */
			n += SIZEOF(void *);
			space_n += SIZEOF(void *);
		}
#		else
		else if ((gtm_jdouble == entry_ptr->parms[j]) || (gtm_jlong == entry_ptr->parms[j]))
		{	/* Account for a pointer space, since longs and doubles cannot be passed by value on 32-bit boxes, and also
			 * make room for a potential 8-byte alignment.
			 */
			n += SIZEOF(void *) + SIZEOF(gtm_int64_t);
			space_n += SIZEOF(void *) + SIZEOF(gtm_int64_t);
		} else if (MASK_BIT_ON(m2) || (gtm_jfloat == entry_ptr->parms[j]))
		{	/* Account for a pointer space, since floats cannot be passed by value. */
			n += SIZEOF(void *);
			space_n += SIZEOF(void *);
		}
#		endif
		jtype_char = entry_ptr->parms[j] - gtm_jtype_start_idx;
		if ((0 > jtype_char) || (gtm_jtype_count <= jtype_char))
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
		else
			*types_descr_dptr = gtm_jtype_chars[MASK_BIT_ON(m2) ? (gtm_jtype_count + jtype_char) : jtype_char];
		types_descr_dptr++;
		m1 >>= 1;
		m2 >>= 1;
	}
	va_end(var);
        /* Allocate space for argument handling. Overall, the allocated space has the following structure:
	 *   ___________________________________________
	 *  |            |              |               |
	 *  | param_list | space buffer | string buffer |
	 *  |____________|______________|_______________|
	 *
	 * All input-output and output-only parameters have to be passed by reference, which means that param_list contains a
	 * pointer to the space buffer where the actual value is stored. Furthermore, in case of gtm_jstring_t and gtm_jbyte_array_t
	 * another pointer from within the space buffer is referencing an area inside the string buffer. Note, however, that certain
	 * arguments, such as gtm_jfloat_t and gtm_jdouble_t, and gtm_jlong_t on 32-bit boxes, are always passed by reference.
	 */
	param_list = (gparam_list *)malloc(n);
	param_list->arg[0] = (void *)types_descr_ptr;
	/* Adding 3 to account for type descriptions, class name, and method name arguments. */
	free_space_pointer = (gtm_long_t *)((char *)param_list + SIZEOF(intszofptr_t) + (SIZEOF(void *) * (argcnt + 3)));
	/* Adding 3 for the same reason as above and another 3 to account for the fact that each of type description, class name,
	 * and method name arguments require room in the free_space buffer, which comes ahead of free_string buffer in memory.
	 */
	free_string_pointer_start = free_string_pointer
		= (char *)param_list + entry_ptr->parmblk_size + (SIZEOF(void *) * 3) + space_n;
	/* Load-up the parameter list */
	VAR_COPY(var, var_copy);
	/* We need to enter this loop even if argcnt == 0, so that the class and method arguments get set. */
	for (i = (0 == argcnt ? -1 : 0), j = 1, m1 = entry_ptr->input_mask, m2 = entry_ptr->output_mask; i < argcnt; j++)
	{
		v = va_arg(var_copy, mval *);
		if (j < 3)
		{
			param_list->arg[j] = free_string_pointer;
			if (v->str.len)
			{
				memcpy(free_string_pointer, v->str.addr, v->str.len);
				free_string_pointer += v->str.len;
			}
			*free_string_pointer++ = '\0';
			/* In case there are 0 arguments. */
			if ((2 == j) && (0 > i))
				i = 0;
			continue;
		}
		/* Verify that all input values are defined. */
		switch (entry_ptr->parms[i])
		{
			case gtm_jboolean:
				if (MASK_BIT_ON(m2))
				{	/* Output expected. */
					param_list->arg[j] = free_space_pointer;
					*((gtm_int_t *)free_space_pointer) = (gtm_int_t)(MV_ON(m1, v) ? (mval2i(v) ? 1 : 0) : 0);
					free_space_pointer++;
				} else	/* Input expected. */
					param_list->arg[j] = (void *)(gtm_long_t)(MV_ON(m1, v) ? (mval2i(v) ? 1 : 0) : 0);
				break;
			case gtm_jint:
				if (MASK_BIT_ON(m2))
				{	/* Output expected. */
					param_list->arg[j] = free_space_pointer;
					*((gtm_int_t *)free_space_pointer) = (gtm_int_t)(MV_ON(m1, v) ? mval2i(v) : 0);
					free_space_pointer++;
				} else	/* Input expected. */
					param_list->arg[j] = (void *)(gtm_long_t)(MV_ON(m1, v) ? mval2i(v) : 0);
				break;
			case gtm_jlong:
#				ifndef GTM64
				/* Only need to do this rounding on non-64 it platforms because this one type has a 64-bit
				 * alignment requirement on those platforms.
				 */
				free_space_pointer = (gtm_long_t *)(ROUND_UP2(((INTPTR_T)free_space_pointer), SIZEOF(gtm_int64_t)));
#				else
				if (MASK_BIT_ON(m2))
				{	/* Output expected. */
#				endif
					param_list->arg[j] = free_space_pointer;
					*((gtm_int64_t *)free_space_pointer) = (gtm_int64_t)(MV_ON(m1, v) ? mval2i8(v) : 0);
					free_space_pointer = (gtm_long_t *)((char *)free_space_pointer + SIZEOF(gtm_int64_t));
#				ifdef GTM64
				} else	/* Input expected. */
					param_list->arg[j] = (void *)(gtm_int64_t)(MV_ON(m1, v) ? mval2i8(v) : 0);
#				endif
				break;
			case gtm_jfloat:
				/* Have to go with additional storage either way due to the limitations of callg. */
				param_list->arg[j] = free_space_pointer;
				*((float *)free_space_pointer) = (float)(MV_ON(m1, v) ? mval2double(v) : 0.0);
				free_space_pointer++;
				break;
			case gtm_jdouble:
#				ifndef GTM64
				/* Only need to do this rounding on non-64 it platforms because this one type has a 64 bit
				 * alignment requirement on those platforms.
				 */
				free_space_pointer = (gtm_long_t *)(ROUND_UP2(((INTPTR_T)free_space_pointer), SIZEOF(double)));
#				endif
				/* Have to go with additional storage either way due to the limitations of callg. */
				param_list->arg[j] = free_space_pointer;
				*((double *)free_space_pointer) = (double)(MV_ON(m1, v) ? mval2double(v) : 0.0);
				free_space_pointer = (gtm_long_t *)((char *)free_space_pointer + SIZEOF(double));
				break;
			case gtm_jstring:
			case gtm_jbyte_array:
				param_list->arg[j] = free_space_pointer;
				/* If this is input-enabled and defined, it should have been forced to string in an earlier loop. */
				assert(!MV_ON(m1, v) || MV_IS_STRING(v));
				if (MV_ON(m1, v) && v->str.len)
				{
					*free_space_pointer++ = (gtm_long_t)v->str.len;
					memcpy(free_string_pointer, v->str.addr, v->str.len);
					*(char **)free_space_pointer = (char *)free_string_pointer;
					free_string_pointer += v->str.len;
				} else
				{	/* If an argument is for output only, an empty string, or skipped altogether, we still want
					 * a valid length and a pointer to an empty null-terminated character array.
					 */
					*free_space_pointer++ = 0;
					*(char **)free_space_pointer = (char *)free_string_pointer;
				}
				free_space_pointer++;
				*free_string_pointer++ = '\0';
				break;
			default:
				va_end(var_copy);
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
				break;
		}
		assert(((char *)free_string_pointer <= ((char *)param_list + n * 2))
			&& ((char *)free_space_pointer <= ((char *)param_list + n * 2)));
		i++;
		m1 = m1 >> 1;
		m2 = m2 >> 1;
	}
	assert((char *)free_space_pointer <= free_string_pointer_start);
	va_end(var_copy);
	param_list->n = argcnt + 3;		/* Take care of the three implicit parameters. */
	save_mumps_status = mumps_status; 	/* Save mumps_status as a callin from external call may change it. */
	status = callg((callgfnptr)entry_ptr->fcn, param_list);
	mumps_status = save_mumps_status;
	/* The first byte of the type description argument gets set to 0xFF in case error happened in JNI glue code,
	 * so check for that and act accordingly.
	 */
	if ((char)0xFF == *(char *)param_list->arg[0])
	{
		error_in_xc = TRUE;
		jni_err_buf = *(char **)((char *)param_list->arg[0] + SIZEOF(char *));
		if (NULL != jni_err_buf)
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_JNI, 2, LEN_AND_STR(jni_err_buf));
		else
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_ZCSTATUSRET);
	}
	free(types_descr_ptr);
	/* Exit from the residual call-in environment(SFF_CI and base frames) which might still exist on M stack when the externally
	 * called function in turn called into an M routine.
	 */
	if (frame_pointer->flags & SFF_CI)
		ci_ret_code_quit();
	/* Only process the input-output and output-only arguments if the external call succeeded; otherwise, return -1
	 * if non-void return is expected.
	 */
	if (!error_in_xc)
	{	/* Compute space requirement for return values. */
		n = 0;
		VAR_COPY(var_copy, var);
		for (i = 0, j = 1, m1 = mask & entry_ptr->output_mask; i < argcnt; j++)
		{
			v = va_arg(var, mval *);
			if (j < 3)
				continue;
			if (MASK_BIT_ON(m1))
				n += extarg_getsize(param_list->arg[j], entry_ptr->parms[i], v);
			i++;
			m1 = m1 >> 1;
		}
		va_end(var);
		if (dst)
			n += extarg_getsize((void *)&status, gtm_status, dst);
		ENSURE_STP_FREE_SPACE(n);
		/* Convert return values. */
		VAR_COPY(var, var_copy);
		for (i = 0, j = 1, m1 = mask & entry_ptr->output_mask; i < argcnt; j++)
		{
			v = va_arg(var_copy, mval *);
			if (j < 3)
				continue;
			if (MASK_BIT_ON(m1))
				extarg2mval((void *)param_list->arg[j], entry_ptr->parms[i], v, TRUE, TRUE);
			i++;
			m1 = m1 >> 1;
		}
		va_end(var);
		if (dst)
		{
			if (entry_ptr->return_type != gtm_void)
				extarg2mval((void *)status, entry_ptr->return_type, dst, TRUE, FALSE);
			else
			{
				memcpy(str_buffer, PACKAGE_ENV_PREFIX, SIZEOF(PACKAGE_ENV_PREFIX));
				tmp_buff_ptr = &str_buffer[SIZEOF(PACKAGE_ENV_PREFIX) - 1];
				if (package->str.len)
				{
					assert(package->str.len < MAX_NAME_LENGTH - SIZEOF(PACKAGE_ENV_PREFIX) - 1);
					*tmp_buff_ptr++ = '_';
					memcpy(tmp_buff_ptr, package->str.addr, package->str.len);
					tmp_buff_ptr += package->str.len;
				}
				*tmp_buff_ptr = '\0';
				xtrnl_table_name = GETENV(str_buffer);
				if (NULL == xtrnl_table_name)
				{ 	/* Environment variable for the package not found. This part of code is for more safety.
					 * We should not come into this path at all.
					 */
					rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_ZCCTENV, 2, LEN_AND_STR(str_buffer));
				}
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(6) ERR_XCVOIDRET, 4,
					  LEN_AND_STR(entry_ptr->call_name.addr), LEN_AND_STR(xtrnl_table_name));
			}
		}
	} else if (dst && (gtm_void != entry_ptr->return_type))
		i2mval(dst, -1);
	free(param_list);
	check_for_timer_pops();
	return;
}

void op_fnfgncal(uint4 n_mvals, mval *dst, mval *package, mval *extref, uint4 mask, int4 argcnt, ...)
{
	boolean_t	java = FALSE;
	char		*free_string_pointer, *free_string_pointer_start;
	char		str_buffer[MAX_NAME_LENGTH], *tmp_buff_ptr, *xtrnl_table_name;
	int		i, pre_alloc_size, rslt, save_mumps_status;
	int4 		callintogtm_vectorindex, n;
	gparam_list	*param_list;
	gtm_long_t	*free_space_pointer;
	INTPTR_T	status;
	mval		*v;
	struct extcall_package_list	*package_ptr;
	struct extcall_entry_list	*entry_ptr;
	uint4		m1;
	va_list		var;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	assert(n_mvals == argcnt + 5);
	assert(MV_IS_STRING(package));	/* Package and routine are literal strings */
	assert(MV_IS_STRING(extref));
	if (MAX_ACTUALS < argcnt)
		rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_ZCMAXPARAM);
	assert(INTRPT_OK_TO_INTERRUPT == intrpt_ok_state); /* Interrupts should be enabled for external calls */
	/* Find package */
	for (package_ptr = TREF(extcall_package_root); package_ptr; package_ptr = package_ptr->next_package)
	{
		MSTR_CMP(package_ptr->package_name, package->str, rslt);
		if (0 == rslt)
			break;
	}
	/* If package has not been found, create it */
	if (NULL == package_ptr)
	{
		package_ptr = exttab_parse(package);
		package_ptr->next_package = TREF(extcall_package_root);
		TREF(extcall_package_root) = package_ptr;
	}
	/* At this point, we have a valid package, pointed to by package_ptr */
	assert(NULL != package_ptr);
	if (NULL == package_ptr->package_handle)
		rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) errno);
	/* Find entry */
	for (entry_ptr = package_ptr->first_entry; entry_ptr; entry_ptr = entry_ptr->next_entry)
	{
		MSTR_CMP(entry_ptr->entry_name, extref->str, rslt);
		if (0 == rslt)
			break;
	}
	if (call_table_initialized == FALSE)
	{
		call_table_initialized = TRUE;
		init_callin_functable();
	}
	/* Entry not found */
	if ((NULL == entry_ptr) || (NULL == entry_ptr->fcn))
		rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_ZCRTENOTF, 2, extref->str.len, extref->str.addr);
	/* Detect a call-out to Java. */
	if ((NULL != entry_ptr->call_name.addr) && !strncmp(entry_ptr->call_name.addr, "gtm_xcj", 7))
	{
		java = TRUE;
		argcnt -= 2;
	}
	/* It is an error to have more actual parameters than formal parameters */
	if (argcnt > entry_ptr->argcnt)
		rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_ZCARGMSMTCH, 2, argcnt, entry_ptr->argcnt);
	VAR_START(var, argcnt);
	if (java)
	{
		op_fgnjavacal(dst, package, extref, mask, argcnt, entry_ptr->argcnt, package_ptr, entry_ptr, var);
		return;
	}
	/* Compute size of parameter block */
	n = entry_ptr->parmblk_size;	/* This is enough for the parameters and the fixed length entries */
	/* Now, add enough for the char *'s and the char **'s and string *'s */
	for (i = 0, m1 = entry_ptr->input_mask; i < argcnt; i++, m1 = m1 >> 1)
	{
		v = va_arg(var, mval *);
		/* For char*, char **, and gtm_string_t * types, add the length. Also a good time to force it into string form. */
		switch (entry_ptr->parms[i])
		{
			case gtm_string_star:	/* CAUTION: Fall-through. */
			case gtm_char_star:
				n += (-1 != entry_ptr->param_pre_alloc_size[i]) ? entry_ptr->param_pre_alloc_size[i] : 0;
				/* CAUTION: Fall-through. */
			case gtm_char_starstar:
				if (MASK_BIT_ON(m1))
				{
					if (MV_DEFINED(v))
					{
						MV_FORCE_STR(v);
						n += v->str.len + 1;	/* gtm_string_star does not really need the extra byte */
					} else
					{
						MV_FORCE_DEFINED_UNLESS_SKIPARG(v);
						n += 1;
					}
				}
				break;
#			ifndef GTM64
			case gtm_double_star:
				n += SIZEOF(double);
				/* CAUTION: Fall-through. */
#			endif
			default:
				if (MASK_BIT_ON(m1))
				{
					MV_FORCE_DEFINED_UNLESS_SKIPARG(v);
				}
		}
	}
	va_end(var);
        /* Double the size, to take care of any alignments in the middle. Overall, the allocated space has the following structure:
	 *   ___________________________________________
	 *  |            |              |               |
	 *  | param_list | space buffer | string buffer |
	 *  |____________|______________|_______________|
	 *
	 * For pointer-type arguments (gtm_long_t *, gtm_float_t *, etc.) the value in param_list is a pointer to a slot inside the
	 * space buffer, unless it is gtm_char_t *, in which case the string buffer is used. For double-pointer types (char ** or
	 * gtm_string_t *) the value in param_list is always a pointer inside the space buffer, where a pointer to an area inside
	 * the string buffer is stored.
	 */
	param_list = (gparam_list *)malloc(n * 2);
	free_space_pointer = (gtm_long_t *)((char *)param_list + SIZEOF(intszofptr_t) + (SIZEOF(void *) * argcnt));
	free_string_pointer_start = free_string_pointer = (char *)param_list + entry_ptr->parmblk_size;
	/* Load-up the parameter list */
	VAR_START(var, argcnt);
	for (i = 0, m1 = entry_ptr->input_mask; i < argcnt; i++, m1 = m1 >> 1)
	{
		v = va_arg(var, mval *);
		/* Verify that all input values are defined */
		pre_alloc_size = entry_ptr->param_pre_alloc_size[i];
		switch (entry_ptr->parms[i])
		{
			case gtm_uint:
				param_list->arg[i] = (void *)(gtm_ulong_t)(MV_ON(m1, v) ? mval2ui(v) : 0);
				/* Note: output gtm_int and gtm_uint is an error (only "star" flavor can be modified). */
				break;
			case gtm_int:
				param_list->arg[i] = (void *)(gtm_long_t)(MV_ON(m1, v) ? mval2i(v) : 0);
				break;
			case gtm_ulong:
				param_list->arg[i] = (void *)GTM64_ONLY((gtm_uint64_t)) NON_GTM64_ONLY((gtm_ulong_t))
					(MV_ON(m1, v) ? GTM64_ONLY(mval2ui8(v)) NON_GTM64_ONLY(mval2ui(v)) : 0);
				/* Note: output xc_long and xc_ulong is an error as described above. */
				break;
			case gtm_long:
				param_list->arg[i] = (void *)GTM64_ONLY((gtm_int64_t)) NON_GTM64_ONLY((gtm_long_t))
					(MV_ON(m1, v) ? GTM64_ONLY(mval2i8(v)) NON_GTM64_ONLY(mval2i(v)) : 0);
				break;
			case gtm_char_star:
				param_list->arg[i] = free_string_pointer;
				if (MASK_BIT_ON(m1))
				{	/* If this is defined and input-enabled, it should have already been forced to string. */
					assert(!MV_DEFINED(v) || MV_IS_STRING(v));
					if (MV_DEFINED(v) && v->str.len)
					{
						memcpy(free_string_pointer, v->str.addr, v->str.len);
						free_string_pointer += v->str.len;
					}
					*free_string_pointer++ = '\0';
				} else if (0 < pre_alloc_size)
				{
					*free_string_pointer = '\0';
					free_string_pointer += pre_alloc_size;
				} else /* Output and no pre-allocation specified */
				{
					if (0 == package->str.len)
						/* Default package - do not display package name */
						rts_error_csa(CSA_ARG(NULL) VARLSTCNT(7) ERR_ZCNOPREALLOUTPAR, 5, i + 1,
							RTS_ERROR_LITERAL("<DEFAULT>"), extref->str.len, extref->str.addr);
					else
						rts_error_csa(CSA_ARG(NULL) VARLSTCNT(7) ERR_ZCNOPREALLOUTPAR, 5, i + 1,
							package->str.len, package->str.addr, extref->str.len, extref->str.addr);
				}
				break;
			case gtm_char_starstar:
				param_list->arg[i] = free_space_pointer;
				/* If this is defined and input-enabled, it should have been forced to string in an earlier loop. */
				assert(!MV_ON(m1, v) || MV_IS_STRING(v));
				*(char **)free_space_pointer = free_string_pointer;
				if (MV_ON(m1, v) && v->str.len)
				{
					memcpy(free_string_pointer, v->str.addr, v->str.len);
					free_string_pointer += v->str.len;
				}
				*free_string_pointer++ = '\0';
				free_space_pointer++;
				break;
			case gtm_int_star:
				param_list->arg[i] = free_space_pointer;
				*((gtm_int_t *)free_space_pointer) = MV_ON(m1, v) ? (gtm_int_t)mval2i(v) : 0;
				free_space_pointer++;
				break;
			case gtm_uint_star:
				param_list->arg[i] = free_space_pointer;
				*((gtm_uint_t *)free_space_pointer) = MV_ON(m1, v) ? (gtm_uint_t)mval2ui(v) : 0;
				free_space_pointer++;
				break;
			case gtm_long_star:
				param_list->arg[i] = free_space_pointer;
				GTM64_ONLY(*((gtm_int64_t *)free_space_pointer) = MV_ON(m1, v) ? (gtm_int64_t)mval2i8(v) : 0);
				NON_GTM64_ONLY(*((gtm_long_t *)free_space_pointer) = MV_ON(m1, v) ? (gtm_long_t)mval2i(v) : 0);
				free_space_pointer++;
				break;
			case gtm_ulong_star:
				param_list->arg[i] = free_space_pointer;
				GTM64_ONLY(*((gtm_uint64_t *)free_space_pointer) = MV_ON(m1, v) ? (gtm_uint64_t)mval2ui8(v) : 0);
				NON_GTM64_ONLY(*((gtm_ulong_t *)free_space_pointer) = MV_ON(m1, v) ? (gtm_ulong_t)mval2ui(v) : 0);
				free_space_pointer++;
				break;
			case gtm_string_star:
				param_list->arg[i] = free_space_pointer;
				if (MASK_BIT_ON(m1))
				{	/* If this is defined and input-enabled, it should have already been forced to string. */
					assert(!MV_DEFINED(v) || MV_IS_STRING(v));
					if (MV_DEFINED(v) && v->str.len)
					{
						*free_space_pointer++ = (gtm_long_t)v->str.len;
						*(char **)free_space_pointer = (char *)free_string_pointer;
						memcpy(free_string_pointer, v->str.addr, v->str.len);
						free_string_pointer += v->str.len;
						free_space_pointer++;
					} else
					{
						*free_space_pointer++ = 0;
						*free_space_pointer++ = 0;	/* Effectively a NULL pointer. */
					}
				} else if (0 < pre_alloc_size)
				{
					*free_space_pointer++ = (gtm_long_t)pre_alloc_size;
					*(char **)free_space_pointer = (char *)free_string_pointer;
					*free_string_pointer = '\0';
					free_space_pointer++;
					free_string_pointer += pre_alloc_size;
				} else /* Output and no pre-allocation specified */
				{
					if (0 == package->str.len)
						/* Default package - do not display package name */
						rts_error_csa(CSA_ARG(NULL) VARLSTCNT(7) ERR_ZCNOPREALLOUTPAR, 5, i + 1,
							  RTS_ERROR_LITERAL("<DEFAULT>"),
							  extref->str.len, extref->str.addr);
					else
						rts_error_csa(CSA_ARG(NULL) VARLSTCNT(7) ERR_ZCNOPREALLOUTPAR, 5, i + 1,
							  package->str.len, package->str.addr,
							  extref->str.len, extref->str.addr);
				}
				break;
			case gtm_float_star:
				param_list->arg[i] = free_space_pointer;
				*((float *)free_space_pointer) = MV_ON(m1, v) ? (float)mval2double(v) : (float)0.0;
				free_space_pointer++;
				break;
			case gtm_double_star:
				/* Only need to do this rounding on non-64 it platforms because this one type has a 64 bit
				 * alignment requirement on those platforms.
				 */
				NON_GTM64_ONLY(free_space_pointer = (gtm_long_t *)(ROUND_UP2(((INTPTR_T)free_space_pointer),
											    SIZEOF(double))));
				param_list->arg[i] = free_space_pointer;
				*((double *)free_space_pointer) = MV_ON(m1, v) ? (double)mval2double(v) : 0.0;
				free_space_pointer += (SIZEOF(double) / SIZEOF(gtm_long_t));
				break;
			case gtm_pointertofunc:
				callintogtm_vectorindex = MV_DEFINED(v) ? (int4)mval2i(v) : 0;
				if ((callintogtm_vectorindex >= gtmfunc_unknown_function) || (callintogtm_vectorindex < 0))
				{
					rts_error_csa(CSA_ARG(NULL) VARLSTCNT(7) ERR_ZCVECTORINDX, 1, callintogtm_vectorindex,
						ERR_TEXT, 2, RTS_ERROR_TEXT("Passing Null vector"));
					param_list->arg[i] = 0;
				} else
					param_list->arg[i] = (void *)callintogtm_vectortable[callintogtm_vectorindex];
				break;
			case gtm_pointertofunc_star:
				/* Cannot pass in a function address to be modified by the user program */
				free_space_pointer = (gtm_long_t *)ROUND_UP2(((INTPTR_T)free_space_pointer), SIZEOF(INTPTR_T));
				param_list->arg[i] = free_space_pointer;
				*((INTPTR_T *)free_space_pointer) = 0;
				free_space_pointer++;
				break;
			default:
				va_end(var);
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
				break;
		}
	}
	assert((char *)free_space_pointer <= free_string_pointer_start);
	va_end(var);
	param_list->n = argcnt;
	save_mumps_status = mumps_status; /* Save mumps_status as a callin from external call may change it */
	status = callg((callgfnptr)entry_ptr->fcn, param_list);
	mumps_status = save_mumps_status;

	/* Exit from the residual call-in environment(SFF_CI and base frames) which might
	 * still exist on M stack when the externally called function in turn called
	 * into an M routine.
	 */
	if (frame_pointer->flags & SFF_CI)
		ci_ret_code_quit();
	/* NOTE: ADD RETURN STATUS CALCUATIONS HERE */
	/* Compute space requirement for return values */
	n = 0;
	VAR_START(var, argcnt);
	for (i = 0, m1 = mask & entry_ptr->output_mask; i < argcnt; i++, m1 = m1 >> 1)
	{
		v = va_arg(var, mval *);
		if (MASK_BIT_ON(m1))
			n += extarg_getsize(param_list->arg[i], entry_ptr->parms[i], v);
	}
	va_end(var);
	if (dst)
		n += extarg_getsize((void *)&status, gtm_status, dst);
	ENSURE_STP_FREE_SPACE(n);
	/* Convert return values */
	VAR_START(var, argcnt);
	for (i = 0, m1 = mask & entry_ptr->output_mask; i < argcnt; i++, m1 = m1 >> 1)
	{
		v = va_arg(var, mval *);
		if (MASK_BIT_ON(m1))
			extarg2mval((void *)param_list->arg[i], entry_ptr->parms[i], v, FALSE, TRUE);
	}
	va_end(var);
	if (dst)
	{
		if (entry_ptr->return_type != gtm_void)
			extarg2mval((void *)status, entry_ptr->return_type, dst, FALSE, FALSE);
		else
		{
			memcpy(str_buffer, PACKAGE_ENV_PREFIX, SIZEOF(PACKAGE_ENV_PREFIX));
			tmp_buff_ptr = &str_buffer[SIZEOF(PACKAGE_ENV_PREFIX) - 1];
			if (package->str.len)
			{
				assert(package->str.len < MAX_NAME_LENGTH - SIZEOF(PACKAGE_ENV_PREFIX) - 1);
				*tmp_buff_ptr++ = '_';
				memcpy(tmp_buff_ptr, package->str.addr, package->str.len);
				tmp_buff_ptr += package->str.len;
			}
			*tmp_buff_ptr = '\0';
			xtrnl_table_name = GETENV(str_buffer);
			if (NULL == xtrnl_table_name)
			{	/* Environment variable for the package not found. This part of code is for more safety.
				 * We should not come into this path at all.
				 */
				rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_ZCCTENV, 2, LEN_AND_STR(str_buffer));
			}
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(6) ERR_XCVOIDRET, 4,
				  LEN_AND_STR(entry_ptr->call_name.addr), LEN_AND_STR(xtrnl_table_name));
		}
	}
	free(param_list);
	check_for_timer_pops();
	return;
}