void	op_indpat(mval *v, mval *dst)
{
	bool		rval;
	mstr		*obj, object;
	oprtype		x;
	error_def(ERR_INDMAXNEST);

	MV_FORCE_STR(v);
	if (!(obj = cache_get(indir_pattern, &v->str)))
	{
		comp_init(&v->str);
		source_column = 1;	/* to coordinate with scanner redirection*/
		rval = compile_pattern(&x,window_token == TK_ATSIGN);
		if (comp_fini(rval, &object, OC_IRETMVAL, &x, v->str.len))
		{
			cache_put(indir_pattern, &v->str, &object);
			*ind_result_sp++ = dst;
			if (ind_result_sp >= ind_result_top)
				rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
			comp_indr(&object);
		}
	}
	else
	{
		*ind_result_sp++ = dst;
		if (ind_result_sp >= ind_result_top)
			rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
		comp_indr(obj);
	}
}

int gtmsource_comm_init(void)
{
	/* Initialize communication stuff */
	struct	linger	disable_linger = {0, 0};
	char	error_string[1024];
	int	err_status;

	if (FD_INVALID != gtmsource_sock_fd) /* Initialization done already */
		return(0);

	/* Create the socket used for communicating with secondary */
	if (FD_INVALID == (gtmsource_sock_fd = socket(AF_INET, SOCK_STREAM, 0)))
	{
		err_status = ERRNO;
		SNPRINTF(error_string, SIZEOF(error_string), "Error with source server socket create : %s", STRERROR(err_status));
		rts_error(VARLSTCNT(6) ERR_REPLCOMM, 0, ERR_TEXT, 2, RTS_ERROR_STRING(error_string));
		return(-1);
	}

	/* A connection breakage should get rid of the socket */
	if (-1 == setsockopt(gtmsource_sock_fd, SOL_SOCKET, SO_LINGER, (const void *)&disable_linger, SIZEOF(disable_linger)))
	{
		err_status = ERRNO;
		SNPRINTF(error_string, SIZEOF(error_string), "Error with source server socket disable linger : %s",
				STRERROR(err_status));
		rts_error(VARLSTCNT(6) ERR_REPLCOMM, 0, ERR_TEXT, 2, RTS_ERROR_STRING(error_string));
	}
	return(0);
}

/* For routine name given, return routine header address if rhd not already set */
rhdtyp	*op_rhdaddr(mval *name, rhdtyp *rhd)
{
	mval		routine;
	mident_fixed	routname;
	rhdtyp		*answer;

	if (NULL != rhd)
		answer = rhd;
	else
	{
		MV_FORCE_STR(name);
		routine = *name;
		routine.str.len = (MAX_MIDENT_LEN < routine.str.len ? MAX_MIDENT_LEN : routine.str.len);
		memcpy(&routname.c[0], routine.str.addr, routine.str.len);
		routine.str.addr = (char *)&routname.c[0];
		if ((NULL == rtn_names) || (NULL == (answer = find_rtn_hdr(&routine.str))))	/* Note assignment */
		{	/* Initial check for rtn_names is so we avoid the call to find_rtn_hdr() if we have just
			 * unlinked all modules as find_rtn_hdr() does not deal well with an empty rtn table.
			 */
			op_zlink(&routine, NULL);
			answer = find_rtn_hdr(&routine.str);
			if (NULL == answer)
				rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, name->str.len, name->str.addr,
					ERR_ZLMODULE, 2, strlen(&zlink_mname.c[0]), &zlink_mname);
#			if defined (__alpha) && defined (__vms)
			answer = answer->linkage_ptr;
			if (NULL == answer)
				rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, name->str.len, name->str.addr,
					ERR_ZLMODULE, 2, strlen(&zlink_mname.c[0]), zlink_mname.c);
#			endif
		}
	}
	return answer;
}

void copy_stack_frame(void)
{
	register stack_frame *sf;
	unsigned char	*msp_save;

	msp_save = msp;
	sf = (stack_frame *) (msp -= SIZEOF(stack_frame));
	if (msp <= stackwarn)
	{
		if (msp <= stacktop)
		{
			msp = msp_save;
			rts_error(VARLSTCNT(1) ERR_STACKOFLOW);
		} else
			rts_error(VARLSTCNT(1) ERR_STACKCRIT);
	}
	assert(msp < stackbase);
	assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
	*sf = *frame_pointer;
	sf->old_frame_pointer = frame_pointer;
	sf->flags = 0;		/* Don't propagate special flags */
	sf->for_ctrl_stack = NULL;
	frame_pointer = sf;
	DBGEHND((stderr, "copy_stack_frame: Added stackframe at addr 0x"lvaddr"  old-msp: 0x"lvaddr"  new-msp: 0x"lvaddr"\n",
		 sf, msp_save, msp));
	assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
}

void ojdefimage (mstr *image)
{
	static mstr imagebuf = {0, 0};
	int4 status;
	unsigned char local_buff[MAX_FILSPC_LEN];
	short iosb[4];
	unsigned short length;
	struct
	{
		item_list_3	le[1];
		int4		terminator;
	}		item_list;

	if (!imagebuf.addr)
	{
		item_list.le[0].buffer_length = MAX_FILSPC_LEN;
		item_list.le[0].item_code = JPI$_IMAGNAME;
		item_list.le[0].buffer_address = local_buff;
		item_list.le[0].return_length_address = &length;
		item_list.terminator = 0;
		status = sys$getjpi (0, 0, 0, &item_list, &iosb[0], 0, 0);
		if (!(status & 1))
			rts_error(VARLSTCNT(1) status);
		sys$synch (efn_immed_wait, &iosb[0]);
		if (!(iosb[0] & 1))
			rts_error(VARLSTCNT(1) iosb[0]);
		imagebuf.addr = malloc(length);
		imagebuf.len = length;
		memcpy(imagebuf.addr, local_buff, length);
	}
	*image = imagebuf;
	return;
}

/* Lookup an external function. Return function address if success, NULL otherwise.
 * package_handle - DLL handle returned by fgn_getpak
 * entry_name - symbol name to be looked up
 * msgtype - message severity of the errors reported if any.
 * Note: If msgtype is SUCCESS, errors are not issued. It is useful if the callers are not
 * interested in message report and not willing to have condition handler overhead (eg. zro_search).
 */
fgnfnc fgn_getrtn(void_ptr_t package_handle, mstr *entry_name, int msgtype)
{
	void_ptr_t	sym_addr;
	char_ptr_t	dummy_err_str;
	void		*short_sym_addr;
	char		err_str[MAX_ERRSTR_LEN]; /* needed as util_out_print doesn't handle 64bit pointers */
	error_def(ERR_DLLNORTN);
	error_def(ERR_TEXT);

	if (!(sym_addr = dlsym(package_handle, entry_name->addr)))
	{
		if (SUCCESS != msgtype)
		{
			assert(!(msgtype & ~SEV_MSK));
			COPY_DLLERR_MSG;
			rts_error(VARLSTCNT(8) MAKE_MSG_TYPE(ERR_DLLNORTN, msgtype), 2, LEN_AND_STR(entry_name->addr),
				ERR_TEXT, 2, LEN_AND_STR(err_str));
		}
	} else
	{  /* Tru64 - dlsym() is bound to return short pointer because of ld -taso flag used for GT.M */
#ifdef	__osf__
		short_sym_addr = sym_addr;
		if (short_sym_addr != sym_addr)
		{
			sym_addr = NULL;
			/* always report an error irrespective of msgtype - since this code should never
			 * have executed and/or the DLL might need to be rebuilt with 32-bit options */
			rts_error(VARLSTCNT(8) ERR_DLLNORTN, 2, LEN_AND_STR(entry_name->addr),
				ERR_TEXT, 2, LEN_AND_LIT("Symbol is loaded above the lower 31-bit address space"));
		}
#endif
	}
	return (fgnfnc)sym_addr;
}

void op_indfun(mval *v, mint code, mval *dst)
{
	bool		rval;
	mstr		*obj, object;
	oprtype		x;
	unsigned char	argcode;

	error_def(ERR_INDMAXNEST);

	argcode = (unsigned char)code;
	assert(UCHAR_MAX >= code); /* if not, the assignment to argcode is lossy */
	assert(indir_opcode[argcode]);
	MV_FORCE_STR(v);
	if (!(obj = cache_get(argcode, &v->str)))
	{
		comp_init(&v->str);
		rval = (*indir_fcn[argcode])(&x, indir_opcode[argcode]);
		if (!comp_fini(rval, &object, OC_IRETMVAL, &x, v->str.len))
			return;
		cache_put(argcode, &v->str, &object);
		*ind_result_sp++ = dst;
		if (ind_result_sp >= ind_result_top)
			rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
		comp_indr(&object);
		return;
	}
	*ind_result_sp++ = dst;
	if (ind_result_sp >= ind_result_top)
		rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
	comp_indr(obj);
	return;
}

/*
 * ------------------------------------------
 * Hang the process for a specified time.
 *
 *	Goes to sleep for a positive value.
 *	Any caught signal will terminate the sleep
 *	following the execution of that signal's catching routine.
 *
 * Arguments:
 *	num - time to sleep
 *
 * Return:
 *	none
 * ------------------------------------------
 */
void op_hang(mval* num)
{
	int 	ms;
#ifdef VMS
	uint4 	time[2];
	int4	efn_mask, status;
	error_def(ERR_SYSCALL);
#endif
	ms = 0;
	MV_FORCE_NUM(num);
	if (num->mvtype & MV_INT)
	{
		if (0 < num->m[1])
		{
			assert(MV_BIAS >= 1000);	/* if formats change overflow may need attention */
			ms = num->m[1] * (1000 / MV_BIAS);
		}
	} else if (0 == num->sgn) /* if sign is not 0 it means num is negative */
		ms = mval2i(num) * 1000;	/* too big to care about fractional amounts */
	if (ms)
	{
		UNIX_ONLY(hiber_start(ms);)
		VMS_ONLY(
			time[0] = -time_low_ms(ms);
			time[1] = -time_high_ms(ms) - 1;
			efn_mask = (1 << efn_outofband | 1 << efn_timer);
			if (SS$_NORMAL != (status = sys$setimr(efn_timer, &time, NULL, &time, 0)))
				rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$setimr"), CALLFROM, status);
			if (SS$_NORMAL != (status = sys$wflor(efn_outofband, efn_mask)))
				rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$wflor"), CALLFROM, status);
		)
		if (outofband)

void	op_trollback(int rb_levels)		/* rb_levels -> # of transaction levels by which we need to rollback */
{
	short		newlevel;
	tp_region	*tr;
	gd_region	*save_cur_region;	/* saved copy of gv_cur_region before tp_clean_up/tp_incr_clean_up modifies it */
	gd_region	*curreg;
	sgmnt_addrs	*csa;

	error_def(ERR_TLVLZERO);
	error_def(ERR_TROLLBK2DEEP);
	error_def(ERR_INVROLLBKLVL);

	if (0 == dollar_tlevel)
		rts_error(VARLSTCNT(1) ERR_TLVLZERO);
	if (0 > rb_levels && dollar_tlevel < -rb_levels)
		rts_error(VARLSTCNT(4) ERR_TROLLBK2DEEP, 2, -rb_levels, dollar_tlevel);
	else if (dollar_tlevel <= rb_levels)
		rts_error(VARLSTCNT(4) ERR_INVROLLBKLVL, 2, rb_levels, dollar_tlevel);

	newlevel = (0 > rb_levels) ? dollar_tlevel + rb_levels : rb_levels;
	/* The DBG_CHECK_GVTARGET_CSADDRS_IN_SYNC macro is used at various points in the database code to check that
	 * gv_target and cs_addrs are in sync. This is because op_gvname relies on this in order to avoid a gv_bind_name
	 * function call (if incoming key matches gv_currkey from previous call, it uses gv_target and cs_addrs right
	 * away instead of recomputing them). We want to check that here as well. The only exception is if we were
	 * interrupted in the middle of TP transaction by an external signal which resulted in us terminating right away.
	 * In this case, we are guaranteed not to make a call to op_gvname again (because we are exiting) so it is ok
	 * not to do this check.
	 */
	DEBUG_ONLY(
		if (!process_exiting)
		{
			DBG_CHECK_GVTARGET_CSADDRS_IN_SYNC;
		}
	)

void change_fhead_timer(char *timer_name, sm_int_ptr_t timer_address, int default_time, bool zero_is_ok)
/* default_time is in milliseconds */
{
    uint4 		status, value;

    error_def(ERR_TIMRBADVAL);

    default_time = default_time * TIMER_SCALE;
    timer_address[1] = 0;
    status = cli_present((char *)timer_name);
    if (status == CLI_NEGATED)
        timer_address[0] = zero_is_ok ? 0 : default_time;
    else if (status == CLI_PRESENT)
    {
        status = cli_get_time((char *)timer_name, &value);
        if (TRUE == status)
        {
            if ((ONE_HOUR < value) || ((0 == value) && (FALSE == zero_is_ok)))
                rts_error(VARLSTCNT(1) ERR_TIMRBADVAL);
            else	/* the above error is of type GTM-I- */
                timer_address[0] = value;

        } else
            rts_error(VARLSTCNT(1) ERR_TIMRBADVAL);
    }
    return;
}

boolean_t iosocket_listen(io_desc *iod, unsigned short len)
{
	d_socket_struct	*dsocketptr;
	socket_struct	*socketptr;
       	char            *errptr;
        int4            errlen;

  	error_def(ERR_SOCKLISTEN);
        error_def(ERR_TEXT);
	error_def(ERR_LQLENGTHNA);
	error_def(ERR_SOCKACTNA);
	error_def(ERR_CURRSOCKOFR);
	error_def(ERR_LISTENPASSBND);

	if (MAX_LISTEN_QUEUE_LENGTH < len)
	{
		rts_error(VARLSTCNT(3) ERR_LQLENGTHNA, 1, len);
		return FALSE;
	}

	assert(iod->type == gtmsocket);
        dsocketptr = (d_socket_struct *)iod->dev_sp;
	socketptr = dsocketptr->socket[dsocketptr->current_socket];

	if (dsocketptr->current_socket >= dsocketptr->n_socket)
	{
		rts_error(VARLSTCNT(4) ERR_CURRSOCKOFR, 2, dsocketptr->current_socket, dsocketptr->n_socket);
		return FALSE;
	}

	if ((socketptr->state != socket_bound) || (socketptr->passive != TRUE))
	{
		rts_error(VARLSTCNT(1) ERR_LISTENPASSBND);
		return FALSE;
	}

	dsocketptr->dollar_key[0] = '\0';

        /* establish a queue of length len for incoming connections */
        if (-1 == tcp_routines.aa_listen(socketptr->sd, len))
        {
                errptr = (char *)STRERROR(errno);
                errlen = STRLEN(errptr);
                rts_error(VARLSTCNT(6) ERR_SOCKLISTEN, 0, ERR_TEXT, 2, errlen, errptr);
                return FALSE;
        }

	socketptr->state = socket_listening;

	len = sizeof(LISTENING) - 1;
	memcpy(&dsocketptr->dollar_key[0], LISTENING, len);
	dsocketptr->dollar_key[len++] = '|';
	memcpy(&dsocketptr->dollar_key[len], socketptr->handle, socketptr->handle_len);
	len += socketptr->handle_len;
	dsocketptr->dollar_key[len++] = '|';
	SPRINTF(&dsocketptr->dollar_key[len], "%d", socketptr->local.port);

	return TRUE;
}

void	op_indglvn(mval *v,mval *dst)
{
	bool		rval;
	mstr		*obj, object;
	oprtype		x;
	lv_val 		*a;
	icode_str	indir_src;
	lv_val		*lv;
	var_tabent	targ_key;
	ht_ent_mname	*tabent;

	error_def(ERR_INDMAXNEST);
	error_def(ERR_UNDEF);

	MV_FORCE_STR(v);
	indir_src.str = v->str;
	indir_src.code = indir_glvn;
	if (NULL == (obj = cache_get(&indir_src)))
	{
		if (valid_mname(&v->str))
		{
			targ_key.var_name = v->str;
			COMPUTE_HASH_MNAME(&targ_key);
			tabent = lookup_hashtab_mname(&curr_symval->h_symtab, &targ_key);
			assert(NULL == tabent ||  NULL != tabent->value);
			if (!tabent || !MV_DEFINED(&((lv_val *)tabent->value)->v))
			{
				if (undef_inhibit)
				{
					*dst = literal_null;
					return;
				}
				else
					rts_error(VARLSTCNT(4) ERR_UNDEF, 2, v->str.len, v->str.addr);
			}
			a = (lv_val *)tabent->value;
			*dst = a->v;
			return;
		}
		comp_init(&v->str);
		rval = glvn(&x);
		if (comp_fini(rval, &object, OC_IRETMVAL, &x, v->str.len))
		{
			indir_src.str.addr = v->str.addr;
			cache_put(&indir_src, &object);
			*ind_result_sp++ = dst;
			if (ind_result_sp >= ind_result_top)
				rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
			comp_indr(&object);
		}
	}
	else
	{
		*ind_result_sp++ = dst;
		if (ind_result_sp >= ind_result_top)
			rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
		comp_indr(obj);
	}
}

void	comp_indr (mstr *obj)
{
	stack_frame	*sf;
	unsigned char	*fix, *fix_base, *tmps, *syms, *save_msp;
	int		tempsz, vartabsz, fixup_cnt;
	INTPTR_T	*vp;
	ihdtyp		*rtnhdr;
	error_def(ERR_STACKOFLOW);
	error_def(ERR_STACKCRIT);

	save_msp = msp;
	sf = (stack_frame *)(msp -= sizeof(stack_frame));
	rtnhdr = (ihdtyp *)obj->addr;

	/* Check that our cache_entry pointer is in proper alignment with us */
	assert(rtnhdr->indce->obj.addr == (char *)rtnhdr);

	tempsz = ROUND_UP2(rtnhdr->temp_size, SIZEOF(char *));
	tmps = msp -= tempsz;
	vartabsz = rtnhdr->vartab_len;
	vartabsz *= sizeof(mval *);
	/* Check that our vars and friends can fit on this stack */
	if ((msp -= vartabsz) <= stackwarn)
	{
		if (msp <= stacktop)
		{
			msp  = save_msp;
			rts_error(VARLSTCNT(1) ERR_STACKOFLOW);
		}
		else
			rts_error(VARLSTCNT(1) ERR_STACKCRIT);
	}
	syms = msp;

	*sf = *frame_pointer;
	sf->old_frame_pointer = frame_pointer;
	sf->type = 0;
	sf->temps_ptr = tmps;
	if (tempsz)
		memset(tmps, 0, tempsz);
	sf->l_symtab = (mval **)syms;
	sf->vartab_len = rtnhdr->vartab_len;
	if (vartabsz)
		memset(syms, 0, vartabsz);

	sf->vartab_ptr = (char *)rtnhdr + rtnhdr->vartab_off;
	sf->temp_mvals = rtnhdr->temp_mvals;
	/* Code starts just past the literals that were fixed up and past the validation and hdr offset fields */
	sf->mpc = (unsigned char *)rtnhdr + rtnhdr->fixup_vals_off + (rtnhdr->fixup_vals_num * sizeof(mval));
        GTM64_ONLY(sf->mpc  = (unsigned char *)ROUND_UP2((UINTPTR_T)sf->mpc, SECTION_ALIGN_BOUNDARY));
	sf->mpc = sf->mpc + (2 * sizeof(INTPTR_T)); /*Account for hdroffset and MAGIC_VALUE*/
	sf->flags = SFF_INDCE;		/* We will be needing cleanup for this frame */
	DEBUG_ONLY(
		vp = (INTPTR_T *)sf->mpc;
		vp--;
		assert((GTM_OMAGIC << 16) + OBJ_LABEL == *vp);
		vp--;
		assert((unsigned char*)rtnhdr == (unsigned char *)vp + *vp);
	);

int gtm_init()
{
	rhdtyp          	*base_addr;
	unsigned char   	*transfer_addr;
	error_def(ERR_CITPNESTED);
	error_def(ERR_CIMAXLEVELS);

	if (!gtm_startup_active)
	{ /* call-in invoked from C as base. GT.M hasn't been started up yet. */
		image_type = GTM_IMAGE;
		gtm_env_init();	/* read in all environment variables */
		err_init(stop_image_conditional_core);
		cli_lex_setup(0, NULL);
		/* Initialize msp to the maximum so if errors occur during GT.M startup below,
		 * the unwind logic in gtmci_ch() will get rid of the whole stack. */
		msp = (unsigned char*)-1;
	}
	ESTABLISH_RET(gtmci_ch, mumps_status);
	if (!gtm_startup_active)
	{ /* GT.M is not active yet. Create GT.M startup environment */
		invocation_mode = MUMPS_CALLIN;
		init_gtm();
		gtm_savetraps(); /* nullify default $ZTRAP handling */
		assert(gtm_startup_active);
		assert(frame_pointer->flags & SFF_CI);
		nested_level = 1;
	}
	else if (!(frame_pointer->flags & SFF_CI))
	{ /* Nested call-in: setup a new CI environment (SFF_CI frame on top of base-frame) */
		/* Mark the beginning of the new stack so that initialization errors in
		 * call-in frame do not unwind entries of the previous stack (see gtmci_ch).*/
		fgncal_stack = msp;
		/* Report if condition handlers stack may overrun during this callin level.
		 * Every underlying level can not have more than 2 active condition handlers,
		 * plus extra MAX_HANDLERS are reserved for this level. */
		if (chnd_end - ctxt <= MAX_HANDLERS)
			rts_error(VARLSTCNT(3) ERR_CIMAXLEVELS, 1, nested_level);
		/* Disallow call-ins within a TP boundary since TP restarts are not supported
		 * currently across nested call-ins. When we implement TP restarts across call-ins,
		 * this error needs be changed to a Warning or Notification */
		if (0 < dollar_tlevel)
			rts_error(VARLSTCNT(1) ERR_CITPNESTED);
		base_addr = make_cimode();
		transfer_addr = PTEXT_ADR(base_addr);
		gtm_init_env(base_addr, transfer_addr);
		SET_CI_ENV(ci_ret_code_exit);
		gtmci_isv_save();
		nested_level++;
	}
	/* Now that GT.M is initialized. Mark the new stack pointer (msp) so that errors
	 * while executing an M routine do not unwind stack below this mark. It important that
	 * the call-in frames (SFF_CI), that hold nesting information (eg. $ECODE/$STACK data
	 * of the previous stack), are kept from being unwound. */
	fgncal_stack = msp;
	REVERT;
	return 0;
}

void comp_indr(mstr *obj)
{
	stack_frame	*sf;
	unsigned char	*fix, *fix_base, *tmps, *syms, *save_msp;
	int		tempsz, vartabsz, fixup_cnt, zapsz;
	INTPTR_T	*vp;
	ihdtyp		*rtnhdr;

	assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
	save_msp = msp;
	sf = (stack_frame *)(msp -= SIZEOF(stack_frame));
	rtnhdr = (ihdtyp *)obj->addr;
	/* Check that our cache_entry pointer is in proper alignment with us */
	assert(rtnhdr->indce->obj.addr == (char *)rtnhdr);
	tempsz = ROUND_UP2(rtnhdr->temp_size, SIZEOF(char *));
	tmps = msp -= tempsz;
	vartabsz = rtnhdr->vartab_len;
	vartabsz *= SIZEOF(ht_ent_mname *);
	/* Check that our vars and friends can fit on this stack */
	if ((msp -= vartabsz) <= stackwarn)
	{
		if (msp <= stacktop)
		{
			msp = save_msp;
			rts_error(VARLSTCNT(1) ERR_STACKOFLOW);
		} else
			rts_error(VARLSTCNT(1) ERR_STACKCRIT);
	}
	syms = msp;
	*sf = *frame_pointer;
	sf->old_frame_pointer = frame_pointer;
	sf->type = 0;
	sf->temps_ptr = tmps;
	sf->l_symtab = (ht_ent_mname **)syms;
	sf->vartab_len = rtnhdr->vartab_len;
	if (zapsz = (vartabsz + tempsz))	/* Note assignment */
		memset(syms, 0, zapsz);		/* Zap temps and symtab together */
	sf->vartab_ptr = (char *)rtnhdr + rtnhdr->vartab_off;
	sf->temp_mvals = rtnhdr->temp_mvals;
	/* Code starts just past the literals that were fixed up and past the validation and hdr offset fields */
	sf->mpc = (unsigned char *)rtnhdr + rtnhdr->fixup_vals_off + (rtnhdr->fixup_vals_num * SIZEOF(mval));
	/* IA64 required SECTION_ALIGN_BOUNDARY alignment (16 bytes). ABS 2008/12
	 * This has been carried forward to other 64bit platfoms without problems
	 */
        GTM64_ONLY(sf->mpc = (unsigned char *)ROUND_UP2((UINTPTR_T)sf->mpc, SECTION_ALIGN_BOUNDARY));
	sf->mpc = sf->mpc + (2 * SIZEOF(INTPTR_T)); /* Account for hdroffset and MAGIC_VALUE */
	sf->flags = SFF_INDCE;		/* We will be needing cleanup for this frame */
	sf->ret_value = NULL;
	sf->dollar_test = -1;		/* initialize it with -1 for indication of not yet being used */
	DEBUG_ONLY(
		vp = (INTPTR_T *)sf->mpc;
		assert(NULL != vp);
		vp--;
		assert((GTM_OMAGIC << 16) + OBJ_LABEL == *vp);
		vp--;
		assert((unsigned char*)rtnhdr == (unsigned char *)vp + *vp);
	);

void	op_indlvarg(mval *v, mval *dst)
{
	bool		rval;
	mstr		*obj, object;
	oprtype		x;
	triple		*ref;
	icode_str	indir_src;

	error_def(ERR_INDMAXNEST);
	error_def(ERR_VAREXPECTED);

	MV_FORCE_STR(v);
	if (v->str.len < 1)
		rts_error(VARLSTCNT(1) ERR_VAREXPECTED);
	if (valid_mname(&v->str))
	{
		*dst = *v;
		dst->mvtype &= ~MV_ALIASCONT;	/* Make sure alias container property does not pass */
		return;
	}
	if (*v->str.addr == '@')
	{
		indir_src.str = v->str;
		indir_src.code = indir_lvarg;
		if (NULL == (obj = cache_get(&indir_src)))
		{
			object.addr = v->str.addr;
			object.len  = v->str.len;
			comp_init(&object);
			if (rval = indirection(&x))
			{
				ref = newtriple(OC_INDLVARG);
				ref->operand[0] = x;
				x = put_tref(ref);
			}
			if (comp_fini(rval, &object, OC_IRETMVAL, &x, object.len))
			{
				indir_src.str.addr = v->str.addr;
				cache_put(&indir_src, &object);
				*ind_result_sp++ = dst;
				if (ind_result_sp >= ind_result_top)
					rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
				comp_indr(&object);
				return;
			}
		} else
		{
			*ind_result_sp++ = dst;
			if (ind_result_sp >= ind_result_top)
				rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
			comp_indr(obj);
			return;
		}
	}
	rts_error(VARLSTCNT(1) ERR_VAREXPECTED);
}

/* this has to be maintained in parallel with unw_retarg(), the unwind with a return argument (extrinisic quit) routine */
void op_unwind(void)
{
	mv_stent 	*mvc;

	error_def(ERR_STACKUNDERFLO);
	error_def(ERR_TPQUIT);

	if (tp_pointer && tp_pointer->fp <= frame_pointer)
		rts_error(VARLSTCNT(1) ERR_TPQUIT);
	/* Note that error_ret() should be invoked only after the rts_error() of TPQUIT.
	 * This is so the TPQUIT error gets noted down in $ECODE (which will not happen if error_ret() is called before).
	 */
	if (!skip_error_ret)
	{
		INVOKE_ERROR_RET_IF_NEEDED;
	} else
	{
		if (NULL != error_frame)
		{
			assert(error_frame >= frame_pointer);
			if (error_frame <= frame_pointer)
				NULLIFY_ERROR_FRAME;	/* ZGOTO to frame level lower than primary error level cancels error mode */
		}
		skip_error_ret = FALSE;	/* reset at the earliest point although caller (goframes()) does reset it just in
					 * case an error occurs before we return to the caller */
	}
	assert(msp <= stackbase && msp > stacktop);
	assert(mv_chain <= (mv_stent *)stackbase && mv_chain > (mv_stent *)stacktop);
	assert(frame_pointer <= (stack_frame*)stackbase && frame_pointer > (stack_frame *)stacktop);

	/* See if unwinding an indirect frame */
	IF_INDR_FRAME_CLEANUP_CACHE_ENTRY(frame_pointer);

	for (mvc = mv_chain; mvc < (mv_stent *)frame_pointer; )
	{
		unw_mv_ent(mvc);
		mvc = (mv_stent *)(mvc->mv_st_next + (char *)mvc);
	}
	if (is_tracing_on)
		(*unw_prof_frame_ptr)();
	mv_chain = mvc;
	msp = (unsigned char *)frame_pointer + sizeof(stack_frame);
	if (msp > stackbase)
		rts_error(VARLSTCNT(1) ERR_STACKUNDERFLO);
	frame_pointer = frame_pointer->old_frame_pointer;
	if (NULL != zyerr_frame && frame_pointer > zyerr_frame)
		zyerr_frame = NULL;
	if (frame_pointer)
	{
		if (frame_pointer < (stack_frame *)msp || frame_pointer > (stack_frame *)stackbase ||
				frame_pointer < (stack_frame *)stacktop)
			rts_error(VARLSTCNT(1) ERR_STACKUNDERFLO);
	}
	return;
}

/* returns the truth value based on the sense indicated by 'negate'.
 * If negate is FALSE (i.e. in regular mode),
 * 	returns TRUE if the env variable/logical log is defined and evaluates to "TRUE" (or part thereof),
 * 	or "YES" (or part thereof), or a non zero integer
 * 	returns FALSE otherwise
 * If negate is TRUE(i.e. in negative mode),
 * 	returns TRUE if the env variable/logical log is defined and evaluates to "FALSE" (or part thereof),
 * 	or "NO" (or part thereof), or a zero integer
 * 	returns FALSE otherwise
 */
boolean_t logical_truth_value(mstr *log, boolean_t negate, boolean_t *is_defined)
{
	int4		status;
	mstr		tn;
	char		buf[1024];
	boolean_t	zero, is_num;
	int		index;

	error_def(ERR_LOGTOOLONG);
	error_def(ERR_TRNLOGFAIL);

	tn.addr = buf;
	if (NULL != is_defined)
		*is_defined = FALSE;
	if (SS_NORMAL == (status = TRANS_LOG_NAME(log, &tn, buf, SIZEOF(buf), dont_sendmsg_on_log2long)))
	{
		if (NULL != is_defined)
			*is_defined = TRUE;
		if (tn.len <= 0)
			return FALSE;
		for (is_num = TRUE, zero = TRUE, index = 0; index < tn.len; index++)
		{
			if (!ISDIGIT_ASCII(buf[index]))
			{
				is_num = FALSE;
				break;
			}
			zero = (zero && ('0' == buf[index]));
		}
		if (!negate)
		{ /* regular mode */
			return (!is_num ? (0 == STRNCASECMP(buf, LOGICAL_TRUE, MIN(STR_LIT_LEN(LOGICAL_TRUE), tn.len)) ||
		    		   0 == STRNCASECMP(buf, LOGICAL_YES, MIN(STR_LIT_LEN(LOGICAL_YES), tn.len)))
				: !zero);
		} else
		{ /* negative mode */
			return (!is_num ? (0 == STRNCASECMP(buf, LOGICAL_FALSE, MIN(STR_LIT_LEN(LOGICAL_FALSE), tn.len)) ||
		    		   0 == STRNCASECMP(buf, LOGICAL_NO, MIN(STR_LIT_LEN(LOGICAL_NO), tn.len)))
				: zero);
		}
	} else if (SS_NOLOGNAM == status)
		return (FALSE);
#	ifdef UNIX
	else if (SS_LOG2LONG == status)
	{
		rts_error(VARLSTCNT(5) ERR_LOGTOOLONG, 3, log->len, log->addr, SIZEOF(buf) - 1);
		return (FALSE);
	}
#	endif
	else
	{
		rts_error(VARLSTCNT(5) ERR_TRNLOGFAIL, 2, log->len, log->addr, status);
		return (FALSE);
	}
}

/* Routine to:
 *   (1) To turn off the MV_RETARG flag in the mval returned from the M function call.
 *   (2) To verify the flag was ON in the first place, else this is not a return value.
 *   (3) To verify the MV_ALIASCONT flag IS on which would signify a QUIT * was done.
 *       To not do this constitutes an error and means QUIT * was NOT done as is
 *       required to create an alias on the caller side.
 */
void op_exfunretals(mval *retval)
{
	unsigned short	savtyp;

	savtyp = retval->mvtype;
	retval->mvtype &= ~MV_RETARG;
	if (0 == (MV_RETARG & savtyp))
		rts_error(VARLSTCNT(1) ERR_QUITARGREQD);
	if (0 == (MV_ALIASCONT & savtyp))
		rts_error(VARLSTCNT(1) ERR_ALIASEXPECTED);
	assert(NULL != alias_retarg);
}

void new_stack_frame(rhdtyp *rtn_base, unsigned char *context, unsigned char *transfer_addr)
{
	register stack_frame 	*sf;
	unsigned char		*msp_save;
	unsigned int		x1, x2;

	assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
	msp_save = msp;
	sf = (stack_frame *)(msp -= SIZEOF(stack_frame));
	if (msp <= stackwarn)
	{
		if (msp <= stacktop)
		{
			msp = msp_save;
			rts_error(VARLSTCNT(1) ERR_STACKOFLOW);
		} else
			rts_error(VARLSTCNT(1) ERR_STACKCRIT);
	}
	assert((unsigned char *)msp < stackbase);
	sf->old_frame_pointer = frame_pointer;
	sf->rvector = rtn_base;
	sf->vartab_ptr = (char *)VARTAB_ADR(rtn_base);
	sf->vartab_len = sf->rvector->vartab_len;
	sf->ctxt = context;
	sf->mpc = transfer_addr;
	sf->flags = 0;
	sf->for_ctrl_stack = NULL;
#ifdef HAS_LITERAL_SECT
	sf->literal_ptr = (int4 *)LITERAL_ADR(rtn_base);
#endif
	sf->temp_mvals = sf->rvector->temp_mvals;
	msp -= x1 = rtn_base->temp_size;
	sf->temps_ptr = msp;
	sf->type = SFT_COUNT;
	msp -= x2 = rtn_base->vartab_len * SIZEOF(ht_ent_mname *);
	sf->l_symtab = (ht_ent_mname **)msp;
	if (msp <= stackwarn)
	{
		if (msp <= stacktop)
		{
			msp = msp_save;
			rts_error(VARLSTCNT(1) ERR_STACKOFLOW);
		} else
			rts_error(VARLSTCNT(1) ERR_STACKCRIT);
	}
	assert(msp < stackbase);
	memset(msp, 0, x1 + x2);
	frame_pointer = sf;
	assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
	DBGEHND((stderr, "new_stack_frame: Added stackframe at addr 0x"lvaddr"  old-msp: 0x"lvaddr"  new-msp: 0x"lvaddr"\n",
		 sf, msp_save, msp));
	return;
}