コード例 #1
0
ファイル: m_xecute.c プロジェクト: CeperaCPP/fis-gtm
int m_xecute(void)
{
	oprtype *cr, x;
	triple *obp, *oldchain, *ref0, *ref1, tmpchain, *triptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	dqinit(&tmpchain,exorder);
	oldchain = setcurtchain(&tmpchain);
	switch (expr(&x, MUMPS_STR))
	{
	case EXPR_FAIL:
		setcurtchain(oldchain);
		return FALSE;
	case EXPR_INDR:
		if (TK_COLON != TREF(window_token))
		{
			make_commarg(&x,indir_xecute);
			break;
		}
		/* caution: fall through */
	case EXPR_GOOD:
		ref0 = maketriple(OC_COMMARG);
		ref0->operand[0] = x;
		ref0->operand[1] = put_ilit(indir_linetail);
		ins_triple(ref0);
	}
	setcurtchain(oldchain);
	if (TK_COLON == TREF(window_token))
	{
		advancewindow();
		cr = (oprtype *)mcalloc(SIZEOF(oprtype));
		if (!bool_expr(FALSE, cr))
			return FALSE;
		if (TREF(expr_start) != TREF(expr_start_orig))
		{
			triptr = newtriple(OC_GVRECTARG);
			triptr->operand[0] = put_tref(TREF(expr_start));
		}
		obp = oldchain->exorder.bl;
		dqadd(obp,&tmpchain,exorder);		/* violates info hiding */
		if (TREF(expr_start) != TREF(expr_start_orig))
		{
			ref0 = newtriple(OC_JMP);
			ref1 = newtriple(OC_GVRECTARG);
			ref1->operand[0] = put_tref(TREF(expr_start));
			*cr = put_tjmp(ref1);
			tnxtarg(&ref0->operand[0]);
		} else
			tnxtarg(cr);
		return TRUE;
	}
	obp = oldchain->exorder.bl;
	dqadd(obp,&tmpchain,exorder);		/* violates info hiding */
	return TRUE;
}
コード例 #2
0
int expression()
{
	int es = 0, fileadd;
	char token2[20], token3[40];
	if (strcmp(token, "ID") == 0)
	{
		fileadd = ftell(fp);   //@ASSIGN记住当前文件位置
		fscanf(fp, "%s %s\n", &token2, &token3);
		printf("%s %s\n", token2, token3);
		if (strcmp(token2, "=") == 0)  //'='
		{
			int address;
			es = lookup(token1, &address);
			if (es > 0) return(es);
			fscanf(fp, "%s %s\n", &token, &token1);
			printf("%s %s\n", token, token1);
			es = bool_expr();
			if (es > 0) return(es);
			fprintf(fout, "        STO %d\n", address);

			vartable[address].value = 1;
			

		}
		else
		{
			fseek(fp, fileadd, 0); //若非'='则文件指针回到'='前的标识符
			printf("%s %s\n", token, token1);
			es = bool_expr();
			if (es > 0) return(es);
		}
	}
	else es = bool_expr();

	return(es);
}
コード例 #3
0
ファイル: m_goto.c プロジェクト: ChristopherEdwards/fis-gtm
int m_goto(void)
{
	oprtype	*cr;
	triple	*obp, *oldchain, *ref0, *ref1, tmpchain, *triptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	dqinit(&tmpchain, exorder);
	oldchain = setcurtchain(&tmpchain);
	if (!entryref(OC_JMP, OC_EXTJMP, (mint)indir_goto, TRUE, FALSE, FALSE))
	{
		setcurtchain(oldchain);
		return FALSE;
	}
	setcurtchain(oldchain);
	if (TK_COLON == TREF(window_token))
	{
		advancewindow();
		cr = (oprtype *)mcalloc(SIZEOF(oprtype));
		if (!bool_expr(FALSE, cr))
			return FALSE;
		if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode))
		{
			triptr = newtriple(OC_GVRECTARG);
			triptr->operand[0] = put_tref(TREF(expr_start));
		}
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
		if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode))
		{
			ref0 = newtriple(OC_JMP);
			ref1 = newtriple(OC_GVRECTARG);
			ref1->operand[0] = put_tref(TREF(expr_start));
			*cr = put_tjmp(ref1);
			tnxtarg(&ref0->operand[0]);
		} else
			tnxtarg(cr);
		return TRUE;
	}
	obp = oldchain->exorder.bl;
	dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
	return TRUE;
}
コード例 #4
0
ファイル: m_goto.c プロジェクト: 5HT/mumps
int m_goto(void)
{
	triple tmpchain, *oldchain, *obp, *ref0, *ref1, *triptr;
	oprtype *cr;

	dqinit(&tmpchain, exorder);
	oldchain = setcurtchain(&tmpchain);
	if (!entryref(OC_JMP, OC_EXTJMP, (mint) indir_goto, TRUE, FALSE))
	{
		setcurtchain(oldchain);
		return FALSE;
	}
	setcurtchain(oldchain);
	if (window_token == TK_COLON)
	{
		advancewindow();
		cr = (oprtype *) mcalloc(sizeof(oprtype));
		if (!bool_expr((bool) FALSE, cr))
			return FALSE;
		if (expr_start != expr_start_orig)
		{
			triptr = newtriple(OC_GVRECTARG);
			triptr->operand[0] = put_tref(expr_start);
		}
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
		if (expr_start != expr_start_orig)
		{
			ref0 = newtriple(OC_JMP);
			ref1 = newtriple(OC_GVRECTARG);
			ref1->operand[0] = put_tref(expr_start);
			*cr = put_tjmp(ref1);
			tnxtarg(&ref0->operand[0]);
		}
		else
			tnxtarg(cr);
		return TRUE;
	}
	obp = oldchain->exorder.bl;
	dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
	return TRUE;
}
コード例 #5
0
ファイル: m_do.c プロジェクト: mihawk/fis-gtm
int m_do(void)
{
	int		opcd;
	oprtype		*cr;
	triple		*calltrip, *labelref, *obp, *oldchain, *ref0, *ref1, *routineref, tmpchain, *triptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if ((TK_EOL == TREF(window_token)) || (TK_SPACE == TREF(window_token)))
	{
		if (!run_time)	/* DO SP SP is a noop at run time */
		{
			calltrip = newtriple(OC_CALLSP);
			calltrip->operand[0] = put_mnxl();
		}
		return TRUE;
	} else if (TK_AMPERSAND == TREF(window_token))
	{
		if (!extern_func(0))
			return FALSE;
		else
			return TRUE;
	}
	dqinit(&tmpchain, exorder);
	oldchain = setcurtchain(&tmpchain);
	calltrip = entryref(OC_CALL, OC_EXTCALL, (mint)indir_do, TRUE, FALSE, FALSE);
	setcurtchain(oldchain);
	if (!calltrip)
		return FALSE;
	if (TK_LPAREN == TREF(window_token))
	{
		if (OC_CALL == calltrip->opcode)
		{
			assert(MLAB_REF == calltrip->operand[0].oprclass);
			calltrip->opcode = OC_EXCAL;
			ref0 = calltrip;
		} else
		{
			if (OC_EXTCALL == calltrip->opcode)
			{
				assert(TRIP_REF == calltrip->operand[1].oprclass);
				if (OC_CDLIT == calltrip->operand[1].oprval.tref->opcode)
					assert(CDLT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
				else
				{
					assert(OC_LABADDR == calltrip->operand[1].oprval.tref->opcode);
					assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprclass);
					assert(OC_PARAMETER == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode);
					assert(TRIP_REF ==
						calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass);
					DEBUG_ONLY(opcd = calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						   operand[0].oprval.tref->opcode);
					assert((OC_ILIT == opcd) || (OC_COMINT == opcd));
					DEBUG_ONLY(opcd = calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						   operand[0].oprval.tref->operand[0].oprclass);
					assert((ILIT_REF == opcd) || (TRIP_REF == opcd));
					/* The opcd references above added to allow an invalid syntax using indirect values for
					 * offsets while specifying a parm list to get through the above asserts (invalid syntax
					 * should not trip asserts) but it leads to the conclusion that the below test may not be
					 * robust enough since it is looking at a literal integer value when there is none so have
					 * added further checks mirroring the first checks done in the two most recent asserts to
					 * make the check more robust. [Example bad code: Do @lbl+@n^artn(arg)]
					 */
					if ((0 != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
					     operand[0].oprval.tref->operand[0].oprval.ilit)
					    || (OC_ILIT != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						operand[0].oprval.tref->opcode)
					    || (ILIT_REF != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						operand[0].oprval.tref->operand[0].oprclass))
					{
						stx_error (ERR_ACTOFFSET);
						return FALSE;
					}
				}
			} else
			{	/* DO _ @dlabel actuallist */
				assert(OC_COMMARG == calltrip->opcode);
				assert(TRIP_REF == calltrip->operand[1].oprclass);
				assert(OC_ILIT == calltrip->operand[1].oprval.tref->opcode);
				assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
				assert((mint)indir_do == calltrip->operand[1].oprval.tref->operand[0].oprval.ilit);
				assert(calltrip->exorder.fl == &tmpchain);
				routineref = maketriple(OC_CURRHD);
				labelref = maketriple(OC_LABADDR);
				ref0 = maketriple(OC_PARAMETER);
				dqins(calltrip->exorder.bl, exorder, routineref);
				dqins(calltrip->exorder.bl, exorder, labelref);
				dqins(calltrip->exorder.bl, exorder, ref0);
				labelref->operand[0] = calltrip->operand[0];
				labelref->operand[1] = put_tref (ref0);
				ref0->operand[0] = calltrip->operand[1];
				ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0;
				ref0->operand[1] = put_tref (routineref);
				calltrip->operand[0] = put_tref(routineref);
				calltrip->operand[1] = put_tref(labelref);
			}
			calltrip->opcode = OC_EXTEXCAL;
			ref0 = newtriple(OC_PARAMETER);
			ref0->operand[0] = calltrip->operand[1];
			calltrip->operand[1] = put_tref(ref0);
		}
		if (!actuallist(&ref0->operand[1]))
			return FALSE;
	} else if (OC_CALL == calltrip->opcode)
	{
		if (TREF(for_stack_ptr) != (oprtype **)TADR(for_stack))
		{
			if (TAREF1(for_temps, (TREF(for_stack_ptr) - (oprtype **)TADR(for_stack))))
				calltrip->opcode = OC_FORLCLDO;
		}
	}
	if (TK_COLON == TREF(window_token))
	{
		advancewindow();
		cr = (oprtype *)mcalloc(SIZEOF(oprtype));
		if (!bool_expr(FALSE, cr))
			return FALSE;
		if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode))
		{
			triptr = newtriple(OC_GVRECTARG);
			triptr->operand[0] = put_tref(TREF(expr_start));
		}
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
		if (calltrip->opcode == OC_EXCAL)
		{
			triptr = newtriple(OC_JMP);
			triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
			calltrip->operand[0].oprclass = ILIT_REF;	/* dummy placeholder */
		}
		if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode))
		{
			ref0 = newtriple(OC_JMP);
			ref1 = newtriple(OC_GVRECTARG);
			ref1->operand[0] = put_tref(TREF(expr_start));
			*cr = put_tjmp(ref1);
			tnxtarg(&ref0->operand[0]);
		} else
			tnxtarg(cr);
	} else
	{
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
		if (OC_EXCAL == calltrip->opcode)
		{
			triptr = newtriple(OC_JMP);
			triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
			calltrip->operand[0].oprclass = ILIT_REF;	/* dummy placeholder */
		}
	}
	return TRUE;
}
コード例 #6
0
ファイル: f_select.c プロジェクト: CeperaCPP/fis-gtm
int f_select(oprtype *a, opctype op)
{
	boolean_t	first_time, save_saw_side, save_shift;
	unsigned int	save_depth;
	opctype		old_op;
	oprtype		*cnd, endtrip, target, tmparg;
	triple		*oldchain, *r, *ref, *save_start, *save_start_orig, tmpchain, *triptr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	save_shift = TREF(shift_side_effects);
	save_saw_side = TREF(saw_side_effect);
	save_depth = TREF(expr_depth);
	save_start = TREF(expr_start);
	save_start_orig = TREF(expr_start_orig);
	TREF(shift_side_effects) = FALSE;
	TREF(saw_side_effect) = FALSE;
	TREF(expr_depth) = 0;
	TREF(expr_start) = TREF(expr_start_orig) = NULL;
	if (save_shift)
	{
		dqinit(&tmpchain, exorder);
		oldchain = setcurtchain(&tmpchain);
	}
	r = maketriple(op);
	first_time = TRUE;
	endtrip = put_tjmp(r);
	for (;;)
	{
		cnd = (oprtype *)mcalloc(SIZEOF(oprtype));
		if (!bool_expr(FALSE, cnd))
		{
			if (save_shift)
				setcurtchain(oldchain);
			return FALSE;
		}
		if (TK_COLON != TREF(window_token))
		{
			if (save_shift)
				setcurtchain(oldchain);
			stx_error(ERR_COLON);
			return FALSE;
		}
		advancewindow();
		if (EXPR_FAIL == expr(&tmparg, MUMPS_EXPR))
		{
			if (save_shift)
				setcurtchain(oldchain);
			return FALSE;
		}
		assert(TRIP_REF == tmparg.oprclass);
		old_op = tmparg.oprval.tref->opcode;
		if (first_time)
		{
			if ((OC_LIT == old_op) || (oc_tab[old_op].octype & OCT_MVADDR))
			{
				ref = newtriple(OC_STOTEMP);
				ref->operand[0] = tmparg;
				tmparg = put_tref(ref);
			}
			r->operand[0] = target = tmparg;
			first_time = FALSE;
		} else
		{
			ref = newtriple(OC_STO);
			ref->operand[0] = target;
			ref->operand[1] = tmparg;
			if (OC_PASSTHRU == tmparg.oprval.tref->opcode)
			{
				assert(TRIP_REF == tmparg.oprval.tref->operand[0].oprclass);
				ref = newtriple(OC_STO);
				ref->operand[0] = target;
				ref->operand[1] = put_tref(tmparg.oprval.tref->operand[0].oprval.tref);
			}
		}
		ref = newtriple(OC_JMP);
		ref->operand[0] = endtrip;
		tnxtarg(cnd);
		if (TK_COMMA != TREF(window_token))
			break;
		advancewindow();
	}
	tmparg = put_ilit(ERR_SELECTFALSE);
	ref = newtriple(OC_RTERROR);
	ref->operand[0] = tmparg;
	ref->operand[1] = put_ilit(FALSE);	/* Not a subroutine reference */
	ins_triple(r);
	assert(!TREF(expr_depth));
	TREF(shift_side_effects) = save_shift;
	TREF(saw_side_effect) = save_saw_side;
	TREF(expr_depth) = save_depth;
	TREF(expr_start) = save_start;
	TREF(expr_start_orig) = save_start_orig;
	if (save_shift)
	{
		newtriple(OC_GVSAVTARG);
		setcurtchain(oldchain);
		dqadd(TREF(expr_start), &tmpchain, exorder);
		TREF(expr_start) = tmpchain.exorder.bl;
		triptr = newtriple(OC_GVRECTARG);
		triptr->operand[0] = put_tref(TREF(expr_start));
	}
	*a = put_tref(r);
	return TRUE;
}
コード例 #7
0
ファイル: m_zgoto.c プロジェクト: h4ck3rm1k3/fis-gtm
int m_zgoto(void)
{
	triple		tmpchain, *oldchain, *obp, *ref0, *ref1, *triptr;
	oprtype		*cr, quits;
	int4		rval;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	dqinit(&tmpchain, exorder);
	oldchain = setcurtchain(&tmpchain);
	if ((TK_EOL == window_token) || (TK_SPACE == window_token))
	{	/* Default zgoto level is 1 */
		quits = put_ilit(1);
		rval = EXPR_GOOD;
	} else if (!(rval = intexpr(&quits)))		/* note assignment */
	{
		setcurtchain(oldchain);
		return FALSE;
	}
	if ((EXPR_INDR != rval) && ((TK_EOL == window_token) || (TK_SPACE == window_token)))
	{	/* Only level parm supplied (no entry ref) - job for op_zg1 */
		setcurtchain(oldchain);
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);		/* this is a violation of info hiding */
		ref0 = newtriple(OC_ZG1);
		ref0->operand[0] = quits;
		return TRUE;
	}
	if (TK_COLON != window_token)
	{	/* First arg parsed, not ending in ":". Better have been indirect */
		setcurtchain(oldchain);
		if (EXPR_INDR != rval)
		{
			stx_error(ERR_COLON);
			return FALSE;
		}
		make_commarg(&quits, indir_zgoto);
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);		/* this is a violation of info hiding */
	 	return TRUE;
	}
	advancewindow();
	if (TK_COLON != window_token)
	{
		if (!entryref(OC_NOOP, OC_PARAMETER, (mint)indir_goto, FALSE, FALSE, TRUE))
		{
			setcurtchain(oldchain);
			return FALSE;
		}
		ref0 = maketriple(OC_ZGOTO);
		ref0->operand[0] = quits;
		ref0->operand[1] = put_tref(tmpchain.exorder.bl);
		ins_triple(ref0);
		setcurtchain(oldchain);
	} else
	{
		ref0 = maketriple(OC_ZG1);
		ref0->operand[0] = quits;
		ins_triple(ref0);
		setcurtchain(oldchain);
	}
	if (TK_COLON == window_token)
	{	/* post conditional expression */
		advancewindow();
		cr = (oprtype *)mcalloc(SIZEOF(oprtype));
		if (!bool_expr((bool)FALSE, cr))
			return FALSE;
		if (TREF(expr_start) != TREF(expr_start_orig))
		{
			triptr = newtriple(OC_GVRECTARG);
			triptr->operand[0] = put_tref(TREF(expr_start));
		}
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);		 /* this is a violation of info hiding */
		if (TREF(expr_start) != TREF(expr_start_orig))
		{
			ref0 = newtriple(OC_JMP);
			ref1 = newtriple(OC_GVRECTARG);
			ref1->operand[0] = put_tref(TREF(expr_start));
			*cr = put_tjmp(ref1);
			tnxtarg(&ref0->operand[0]);
		} else
			tnxtarg(cr);
		return TRUE;
	}
	obp = oldchain->exorder.bl;
	dqadd(obp, &tmpchain, exorder);			/* this is a violation of info hiding */
	return TRUE;
}
コード例 #8
0
ファイル: m_if.c プロジェクト: 5HT/mumps
int m_if(void)
{
	triple *ref0, *ref1, *ref2, *jmpref, ifpos_in_chain, *triptr;
	oprtype x, y, *ta_opr;
	bool first_time, t_set, is_commarg;

	typedef struct jmpchntype
	{	struct
		{	struct jmpchntype *fl,*bl;
		}link;
		triple  *jmptrip;
	}jmpchn;
	jmpchn *jmpchain,*nxtjmp;

	error_def(ERR_SPOREOL);
	error_def(ERR_INDEXTRACHARS);

	ifpos_in_chain = pos_in_chain;
	jmpchain = (jmpchn*) mcalloc(sizeof(jmpchn));
	dqinit(jmpchain,link);
	if (window_token == TK_EOL)
		return TRUE;
	is_commarg = last_source_column == 1;
	x = for_end_of_scope(0);
	assert(x.oprclass == INDR_REF);
	if (window_token == TK_SPACE)
	{	jmpref = newtriple(OC_JMPTCLR);
		jmpref->operand[0] = x;
		nxtjmp = (jmpchn *) mcalloc(sizeof(jmpchn));
		nxtjmp->jmptrip = jmpref;
		dqins(jmpchain,link,nxtjmp);
	}
	else
	{
		first_time = TRUE;
		for (;;)
		{
			ta_opr = (oprtype *) mcalloc(sizeof(oprtype));
			if (!bool_expr((bool) TRUE, ta_opr))
				return FALSE;
			if ((ref0 = curtchain->exorder.bl)->opcode == OC_JMPNEQ
				&& (ref1 = ref0->exorder.bl)->opcode == OC_COBOOL
				&& (ref2 = ref1->exorder.bl)->opcode == OC_INDGLVN)
			{
				dqdel(ref0,exorder);
				ref1->opcode = OC_JMPTSET;
				ref1->operand[0] = put_indr(ta_opr);
				ref2->opcode = OC_COMMARG;
				ref2->operand[1] = put_ilit((mint) indir_if);
			}
			t_set = curtchain->exorder.bl->opcode == OC_JMPTSET;
			if (!t_set)
				newtriple(OC_CLRTEST);
			if (expr_start != expr_start_orig)
			{
                		triptr = newtriple(OC_GVRECTARG);
				triptr->operand[0] = put_tref(expr_start);
			}
			jmpref = newtriple(OC_JMP);
			jmpref->operand[0] = x;
			nxtjmp = (jmpchn *) mcalloc(sizeof(jmpchn));
			nxtjmp->jmptrip = jmpref;
			dqins(jmpchain,link,nxtjmp);
			tnxtarg(ta_opr);
			if (first_time)
			{
				if (!t_set)
					newtriple(OC_SETTEST);
				if (expr_start != expr_start_orig)
				{
					triptr = newtriple(OC_GVRECTARG);
					triptr->operand[0] = put_tref(expr_start);
				}
				first_time = FALSE;
			}
			if (window_token != TK_COMMA)
				break;
			advancewindow();
		}
	}
	if (is_commarg)
	{
		if (window_token != TK_EOL)
		{
			stx_error(ERR_INDEXTRACHARS);
			return FALSE;
		}
		return TRUE;
	}
	if (window_token != TK_EOL && window_token != TK_SPACE)
	{
		stx_error(ERR_SPOREOL);
		return FALSE;
	}
	if (!linetail())
	{	tnxtarg(&x);
		dqloop(jmpchain,link,nxtjmp)
		{	ref1 = nxtjmp->jmptrip;
			ref1->operand[0] = x;
		}
コード例 #9
0
ファイル: m_do.c プロジェクト: h4ck3rm1k3/fis-gtm
int m_do(void)
{
	triple		tmpchain, *oldchain, *obp, *ref0, *tripsize,
			*triptr, *ref1, *calltrip, *routineref, *labelref;
	oprtype		*cr;
	DCL_THREADGBL_ACCESS;

	SETUP_THREADGBL_ACCESS;
	if ((TK_SPACE == window_token) || (TK_EOL == window_token))
	{
		if (!run_time)	/* DO SP SP is a noop at run time */
		{
			calltrip = newtriple(OC_CALLSP);
			calltrip->operand[0] = put_mnxl();
			calltrip->operand[1] = put_ocnt();
		}
		return TRUE;
	} else if (TK_AMPERSAND == window_token)
	{
		if (!extern_func(0))
			return FALSE;
		else
			return TRUE;
	}
	dqinit(&tmpchain, exorder);
	oldchain = setcurtchain(&tmpchain);
	calltrip = entryref(OC_CALL, OC_EXTCALL, (mint)indir_do, TRUE, FALSE, FALSE);
	setcurtchain(oldchain);
	if (!calltrip)
		return FALSE;
	if (TK_LPAREN == window_token)
	{
		if (OC_CALL == calltrip->opcode)
		{
			assert(MLAB_REF == calltrip->operand[0].oprclass);
			calltrip->opcode = OC_EXCAL;
			ref0 = newtriple(OC_PARAMETER);
			calltrip->operand[1] = put_tref(ref0);
			ref0->operand[0] = put_tsiz();	/* parm to hold size of jump codegen */
			tripsize = ref0->operand[0].oprval.tref;
			assert(OC_TRIPSIZE == tripsize->opcode);
		} else
		{
			if (OC_EXTCALL == calltrip->opcode)
			{
				assert(TRIP_REF == calltrip->operand[1].oprclass);
				if (OC_CDLIT == calltrip->operand[1].oprval.tref->opcode)
					assert(CDLT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
				else
				{
					assert(OC_LABADDR == calltrip->operand[1].oprval.tref->opcode);
					assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprclass);
					assert(OC_PARAMETER == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode);
					assert(TRIP_REF ==
						calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass);
					assert(OC_ILIT == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						operand[0].oprval.tref->opcode);
					assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						operand[0].oprval.tref->operand[0].oprclass);
					if (0 != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
						operand[0].oprval.tref->operand[0].oprval.ilit)
					{
						stx_error(ERR_ACTOFFSET);
						return FALSE;
					}
				}
			} else		/* DO _ @dlabel actuallist */
			{
				assert(OC_COMMARG == calltrip->opcode);
				assert(TRIP_REF == calltrip->operand[1].oprclass);
				assert(OC_ILIT == calltrip->operand[1].oprval.tref->opcode);
				assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
				assert((mint)indir_do == calltrip->operand[1].oprval.tref->operand[0].oprval.ilit);
				assert(calltrip->exorder.fl == &tmpchain);
				routineref = maketriple(OC_CURRHD);
				labelref = maketriple(OC_LABADDR);
				ref0 = maketriple(OC_PARAMETER);
				dqins(calltrip->exorder.bl, exorder, routineref);
				dqins(calltrip->exorder.bl, exorder, labelref);
				dqins(calltrip->exorder.bl, exorder, ref0);
				labelref->operand[0] = calltrip->operand[0];
				labelref->operand[1] = put_tref(ref0);
				ref0->operand[0] = calltrip->operand[1];
				ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0;
				ref0->operand[1] = put_tref(routineref);
				calltrip->operand[0] = put_tref(routineref);
				calltrip->operand[1] = put_tref(labelref);
			}
			calltrip->opcode = OC_EXTEXCAL;
			ref0 = newtriple(OC_PARAMETER);
			ref0->operand[0] = calltrip->operand[1];
			calltrip->operand[1] = put_tref(ref0);
		}
		if (!actuallist(&ref0->operand[1]))
			return FALSE;
	} else if (OC_CALL == calltrip->opcode)
	{
		calltrip->operand[1] = put_ocnt();
		if (TREF(for_stack_ptr) != TADR(for_stack))
		{
			if (TAREF1(for_temps, (TREF(for_stack_ptr) - TADR(for_stack))))
				calltrip->opcode = OC_FORLCLDO;
		}
	}
	if (TK_COLON == window_token)
	{
		advancewindow();
		cr = (oprtype *)mcalloc(SIZEOF(oprtype));
		if (!bool_expr((bool) FALSE, cr))
			return FALSE;
		if (TREF(expr_start) != TREF(expr_start_orig))
		{
			triptr = newtriple(OC_GVRECTARG);
			triptr->operand[0] = put_tref(TREF(expr_start));
		}
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
		if (OC_EXCAL == calltrip->opcode)
		{
			triptr = newtriple(OC_JMP);
			triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
			calltrip->operand[0].oprclass = ILIT_REF;	/* dummy placeholder */
			tripsize->operand[0].oprval.tsize->ct = triptr;
		}
		if (TREF(expr_start) != TREF(expr_start_orig))
		{
			ref0 = newtriple(OC_JMP);
			ref1 = newtriple(OC_GVRECTARG);
			ref1->operand[0] = put_tref(TREF(expr_start));
			*cr = put_tjmp(ref1);
			tnxtarg(&ref0->operand[0]);
		} else
			tnxtarg(cr);
	} else
	{
		obp = oldchain->exorder.bl;
		dqadd(obp, &tmpchain, exorder);   /*this is a violation of info hiding*/
		if (OC_EXCAL == calltrip->opcode)
		{
			triptr = newtriple(OC_JMP);
			triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
			calltrip->operand[0].oprclass = ILIT_REF;	/* dummy placeholder */
			tripsize->operand[0].oprval.tsize->ct = triptr;
		}
	}
	return TRUE;
}