Пример #1
0
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;
}
Пример #2
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;
}
Пример #3
0
Файл: exfunc.c Проект: 5HT/mumps
int exfunc (oprtype *a)
{
	triple		*ref0, *calltrip, *masktrip, *counttrip, *funret, *tripsize;
	triple		*triptr;
	triple		tmpchain, *oldchain, *obp, *routineref, *labelref;
	error_def	(ERR_ACTOFFSET);

	assert (window_token == TK_DOLLAR);
	advancewindow();
	assert (window_token == TK_DOLLAR);
	advancewindow();
	dqinit (&tmpchain, exorder);
	oldchain = setcurtchain (&tmpchain);
	calltrip = entryref (OC_EXFUN, OC_EXTEXFUN, INDIR_DUMMY, TRUE, TRUE);
	setcurtchain (oldchain);
	if (!calltrip) return FALSE;
	if (calltrip->opcode == OC_EXFUN)
	{
		assert(calltrip->operand[0].oprclass == MLAB_REF);
		ref0 = newtriple(OC_PARAMETER);
		ref0->operand[0] = put_tsiz();		/* Need size of following code gen triple here */
		calltrip->operand[1] = put_tref(ref0);
		tripsize = ref0->operand[0].oprval.tref;
		assert(OC_TRIPSIZE == tripsize->opcode);
	}
	else
	{
		if (calltrip->opcode == OC_EXTEXFUN)
		{
			assert (calltrip->operand[1].oprclass == TRIP_REF);
			if (calltrip->operand[1].oprval.tref->opcode == OC_CDLIT)
				assert (calltrip->operand[1].oprval.tref->operand[0].oprclass == CDLT_REF);
			else
			{
			assert (calltrip->operand[1].oprval.tref->opcode == OC_LABADDR);
			assert (calltrip->operand[1].oprval.tref->operand[1].oprclass == TRIP_REF);
			assert (calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode == OC_PARAMETER);
			assert (calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass == TRIP_REF);
			assert (calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprval.tref->opcode
				== OC_ILIT);
			assert
			(calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprclass
				== ILIT_REF);
			if
			(calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprval.ilit
				!= 0)
				{
					stx_error (ERR_ACTOFFSET);
					return FALSE;
				}
			}
		}
		else		/* $$ @dlabel [actuallist] */
		{
			assert (calltrip->opcode == OC_COMMARG);
			assert (calltrip->operand[1].oprclass == TRIP_REF);
			assert (calltrip->operand[1].oprval.tref->opcode == OC_ILIT);
			assert (calltrip->operand[1].oprval.tref->operand[0].oprclass == ILIT_REF);
			assert (calltrip->operand[1].oprval.tref->operand[0].oprval.ilit == INDIR_DUMMY);
			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_EXTEXFUN;
		}
		ref0 = newtriple (OC_PARAMETER);
		ref0->operand[0] = calltrip->operand[1];
		calltrip->operand[1] = put_tref (ref0);
	}
	if (window_token != TK_LPAREN)
	{
		masktrip = newtriple (OC_PARAMETER);
		counttrip = newtriple (OC_PARAMETER);
		masktrip->operand[0] = put_ilit (0);
		counttrip->operand[0] = put_ilit (0);
		masktrip->operand[1] = put_tref (counttrip);
		ref0->operand[1] = put_tref (masktrip);
	}
	else
		if (!actuallist (&ref0->operand[1])) return FALSE;
	obp = oldchain->exorder.bl;
	dqadd (obp, &tmpchain, exorder);		/*this is a violation of info hiding*/
	if (calltrip->opcode == OC_EXFUN)
	{
		assert(calltrip->operand[0].oprclass == MLAB_REF);
		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;
	}

	funret = newtriple (OC_EXFUNRET);
	funret->operand[0] = *a = put_tref (calltrip);
	return TRUE;
}
Пример #4
0
int exfunc(oprtype *a, boolean_t alias_target)
{
	triple		*calltrip, *calltrip_opr1_tref, *counttrip, *funret, *labelref, *masktrip;
	triple		*oldchain, *ref0, *routineref, tmpchain, *triptr;
#	if defined(USHBIN_SUPPORTED) || defined(VMS)
	triple		*tripsize;
#	endif

	assert(TK_DOLLAR == window_token);
	advancewindow();
	dqinit(&tmpchain, exorder);
	oldchain = setcurtchain(&tmpchain);
	calltrip = entryref(OC_EXFUN, OC_EXTEXFUN, INDIR_DUMMY, TRUE, TRUE, FALSE);
	setcurtchain(oldchain);
	if (!calltrip)
		return FALSE;
	if (OC_EXFUN == calltrip->opcode)
	{
		assert(MLAB_REF == calltrip->operand[0].oprclass);
#		if defined(USHBIN_SUPPORTED) || defined(VMS)
		ref0 = newtriple(OC_PARAMETER);
		ref0->operand[0] = put_tsiz();		/* Need size of following code gen triple here */
		calltrip->operand[1] = put_tref(ref0);
		tripsize = ref0->operand[0].oprval.tref;
		assert(OC_TRIPSIZE == tripsize->opcode);
#		else
		ref0 = calltrip;
#		endif
	} else
	{
		calltrip_opr1_tref = calltrip->operand[1].oprval.tref;
		if (OC_EXTEXFUN == calltrip->opcode)
		{
			assert(TRIP_REF == calltrip->operand[1].oprclass);
			if (OC_CDLIT == calltrip_opr1_tref->opcode)
				assert(CDLT_REF == calltrip_opr1_tref->operand[0].oprclass);
			else
			{
				assert(OC_LABADDR == calltrip_opr1_tref->opcode);
				assert(TRIP_REF == calltrip_opr1_tref->operand[1].oprclass);
				assert(OC_PARAMETER == calltrip_opr1_tref->operand[1].oprval.tref->opcode);
				assert(TRIP_REF == calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprclass);
				assert(OC_ILIT == calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprval.tref->opcode);
				assert(ILIT_REF
				       == calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprclass);
				if (0 != calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprval.ilit)
				{
					stx_error(ERR_ACTOFFSET);
					return FALSE;
				}
			}
		} else		/* $$ @dlabel [actuallist] */
		{
			assert(OC_COMMARG == calltrip->opcode);
			assert(TRIP_REF == calltrip->operand[1].oprclass);
			assert(OC_ILIT == calltrip_opr1_tref->opcode);
			assert(ILIT_REF == calltrip_opr1_tref->operand[0].oprclass);
			assert(INDIR_DUMMY == calltrip_opr1_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_EXTEXFUN;
		}
		ref0 = newtriple(OC_PARAMETER);
		ref0->operand[0] = calltrip->operand[1];
		calltrip->operand[1] = put_tref(ref0);
	}
	if (TK_LPAREN != window_token)
	{
		masktrip = newtriple(OC_PARAMETER);
		counttrip = newtriple(OC_PARAMETER);
		masktrip->operand[0] = put_ilit(0);
		counttrip->operand[0] = put_ilit(0);
		masktrip->operand[1] = put_tref(counttrip);
		ref0->operand[1] = put_tref(masktrip);
	} else
		if (!actuallist(&ref0->operand[1]))
			return FALSE;
	triptr = oldchain->exorder.bl;
	dqadd(triptr, &tmpchain, exorder);		/*this is a violation of info hiding*/
	if (OC_EXFUN == calltrip->opcode)
	{
		assert(MLAB_REF == calltrip->operand[0].oprclass);
		triptr = newtriple(OC_JMP);
		triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
		calltrip->operand[0].oprclass = ILIT_REF;	/* dummy placeholder */
#		if defined(USHBIN_SUPPORTED) || defined(VMS)
		tripsize->operand[0].oprval.tsize->ct = triptr;
#		endif
	}
	/* If target is an alias, use special container-expecting routine OC_EXFUNRETALS, else regular OC_EXFUNRET */
	funret = newtriple((alias_target ? OC_EXFUNRETALS : OC_EXFUNRET));
	funret->operand[0] = *a = put_tref(calltrip);
	return TRUE;
}
Пример #5
0
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
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;
}
Пример #7
0
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;
}