Пример #1
0
void	gvzwrite_clnup(void)
{
	gv_key		*old;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	gv_cur_region = gvzwrite_block->gd_reg;
	change_reg();
	assert(reset_gv_target == ((gv_namehead *)gvzwrite_block->old_targ));
	if (NULL != gvzwrite_block->old_key)
	{
		old = (gv_key *)gvzwrite_block->old_key;
		memcpy(&gv_currkey->base[0], &old->base[0], old->end + 1);
		gv_currkey->end = old->end;
		gv_currkey->prev = old->prev;
		gd_map = gvzwrite_block->old_map;
		gd_map_top = gvzwrite_block->old_map_top;
		free(gvzwrite_block->old_key);
		gvzwrite_block->old_key = gvzwrite_block->old_targ = (unsigned char *)NULL;
		gvzwrite_block->subsc_count = 0;
		TREF(gv_last_subsc_null) = gvzwrite_block->gv_last_subsc_null;
		TREF(gv_some_subsc_null) = gvzwrite_block->gv_some_subsc_null;
	}
	RESET_GV_TARGET(DO_GVT_GVKEY_CHECK);
}
Пример #2
0
int f_zparse(oprtype *a, opctype op)
{
	boolean_t	again;
	int		i;
	triple		*last, *r, *ref;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	last = r = maketriple(op);
	if (EXPR_FAIL == expr(&(r->operand[0]), MUMPS_STR))
		return FALSE;
	again = TRUE;
	for (i = 0; i < 4 ;i++)
	{
		ref = newtriple(OC_PARAMETER);
		last->operand[1] = put_tref(ref);
		if (again && TK_COMMA == TREF(window_token))
		{
			advancewindow();
			if (TK_COMMA == TREF(window_token))
				ref->operand[0] = put_str("", 0);
			else if (EXPR_FAIL == expr(&ref->operand[0], MUMPS_STR))
				return FALSE;
		} else
		{
			again = FALSE;
			ref->operand[0] = put_str("", 0);
		}
		last = ref;
	}
	ins_triple(r);
	*a = put_tref(r);
	return TRUE;
}
Пример #3
0
int linetail(void)
{
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	for (;;)
	{
		while (TK_SPACE == TREF(window_token))
			advancewindow();
		if (TK_EOL == TREF(window_token))
			return TRUE;
		if (!cmd())
		{
			if (OC_RTERROR != (TREF(curtchain))->exorder.bl->exorder.bl->exorder.bl->opcode)
			{	/* If rterror is last triple generated (has two args), then error already raised */
				TREF(source_error_found) ? stx_error(TREF(source_error_found)) : stx_error(ERR_CMD);
			}
			assert((TREF(curtchain))->exorder.bl->exorder.fl == TREF(curtchain));
			assert(TREF(source_error_found));
			return FALSE;
		}
		if ((TK_SPACE != TREF(window_token)) && (TK_EOL != TREF(window_token)))
		{
			stx_error(ERR_SPOREOL);
			return FALSE;
		}
	}
}
Пример #4
0
void mupip_rctldump(void)
{
#	ifdef AUTORELINK_SUPPORTED
	unsigned short		max_len;
	mstr			dir;
	char			objdir[GTM_PATH_MAX];
	open_relinkctl_sgm	*linkctl;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (TREF(parms_cnt))
	{
		assert(1 == TREF(parms_cnt));
		max_len = SIZEOF(objdir);
		if (!cli_get_str("DIRECTORY", objdir, &max_len))
			rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MUPCLIERR);
		dir.addr = objdir;
		dir.len = max_len;
		linkctl = relinkctl_attach(&dir);
		assert(linkctl == TREF(open_relinkctl_list));
		assert((NULL == linkctl) || (NULL == linkctl->next));
	} else
		zro_init();
	util_out_print("", RESET);	/* Reset output buffer */
	zshow_rctldump(NULL);		/* callee knows caller is mupip_rctldump type based on the NULL parameter */
#	endif	/* AUTORELINK_SUPPORTED */
}
Пример #5
0
void util_spawn(void)
{
	char *cmd;
	int  rc;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	assert(1 >= TREF(parms_cnt));
	if (0 == TREF(parms_cnt))
	{
		cmd = GETENV("SHELL");
		if (!cmd)
			cmd = "/bin/sh";
		rc = SYSTEM(cmd);
		if (-1 == rc)
			PERROR("system : ");
	} else
	{
		assert(TAREF1(parm_ary, TREF(parms_cnt) - 1));
		assert((char *)-1L != (TAREF1(parm_ary, TREF(parms_cnt) - 1)));
		rc = SYSTEM((TAREF1(parm_ary, TREF(parms_cnt) - 1)));
		if (-1 == rc)
			PERROR("system : ");
	}
}
Пример #6
0
int m_zattach(void)
{
	oprtype	x;
	triple	*triptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if ((TK_EOL == TREF(window_token)) || (TK_SPACE == TREF(window_token)))
	{
		triptr = newtriple(OC_ZATTACH);
		triptr->operand[0] = put_str("",0);
		return TRUE;
	}
	else
	{
		switch (expr(&x, MUMPS_STR))
		{
		case EXPR_FAIL:
			return FALSE;
		case EXPR_GOOD:
			triptr = newtriple(OC_ZATTACH);
			triptr->operand[0] = x;
			return TRUE;
		case EXPR_INDR:
			make_commarg(&x,indir_zattach);
			return TRUE;
		}
	}
	return FALSE; /* This should never get executed, added to make compiler happy */
}
Пример #7
0
int f_fnumber(oprtype *a, opctype op)
{
	triple	*r, *ref, *ref1;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	r = maketriple(op);
	if (EXPR_FAIL == expr(&r->operand[0], MUMPS_NUM))
		return FALSE;
	if (TK_COMMA != TREF(window_token))
	{
		stx_error(ERR_COMMA);
		return FALSE;
	}
	advancewindow();
	ref = newtriple(OC_PARAMETER);
	r->operand[1] = put_tref(ref);
	if (EXPR_FAIL == expr(&ref->operand[0], MUMPS_STR))
		return FALSE;
	ref1 = newtriple(OC_PARAMETER);
	ref->operand[1] = put_tref(ref1);
	if (TK_COMMA == TREF(window_token))
	{
		advancewindow();
		if (EXPR_FAIL == expr(&ref1->operand[1], MUMPS_INT))
			return FALSE;
		ref1->operand[0] = put_ilit((mint)(1));				/* flag that the 3rd argument is real */
	} else
		ref1->operand[0] = ref1->operand[1] = put_ilit((mint)0);	/* flag no 3rd argument and give it default value */
	ins_triple(r);
	*a = put_tref(r);
	return TRUE;
}
Пример #8
0
int f_find(oprtype *a, opctype op)
{
	triple *delimiter, *r, *start;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	r = maketriple(op);
	if (EXPR_FAIL == expr(&(r->operand[0]), MUMPS_STR))
		return FALSE;
	if (TK_COMMA != TREF(window_token))
	{
		stx_error(ERR_COMMA);
		return FALSE;
	}
	advancewindow();
	delimiter = newtriple(OC_PARAMETER);
	start = newtriple(OC_PARAMETER);
	r->operand[1] = put_tref(delimiter);
	delimiter->operand[1] = put_tref(start);
	if (EXPR_FAIL == expr(&(delimiter->operand[0]), MUMPS_STR))
		return FALSE;
	if (TK_COMMA != TREF(window_token))
		start->operand[0] = put_ilit(1);
	else
	{
		advancewindow();
		if (EXPR_FAIL == expr(&(start->operand[0]), MUMPS_INT))
			return FALSE;
	}
	ins_triple(r);
	*a = put_tref(r);
	return TRUE;
}
Пример #9
0
/* Free the memory allocated for MPROF stack. */
void mprof_stack_free(void)
{
	mprof_stack_frame *chunk_start, *prev_chunk_start;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (process_exiting)	/* no point trying to clean after ourselves if we are exiting */
		return;
	/* there are no elements on the stack */
	if (MPROF_STACK_ALLOC_CNT == TREF(mprof_chunk_avail_size))
	{
		free(TREF(mprof_stack_next_frame));
		TREF(mprof_stack_next_frame) = TREF(mprof_stack_curr_frame) = NULL;
		TREF(mprof_chunk_avail_size) = 0;
		return;
	}
	chunk_start = TREF(mprof_stack_curr_frame) - (MPROF_STACK_ALLOC_CNT - TREF(mprof_chunk_avail_size) - 1);
	while (NULL != chunk_start)
	{
		if (NULL != chunk_start->prev)
			prev_chunk_start = chunk_start->prev - (MPROF_STACK_ALLOC_CNT - 1);
		else
			prev_chunk_start = NULL;
		free(chunk_start);
		chunk_start = prev_chunk_start;
	}
	TREF(mprof_stack_next_frame) = TREF(mprof_stack_curr_frame) = NULL;
	TREF(mprof_chunk_avail_size) = 0;
	return;
}
Пример #10
0
void	op_indpat(mval *v, mval *dst)
{
	int		rval;
	icode_str	indir_src;
	mstr		*obj, object;
	oprtype		x, getdst;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	MV_FORCE_STR(v);
	indir_src.str = v->str;
	indir_src.code = indir_pattern;
	if (NULL == (obj = cache_get(&indir_src)))
	{
		obj = &object;
		comp_init(&v->str, &getdst);
		source_column = 1;	/* to coordinate with scanner redirection*/
		rval = compile_pattern(&x, (TK_ATSIGN == TREF(window_token)));
		if (EXPR_FAIL == comp_fini(rval, obj, OC_IRETMVAL, &x, &getdst, v->str.len))
			return;
		indir_src.str.addr = v->str.addr;
		cache_put(&indir_src, obj);
		/* Fall into code activation below */
	}
	TREF(ind_result) = dst;					/* Where to store return value */
	comp_indr(obj);
	return;
}
Пример #11
0
int f_ztrigger(oprtype *a, opctype op)
{
	triple	*r, *arg1, *arg2;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	r = maketriple(op);
	arg1 = newtriple(OC_PARAMETER);
	arg2 = newtriple(OC_PARAMETER);
	if (EXPR_FAIL == expr(&(r->operand[0]), MUMPS_STR))
		return FALSE;
	if (TK_COMMA == TREF(window_token))
	{	/* Looking for a 2nd argument */
		advancewindow();
		if (EXPR_FAIL == expr(&(arg1->operand[0]), MUMPS_STR))
			return FALSE;
		if (TK_COMMA == TREF(window_token))
		{
			advancewindow();
			if (EXPR_FAIL == expr(&(arg2->operand[0]), MUMPS_STR))
				return FALSE;
		} else
			arg2->operand[0] = put_lit((mval *)&literal_null);
	} else
	{
		arg1->operand[0] = put_lit((mval *)&literal_null);
		arg2->operand[0] = put_lit((mval *)&literal_null);
	}
	r->operand[1] = put_tref(arg1);
	arg1->operand[1] = put_tref(arg2);
	ins_triple(r);
	*a = put_tref(r);
	return TRUE;
}
Пример #12
0
void util_help(void)
{
	int  rc;
	char *help_option;
	char help_cmd_string[HELP_CMD_STRING_SIZE];
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	assert(1 >= TREF(parms_cnt));
	assert(GTM_IMAGE < image_type && UTIL_HELP_IMAGES > image_type);
	if (0 == TREF(parms_cnt))
		help_option = utilImageGLDs[INVALID_IMAGE];
	else
	{
		assert(TAREF1(parm_ary, TREF(parms_cnt) - 1));
		assert((char *)-1L != (TAREF1(parm_ary, TREF(parms_cnt) - 1)));
		help_option = (TAREF1(parm_ary, TREF(parms_cnt) - 1));
	}
	SNPRINTF(help_cmd_string, SIZEOF(help_cmd_string),
			"$gtm_dist/mumps -run %%XCMD 'do ^GTMHELP(\"%s\",\"$gtm_dist/%shelp.gld\")'",
			help_option, utilImageGLDs[image_type]);
	rc = SYSTEM(help_cmd_string);
	if (0 != rc)
		rts_error_csa(NULL, VARLSTCNT(5) ERR_TEXT, 2, RTS_ERROR_TEXT("HELP command error"), rc);
}
Пример #13
0
/* Halt the process similar to op_halt but allow a return code to be specified. If no return code
 * is specified, return code 0 is used as a default (making it identical to op_halt).
 */
int m_zhalt(void)
{
	triple	*triptr;
	oprtype ot;
	int	status;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	/* Let m_halt() handle the case of the missing return code */
	if ((TK_SPACE == TREF(window_token)) || (TK_EOL == TREF(window_token)))
		return m_halt();
	switch (status = expr(&ot, MUMPS_NUM))		/* NOTE assignment */
	{
		case EXPR_FAIL:
			return FALSE;
		case EXPR_GOOD:
			triptr = newtriple(OC_ZHALT);
			triptr->operand[0] = ot;
			return TRUE;
		case EXPR_INDR:
			make_commarg(&ot, indir_zhalt);
			return TRUE;
		default:
			assertpro(FALSE);
	}
	return FALSE; /* This should never get executed, added to make compiler happy */
}
Пример #14
0
int f_name(oprtype *a, opctype op)
{
	boolean_t	gbl;
	oprtype		*depth;
	short int	column;
	triple		*r, *s;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	r = maketriple(op);
	gbl = FALSE;
	switch (TREF(window_token))
	{
	case TK_CIRCUMFLEX:
		gbl = TRUE;
		advancewindow();
		/* caution fall through */
	case TK_IDENT:
		if (!name_glvn(gbl, &r->operand[1]))
			return FALSE;
		depth = &r->operand[0];
		break;
	case TK_ATSIGN:
		r->opcode = OC_INDFNNAME2;			/* chomps extra subscripts of resulting string */
		s = maketriple(OC_INDFNNAME);
		if (!indirection(&(s->operand[0])))
			return FALSE;
		s->operand[1] = put_ilit(MAX_LVSUBSCRIPTS + 1);	/* first, get all the subscripts. r will chomp them */
		coerce(&s->operand[1], OCT_MVAL);
		ins_triple(s);
		depth = &r->operand[0];
		r->operand[1] = put_tref(s);
		break;
	default:
		stx_error(ERR_VAREXPECTED);
		return FALSE;
	}
	/* allow for optional default value */
	if (TK_COMMA != TREF(window_token))
	{
		*depth = put_ilit(MAX_LVSUBSCRIPTS + 1);	/* default to maximum number of subscripts allowed by law */
		/* ideally this should be MAX(MAX_LVSUBSCRIPTS, MAX_GVSUBSCRIPTS) but they are the same so take the easy path */
		assert(MAX_LVSUBSCRIPTS == MAX_GVSUBSCRIPTS);	/* add assert to ensure our assumption is valid */
	} else
	{
		DISABLE_SIDE_EFFECT_AT_DEPTH;		/* doing this here let's us know specifically if direction had SE threat */
		advancewindow();
		column = source_column;
		if (EXPR_FAIL == expr(depth, MUMPS_STR))
			return FALSE;
		if (!run_time && (OC_INDFNNAME2 == r->opcode) && (SE_WARN == TREF(side_effect_handling)))
			ISSUE_SIDEEFFECTEVAL_WARNING(column - 1);
	}
	coerce(depth, OCT_MVAL);
	ins_triple(r);
	*a = put_tref(r);
	return TRUE;
}
Пример #15
0
int rts_error_va(void *csa, int argcnt, va_list var)
{
	int 		msgid;
	va_list		var_dup;
	const err_ctl	*ctl;
#	ifdef DEBUG
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (TREF(rts_error_unusable) && !TREF(rts_error_unusable_seen))
	{
		TREF(rts_error_unusable_seen) = TRUE;
		/* The below assert ensures that this rts_error invocation is appropriate in the current context of the code that
		 * triggered this rts_error. If ever this assert fails, investigate the window of DBG_MARK_RTS_ERROR_UNUSABLE
		 * and DBG_MARK_RTS_ERROR_USABLE in the call-stack.
		 */
		assert(FALSE);
	}
#	endif
	VAR_COPY(var_dup, var);
	if (-1 == gtm_errno)
		gtm_errno = errno;
	msgid = va_arg(var_dup, int);
	/* If there was a previous fatal error that did not yet get printed, do it before overwriting the
	 * util_output buffer with the about-to-be-handled nested error. This way one will see ALL the
	 * fatal error messages (e.g. assert failures) in the order in which they occurred instead of
	 * just the last nested one.
	 */
	if (DUMPABLE)
		PRN_ERROR;
	/* This is simply a place holder msg to signal tp restart or otherwise rethrow an error */
	if ((ERR_TPRETRY == msgid) || (ERR_REPEATERROR == msgid) || (ERR_REPLONLNRLBK == msgid) || (ERR_JOBINTRRQST == msgid)
			|| (ERR_JOBINTRRETHROW == msgid))
	{
		SET_ERROR_CONDITION(msgid);	/* sets "error_condition" & "severity" */
	} else
	{	/* Note this message is not flushed out. This is so user console is not polluted with messages that are going to be
		 * handled by a ZTRAP. If ZTRAP is not active, the message will be flushed out in mdb_condition_handler - which is
		 * usually the top level handler or is rolled over into by higher handlers.
		 */
		if (IS_GTMSECSHR_IMAGE)
			util_out_print(NULL, RESET);
		SET_ERROR_CONDITION(msgid);	/* sets "error_condition" & "severity" */
		gtm_putmsg_list(csa, argcnt, var);
		if (DUMPABLE)
			created_core = dont_want_core = FALSE;		/* We can create a(nother) core now */
		if (IS_GTMSECSHR_IMAGE)
			util_out_print(NULL, OPER);			/* gtmsecshr errors always immediately pushed out */
	}
	va_end(var_dup);
	va_end(var);
	DRIVECH(msgid);				/* Drive the topmost (inactive) condition handler */
	/* Note -- at one time there was code here to catch if we returned from the condition handlers
	 * when the severity was error or above. That code had to be removed because of several errors
	 * that are handled and returned from. An example is EOF errors.  SE 9/2000
	 */
	return 0;
}
Пример #16
0
int f_zprevious(oprtype *a, opctype op)
{
	triple		*oldchain, *r;
	save_se		save_state;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	r = maketriple(op);
	switch (TREF(window_token))
	{
	case TK_IDENT:
		if (TK_LPAREN != TREF(director_token))
		{
			r->opcode = OC_FNLVPRVNAME;
			r->operand[0] = put_str((TREF(window_ident)).addr, (TREF(window_ident)).len);
			ins_triple(r);
			advancewindow();
			break;
		}
		if (!lvn(&(r->operand[0]), OC_SRCHINDX, r))
			return FALSE;
		ins_triple(r);
		break;
	case TK_CIRCUMFLEX:
		if (!gvn())
			return FALSE;
		r->opcode = OC_ZPREVIOUS;
		ins_triple(r);
		break;
	case TK_ATSIGN:
		if (SHIFT_SIDE_EFFECTS)
		{
			START_GVBIND_CHAIN(&save_state, oldchain);
			if (!indirection(&(r->operand[0])))
			{
				setcurtchain(oldchain);
				return FALSE;
			}
			r->operand[1] = put_ilit((mint)indir_fnzprevious);
			ins_triple(r);
			PLACE_GVBIND_CHAIN(&save_state, oldchain);
		} else
		{
			if (!indirection(&(r->operand[0])))
				return FALSE;
			r->operand[1] = put_ilit((mint)indir_fnzprevious);
			ins_triple(r);
		}
		r->opcode = OC_INDFUN;
		break;
	default:
		stx_error(ERR_VAREXPECTED);
		return FALSE;
	}
	*a = put_tref(r);
	return TRUE;
}
Пример #17
0
int m_hcmd(void)
{
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if ((TK_SPACE == TREF(window_token)) || (TK_EOL == TREF(window_token)))
		return m_halt();
	return m_hang();
}
Пример #18
0
int f_piece(oprtype *a, opctype op)
{
	delimfmt	unichar;
	mval		*delim_mval;
	oprtype		x;
	triple		*delimiter, *first, *last, *r;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	r = maketriple(op);
	if (EXPR_FAIL == expr(&(r->operand[0]), MUMPS_STR))
		return FALSE;
	if (TK_COMMA != TREF(window_token))
	{
		stx_error(ERR_COMMA);
		return FALSE;
	}
	advancewindow();
	delimiter = newtriple(OC_PARAMETER);
	r->operand[1] = put_tref(delimiter);
	first = newtriple(OC_PARAMETER);
	delimiter->operand[1] = put_tref(first);
	if (EXPR_FAIL == expr(&x, MUMPS_STR))
		return FALSE;
	if (TK_COMMA != TREF(window_token))
		first->operand[0] = put_ilit(1);
	else
	{
		advancewindow();
		if (EXPR_FAIL == expr(&(first->operand[0]), MUMPS_INT))
			return FALSE;
	}
	assert(TRIP_REF == x.oprclass);
	if ((TK_COMMA != TREF(window_token)) && (OC_LIT == x.oprval.tref->opcode)
		 && (1 == ((gtm_utf8_mode && (OC_FNZPIECE != op))  ?   MV_FORCE_LEN(&x.oprval.tref->operand[0].oprval.mlit->v)
								   : x.oprval.tref->operand[0].oprval.mlit->v.str.len)))
	{	/* Potential shortcut to op_fnzp1 or op_fnp1. Make some further checks */
		delim_mval = &x.oprval.tref->operand[0].oprval.mlit->v;
		/* Both valid chars of char_len 1 and invalid chars of byte length 1 get the fast path */
		unichar.unichar_val = 0;
		if (!gtm_utf8_mode || OC_FNZPIECE == op)
		{       /* Single byte delimiter */
			r->opcode = OC_FNZP1;
			unichar.unibytes_val[0] = *delim_mval->str.addr;
		} else
		{       /* Potentially multiple bytes in one int */
			r->opcode = OC_FNP1;
			assert(SIZEOF(int) >= delim_mval->str.len);
			memcpy(unichar.unibytes_val, delim_mval->str.addr, delim_mval->str.len);
		}
		delimiter->operand[0] = put_ilit(unichar.unichar_val);
		ins_triple(r);
		*a = put_tref(r);
		return TRUE;
	}
Пример #19
0
int strexpr(oprtype *a)
{

	triple *triptr;
	int4 rval;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (!(TREF(expr_depth))++)
		TREF(expr_start) = TREF(expr_start_orig) = NULL;
	if (!(rval = eval_expr(a)))
	{
		TREF(expr_depth) = 0;
		return FALSE;
	}
	coerce(a,OCT_MVAL);
	ex_tail(a);
	if (!(--(TREF(expr_depth))))
		TREF(shift_side_effects) = FALSE;
	if (TREF(expr_start) != TREF(expr_start_orig))
	{
		triptr = newtriple(OC_GVRECTARG);
		triptr->operand[0] = put_tref(TREF(expr_start));
	}
	return rval;

}
Пример #20
0
void op_fnnext(lv_val *src, mval *key, mval *dst)
{
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	assert(!TREF(in_op_fnnext));
	TREF(in_op_fnnext) = TRUE;
	op_fnorder(src, key, dst);
	assert(!TREF(in_op_fnnext)); /* should have been reset by op_fnorder */
	TREF(in_op_fnnext) = FALSE;
}
Пример #21
0
/* Preallocate space for MPROF_STACK_ALLOC_CNT elements of the stack. */
void mprof_stack_init(void)
{
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (NULL == TREF(mprof_stack_next_frame))
		TREF(mprof_stack_next_frame) = (mprof_stack_frame *)malloc(SIZEOF(mprof_stack_frame) * MPROF_STACK_ALLOC_CNT);
	TREF(mprof_stack_curr_frame) = NULL;
	TREF(mprof_chunk_avail_size) = MPROF_STACK_ALLOC_CNT;
	return;
}
Пример #22
0
int f_zcall(oprtype *a, opctype op)
{
	int	argc;
	oprtype	*argp, argv[CHARMAXARGS];
	triple	*curr,*ref, *last, *root;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	argp = &argv[0];
	argc = 0;
	if (EXPR_FAIL == expr(argp, MUMPS_EXPR))
		return FALSE;
	assert(TRIP_REF == argp->oprclass);
	argc++;
	argp++;
	for (;;)
	{
		if (TK_COMMA != TREF(window_token))
			break;
		advancewindow();
		if (TK_COMMA == TREF(window_token) || TK_RPAREN == TREF(window_token))
		{
			ref = newtriple(OC_NULLEXP);
			*argp = put_tref(ref);
		} else
		{
			if (EXPR_FAIL == expr(argp, MUMPS_EXPR))
				return FALSE;
			assert(TRIP_REF == argp->oprclass);
		}
		argc++;
		argp++;
		if (argc >= CHARMAXARGS)
		{
			stx_error(ERR_FCHARMAXARGS);
			return FALSE;
		}
	}
	root = last = maketriple(op);
	root->operand[0] = put_ilit(argc + 1);
	argp = &argv[0];
	for (; argc > 0 ;argc--, argp++)
	{
		curr = newtriple(OC_PARAMETER);
		curr->operand[0] = *argp;
		last->operand[1] = put_tref(curr);
		last = curr;
	}
	ins_triple(root);
	*a = put_tref(root);
	return TRUE;
}
Пример #23
0
int m_ztstart(void)
{
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if ((TK_EOL != TREF(window_token)) && (TK_SPACE != TREF(window_token)))
	{
		stx_error(ERR_SPOREOL);
		return FALSE;
	}
	newtriple(OC_ZTSTART);
	return TRUE;
}
Пример #24
0
boolean_t op_gvqueryget(mval *key, mval *val)
{
	boolean_t 	gotit;
	gv_key		*save_key;
	gvnh_reg_t	*gvnh_reg;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (TREF(gv_last_subsc_null) && NEVER == gv_cur_region->null_subs)
		sgnl_gvnulsubsc();
	switch (REG_ACC_METH(gv_cur_region))
	{
	case dba_bg:
	case dba_mm:
		gvnh_reg = TREF(gd_targ_gvnh_reg);
		if (NULL == gvnh_reg)
			gotit = ((0 != gv_target->root) ? gvcst_queryget(val) : FALSE); /* global does not exist if root is 0 */
		else
			INVOKE_GVCST_SPR_XXX(gvnh_reg, gotit = gvcst_spr_queryget(val));
		break;
	case dba_cm:
		gotit = gvcmx_query(val);
		break;
	case dba_usr:
		save_key = gv_currkey;
		gv_currkey = gv_altkey;
		/* We rely on the fact that *gv_altkey area is not modified by gvusr_queryget, and don't change gv_altkey.
		 * If and when *gv_altkey area is modified by gvusr_queryget, we have to set up a spare key area
		 * (apart from gv_altkey and gv_currkey), and make gv_altkey point the spare area before calling gvusr_queryget */
		memcpy(gv_currkey, save_key, SIZEOF(*save_key) + save_key->end);
		gotit = gvusr_queryget(val);
		gv_altkey = gv_currkey;
		gv_currkey = save_key;
		break;
	default:
		assertpro(FALSE && REG_ACC_METH(gv_cur_region));
	}
	if (gotit)
	{
		key->mvtype = MV_STR;
		key->str.addr = (char *)gv_altkey->base;
		key->str.len = gv_altkey->end + 1;
		s2pool(&key->str);
	} else
	{
		*key = literal_null;
		*val = literal_null;
	}
	return gotit;
}
Пример #25
0
int m_zinvcmd(void)
{
	triple *triptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	while ((TK_EOL != TREF(window_token)) && (TK_SPACE != TREF(window_token)) && (TK_ERROR != TREF(window_token)))
		advancewindow();
	if (TK_ERROR == TREF(window_token))
		return FALSE;
	triptr = newtriple(OC_RTERROR);
	triptr->operand[0] = put_ilit(ERR_INVCMD);
	triptr->operand[1] = put_ilit(FALSE);	/* not a subroutine reference */
	return TRUE;
}
Пример #26
0
int m_break(void)
{
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if ((TK_SPACE != TREF(window_token)) && (TK_EOL != TREF(window_token)))
		if (!m_xecute())
			return FALSE;
	newtriple(OC_BREAK);
	if (TREF(for_stack_ptr) == TADR(for_stack))
		start_fetches (OC_FETCH);
	else
		start_for_fetches ();
	return TRUE;
}
Пример #27
0
/* This code is very similar to op_fngvget.c except, if the gvn is undefined, this returns an undefined value as a signal to
 * op_fnget2, which, in turn, returns a specified "default" value; that slight of hand deals with order of evaluation issues
 * Any changes to this routine most likely have to be made in op_fngvget.c as well.
 */
void	op_fngvget1(mval *dst)
{
	boolean_t	gotit;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if (TREF(gv_last_subsc_null) && NEVER == gv_cur_region->null_subs)
		sgnl_gvnulsubsc();

	switch (gv_cur_region->dyn.addr->acc_meth)
	{
		case dba_bg :
		case dba_mm :
			gotit = gv_target->root ? gvcst_get(dst) : FALSE;
			break;
		case dba_cm :
			gotit = gvcmx_get(dst);
			break;
		default :
			if (gotit = gvusr_get(dst))	/* NOTE: assignment */
				s2pool(&dst->str);
			break;
	}
	if (!gotit)
		dst->mvtype = 0;
	assert(0 == (dst->mvtype & MV_ALIASCONT));	/* Should be no alias container flag */
	return;
}
bool timer_set(long cycles, bool start)
{
    bool found = false;
 
    int prescale_option = 0;
    int actual_cycles = 0;
 
    /* Use the first prescale that fits Timer4's 20-bit counter */
    while (!found && prescale_option < 7)
    {
        actual_cycles = cycles >> prescale_shifts[prescale_option];
 
        if (actual_cycles < 0x100000)
            found = true;
        else
            prescale_option++;
    }
 
    if (!found)
        return false;

    /* Stop the timer and set new prescale & ref count */
    TCFG(4) &= ~TCFG_EN;
    TCFG(4) = prescale_option << TCFG_SEL;
    TREF(4) = actual_cycles;
    
    if (start && pfn_unregister != NULL)
    {
        pfn_unregister();
        pfn_unregister = NULL;
    }
    
    return true;
}
Пример #29
0
int f_translate(oprtype *a, opctype op)
{
	boolean_t	more_args;
	int		i;
	triple		*args[3];
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	args[0] = maketriple(op);
	if (EXPR_FAIL == expr(&(args[0]->operand[0]), MUMPS_EXPR))
		return FALSE;
	for (i = 1 , more_args = TRUE ; i < 3 ; i++)
	{
		args[i] = newtriple(OC_PARAMETER);
		if (more_args)
		{
			if (TK_COMMA != TREF(window_token))
				more_args = FALSE;
			else
			{
				advancewindow();
				if (EXPR_FAIL == expr(&(args[i]->operand[0]), MUMPS_EXPR))
					return FALSE;
			}
		}
		if (!more_args)
			args[i]->operand[0] = put_lit((mval *)&literal_null);
		args[i - 1]->operand[1] = put_tref(args[i]);
	}
	ins_triple(args[0]);
	*a = put_tref(args[0]);
	return TRUE;
}
Пример #30
0
void	t_begin_crit(uint4 err)	/* err - error code for current gvcst_routine */
{
	boolean_t	was_crit;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	CWS_RESET;
	start_tn = cs_addrs->ti->curr_tn;
	cw_set_depth = 0;
	t_tries = CDB_STAGNATE;
	/* since this is mainline code and we know fast_lock_count should be 0 at this point reset it just in case it is not.
	 * having fast_lock_count non-zero will defer the database flushing logic and other critical parts of the system.
	 * hence this periodic reset at the beginning of each transaction.
	 */
	assert(0 == fast_lock_count);
	fast_lock_count = 0;
	t_err = err;
	if (non_tp_jfb_ptr)
		non_tp_jfb_ptr->record_size = 0; /* re-initialize it to 0 since TOTAL_NONTPJNL_REC_SIZE macro uses it */
	/* the only currently known callers of this routine are DSE and MUPIP RECOVER (mur_put_aimg_rec.c).
	 * all of them set "write_after_image" to TRUE. hence the assert below.
	 */
	assert(write_after_image);
	update_trans = UPDTRNS_DB_UPDATED_MASK;
	was_crit = cs_addrs->now_crit;
	assert(!was_crit || cs_addrs->hold_onto_crit);
	if (!was_crit)
	{	/* We are going to grab_crit. If csa->nl->wc_blocked is set to TRUE, we will end up calling wcs_recover as part of
		 * grab_crit. Set variable to indicate it is ok to do so even though t_tries is CDB_STAGNATE since we are not
		 * in the middle of any transaction.
		 */
		DEBUG_ONLY(TREF(ok_to_call_wcs_recover) = TRUE;)