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;
}
int f_order(oprtype *a, opctype op)
{
boolean_t ok, used_glvn_slot;
enum order_dir direction;
enum order_obj object;
int4 intval;
opctype gv_oc;
oprtype control_slot, dir_opr, *dir_oprptr, *next_oprptr;
short int column;
triple *oldchain, *r, *sav_dirref, *sav_gv1, *sav_gvn, *sav_lvn, *sav_ref, *share, *triptr;
triple *chain2, *obp, tmpchain2;
save_se save_state;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
oldchain = sav_dirref = NULL; /* default to no direction and no shifting indirection */
used_glvn_slot = FALSE;
sav_gv1 = TREF(curtchain);
r = maketriple(OC_NOOP); /* We'll fill in the opcode later, when we figure out what it is */
switch (TREF(window_token))
{
case TK_IDENT:
if (TK_LPAREN == TREF(director_token))
{
object = LOCAL;
ok = lvn(&r->operand[0], OC_SRCHINDX, r); /* 2nd arg causes us to mess below with return from lvn */
} else
{
object = LOCAL_NAME;
ok = TRUE;
r->operand[0] = put_str((TREF(window_ident)).addr, (TREF(window_ident)).len);
advancewindow();
}
next_oprptr = &r->operand[1];
break;
case TK_CIRCUMFLEX:
object = GLOBAL;
ok = gvn();
sav_gvn = (TREF(curtchain))->exorder.bl;
next_oprptr = &r->operand[0];
break;
case TK_ATSIGN:
object = INDIRECT;
if (SHIFT_SIDE_EFFECTS)
START_GVBIND_CHAIN(&save_state, oldchain);
ok = indirection(&r->operand[0]);
next_oprptr = &r->operand[1];
break;
default:
ok = FALSE;
break;
}
if (!ok)
{
if (NULL != oldchain)
setcurtchain(oldchain);
stx_error(ERR_VAREXPECTED);
return FALSE;
}
if (TK_COMMA != TREF(window_token))
direction = FORWARD; /* default direction */
else
{ /* two argument form: ugly logic for direction */
advancewindow();
column = source_column;
dir_oprptr = (oprtype *)mcalloc(SIZEOF(oprtype));
dir_opr = put_indr(dir_oprptr);
sav_ref = newtriple(OC_GVSAVTARG);
DISABLE_SIDE_EFFECT_AT_DEPTH; /* doing this here let's us know specifically if direction had SE threat */
if (EXPR_FAIL == expr(dir_oprptr, MUMPS_EXPR))
{
if (NULL != oldchain)
setcurtchain(oldchain);
return FALSE;
}
assert(TRIP_REF == dir_oprptr->oprclass);
triptr = dir_oprptr->oprval.tref;
if (OC_LIT == triptr->opcode)
{ /* if direction is a literal - pick it up and stop flailing about */
if (MV_IS_TRUEINT(&triptr->operand[0].oprval.mlit->v, &intval) && (1 == intval || -1 == intval))
{
direction = (1 == intval) ? FORWARD : BACKWARD;
sav_ref->opcode = OC_NOOP;
sav_ref = NULL;
} else
{ /* bad direction */
if (NULL != oldchain)
setcurtchain(oldchain);
stx_error(ERR_ORDER2);
return FALSE;
}
} else
{
direction = TBD;
sav_dirref = newtriple(OC_GVSAVTARG); /* $R reflects direction eval even if we revisit 1st arg */
triptr = newtriple(OC_GVRECTARG);
triptr->operand[0] = put_tref(sav_ref);
switch (object)
{
case GLOBAL: /* The direction may have had a side effect, so take copies of subscripts */
*next_oprptr = *dir_oprptr;
for (; sav_gvn != sav_gv1; sav_gvn = sav_gvn->exorder.bl)
{ /* hunt down the gv opcode */
gv_oc = sav_gvn->opcode;
if ((OC_GVNAME == gv_oc) || (OC_GVNAKED == gv_oc) || (OC_GVEXTNAM == gv_oc))
break;
}
assert((OC_GVNAME == gv_oc) || (OC_GVNAKED == gv_oc) || (OC_GVEXTNAM == gv_oc));
TREF(temp_subs) = TRUE;
create_temporaries(sav_gvn, gv_oc);
break;
case LOCAL: /* Additionally need to move srchindx triple to after potential side effect */
triptr = newtriple(OC_PARAMETER);
triptr->operand[0] = *next_oprptr;
triptr->operand[1] = *(&dir_opr);
*next_oprptr = put_tref(triptr);
sav_lvn = r->operand[0].oprval.tref;
assert((OC_SRCHINDX == sav_lvn->opcode) || (OC_VAR == sav_lvn->opcode));
if (OC_SRCHINDX == sav_lvn->opcode)
{
dqdel(sav_lvn, exorder);
ins_triple(sav_lvn);
TREF(temp_subs) = TRUE;
create_temporaries(sav_lvn, OC_SRCHINDX);
}
assert(&r->operand[1] == next_oprptr);
assert(TRIP_REF == next_oprptr->oprclass);
assert(OC_PARAMETER == next_oprptr->oprval.tref->opcode);
assert(TRIP_REF == next_oprptr->oprval.tref->operand[0].oprclass);
sav_lvn = next_oprptr->oprval.tref->operand[0].oprval.tref;
if ((OC_VAR == sav_lvn->opcode) || (OC_GETINDX == sav_lvn->opcode))
{ /* lvn excludes the last subscript from srchindx and attaches it to the "parent"
* now we find it is an lvn and needs protection too
*/
triptr = maketriple(OC_STOTEMP);
triptr->operand[0] = put_tref(sav_lvn);
dqins(sav_lvn, exorder, triptr); /* NOTE: violation of info hiding */
next_oprptr->oprval.tref->operand[0].oprval.tref = triptr;
}
break;
case INDIRECT: /* Save and restore the variable lookup for true left-to-right evaluation */
*next_oprptr = *dir_oprptr;
used_glvn_slot = TRUE;
dqinit(&tmpchain2, exorder);
chain2 = setcurtchain(&tmpchain2);
INSERT_INDSAVGLVN(control_slot, r->operand[0], ANY_SLOT, 1);
setcurtchain(chain2);
obp = sav_ref->exorder.bl; /* insert before second arg */
dqadd(obp, &tmpchain2, exorder);
r->operand[0] = control_slot;
break;
case LOCAL_NAME: /* left argument is a string - side effect can't screw it up */
*next_oprptr = *dir_oprptr;
break;
default:
assert(FALSE);
}
ins_triple(r);
if (used_glvn_slot)
{
triptr = newtriple(OC_GLVNPOP);
triptr->operand[0] = control_slot;
}
if (SE_WARN_ON && (TREF(side_effect_base))[TREF(expr_depth)])
ISSUE_SIDEEFFECTEVAL_WARNING(column - 1);
DISABLE_SIDE_EFFECT_AT_DEPTH; /* usual side effect processing doesn't work for $ORDER() */
}
}
if (TBD != direction)
ins_triple(r);
if (NULL != sav_dirref)
{
triptr = newtriple(OC_GVRECTARG);
triptr->operand[0] = put_tref(sav_dirref);
}
r->opcode = order_opc[object][direction]; /* finally - the op code */
if (NULL != oldchain)
PLACE_GVBIND_CHAIN(&save_state, oldchain); /* shift chain back to "expr_start" */
if (OC_FNLVNAME == r->opcode)
*next_oprptr = put_ilit(0); /* Flag not to return aliases with no value */
if (OC_INDFUN == r->opcode)
*next_oprptr = put_ilit((mint)((FORWARD == direction) ? indir_fnorder1 : indir_fnzprevious));
*a = put_tref(r);
return TRUE;
}