int indirection(oprtype *a)
{
char c;
oprtype *sb1, *sb2, subs[MAX_INDSUBSCRIPTS], x;
triple *next, *ref;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(TK_ATSIGN == TREF(window_token));
if (!(TREF(expr_depth))++)
TREF(expr_start) = TREF(expr_start_orig) = NULL;
advancewindow();
if (!expratom(a))
{
TREF(expr_depth) = 0;
return FALSE;
}
coerce(a, OCT_MVAL);
ex_tail(a);
if (!(--(TREF(expr_depth))))
TREF(shift_side_effects) = FALSE;
TREF(saw_side_effect) = TREF(shift_side_effects); /* TRUE or FALSE, at this point they're the same */
if (TK_ATSIGN == TREF(window_token))
{
advancewindow();
if (TK_LPAREN != TREF(window_token))
{
stx_error(ERR_LPARENMISSING);
return FALSE;
}
ref = maketriple(OC_INDNAME);
sb1 = sb2 = subs;
for (;;)
{
if (ARRAYTOP(subs) <= sb1)
{
stx_error(ERR_MAXNRSUBSCRIPTS);
return FALSE;
}
advancewindow();
if (EXPR_FAIL == expr(sb1++, MUMPS_EXPR))
return FALSE;
if (TK_RPAREN == (c = TREF(window_token))) /* NOTE assignment */
{
advancewindow();
break;
}
if (TK_COMMA != c)
{
stx_error(ERR_RPARENMISSING);
return FALSE;
}
}
/* store argument count...n args plus the name plus the dst*/
ref->operand[0] = put_ilit((mint)(sb1 - sb2) + 2);
ins_triple(ref);
next = newtriple(OC_PARAMETER);
next->operand[0] = *a;
ref->operand[1] = put_tref(next);
*a = put_tref(ref);
while (sb2 < sb1)
{
ref = newtriple(OC_PARAMETER);
next->operand[1] = put_tref(ref);
ref->operand[0] = *sb2++;
next = ref;
}
}
return TRUE;
}
int gvn(void)
{
triple *ref, *t1, *oldchain, tmpchain, *triptr, *s;
oprtype subscripts[MAX_GVSUBSCRIPTS], *sb1, *sb2;
boolean_t shifting, vbar, parse_status;
opctype ox;
char x;
error_def(ERR_MAXNRSUBSCRIPTS);
error_def(ERR_RPARENMISSING);
error_def(ERR_GBLNAME);
error_def(ERR_EXTGBLDEL);
error_def(ERR_GVNAKEDEXTNM);
error_def(ERR_EXPR);
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(window_token == TK_CIRCUMFLEX);
advancewindow();
sb1 = sb2 = subscripts;
ox = 0;
if (shifting = TREF(shift_side_effects))
{
dqinit(&tmpchain, exorder);
oldchain = setcurtchain(&tmpchain);
}
if (window_token == TK_LBRACKET || window_token == TK_VBAR)
{ vbar = (window_token == TK_VBAR);
advancewindow();
if (vbar)
parse_status = expr(sb1++);
else
parse_status = expratom(sb1++);
if (!parse_status)
{ stx_error(ERR_EXPR);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
if (window_token == TK_COMMA)
{
advancewindow();
if (vbar)
parse_status = expr(sb1++);
else
parse_status = expratom(sb1++);
if (!parse_status)
{ stx_error(ERR_EXPR);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
} else
*sb1++ = put_str(0,0);
if ((!vbar && window_token != TK_RBRACKET) || (vbar && window_token != TK_VBAR))
{ stx_error(ERR_EXTGBLDEL);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
advancewindow();
ox = OC_GVEXTNAM;
}
if (window_token == TK_IDENT)
{
if (!ox)
ox = OC_GVNAME;
*sb1++ = put_str(window_ident.addr, window_ident.len);
advancewindow();
} else
{ if (ox)
{
stx_error(ERR_GVNAKEDEXTNM);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
if (window_token != TK_LPAREN)
{
stx_error(ERR_GBLNAME);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
ox = OC_GVNAKED;
}
if (window_token == TK_LPAREN)
for (;;)
{
if (sb1 >= ARRAYTOP(subscripts))
{
stx_error(ERR_MAXNRSUBSCRIPTS);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
advancewindow();
if (!expr(sb1))
{
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
assert(sb1->oprclass == TRIP_REF);
s = sb1->oprval.tref;
if (s->opcode == OC_LIT)
*sb1 = make_gvsubsc(&s->operand[0].oprval.mlit->v);
sb1++;
if ((x = window_token) == TK_RPAREN)
{
advancewindow();
break;
}
if (x != TK_COMMA)
{
stx_error(ERR_RPARENMISSING);
if (shifting)
setcurtchain(oldchain);
return FALSE;
}
}
ref = newtriple(ox);
ref->operand[0] = put_ilit((mint)(sb1 - sb2));
for ( ; sb2 < sb1 ; sb2++)
{
t1 = newtriple(OC_PARAMETER);
ref->operand[1] = put_tref(t1);
ref = t1;
ref->operand[0] = *sb2;
}
if (shifting)
{
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));
}
return TRUE;
}
