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;
}
void op_indfun(mval *v, mint code, mval *dst)
{
bool rval;
mstr *obj, object;
oprtype x;
unsigned char argcode;
error_def(ERR_INDMAXNEST);
argcode = (unsigned char)code;
assert(UCHAR_MAX >= code); /* if not, the assignment to argcode is lossy */
assert(indir_opcode[argcode]);
MV_FORCE_STR(v);
if (!(obj = cache_get(argcode, &v->str)))
{
comp_init(&v->str);
rval = (*indir_fcn[argcode])(&x, indir_opcode[argcode]);
if (!comp_fini(rval, &object, OC_IRETMVAL, &x, v->str.len))
return;
cache_put(argcode, &v->str, &object);
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(&object);
return;
}
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(obj);
return;
}
void op_indpat(mval *v, mval *dst)
{
bool rval;
mstr *obj, object;
oprtype x;
error_def(ERR_INDMAXNEST);
MV_FORCE_STR(v);
if (!(obj = cache_get(indir_pattern, &v->str)))
{
comp_init(&v->str);
source_column = 1; /* to coordinate with scanner redirection*/
rval = compile_pattern(&x,window_token == TK_ATSIGN);
if (comp_fini(rval, &object, OC_IRETMVAL, &x, v->str.len))
{
cache_put(indir_pattern, &v->str, &object);
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(&object);
}
}
else
{
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(obj);
}
}
void op_indglvn(mval *v,mval *dst)
{
bool rval;
mstr *obj, object;
oprtype x;
lv_val *a;
icode_str indir_src;
lv_val *lv;
var_tabent targ_key;
ht_ent_mname *tabent;
error_def(ERR_INDMAXNEST);
error_def(ERR_UNDEF);
MV_FORCE_STR(v);
indir_src.str = v->str;
indir_src.code = indir_glvn;
if (NULL == (obj = cache_get(&indir_src)))
{
if (valid_mname(&v->str))
{
targ_key.var_name = v->str;
COMPUTE_HASH_MNAME(&targ_key);
tabent = lookup_hashtab_mname(&curr_symval->h_symtab, &targ_key);
assert(NULL == tabent || NULL != tabent->value);
if (!tabent || !MV_DEFINED(&((lv_val *)tabent->value)->v))
{
if (undef_inhibit)
{
*dst = literal_null;
return;
}
else
rts_error(VARLSTCNT(4) ERR_UNDEF, 2, v->str.len, v->str.addr);
}
a = (lv_val *)tabent->value;
*dst = a->v;
return;
}
comp_init(&v->str);
rval = glvn(&x);
if (comp_fini(rval, &object, OC_IRETMVAL, &x, v->str.len))
{
indir_src.str.addr = v->str.addr;
cache_put(&indir_src, &object);
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(&object);
}
}
else
{
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(obj);
}
}
void op_indrzshow(mval *s1,mval *s2)
{
mstr object;
bool rval;
oprtype v;
triple *src, *r, *outtype, *lvar;
error_def(ERR_VAREXPECTED);
error_def(ERR_INDMAXNEST);
comp_init(&s2->str);
src = maketriple(OC_IGETSRC);
ins_triple(src);
switch(window_token)
{
case TK_CIRCUMFLEX:
if (rval = gvn())
{ r = maketriple(OC_ZSHOW);
outtype = newtriple(OC_PARAMETER);
r->operand[1] = put_tref(outtype);
r->operand[0] = put_tref(src);
outtype->operand[0] = put_ilit(ZSHOW_GLOBAL);
ins_triple(r);
}
break;
case TK_IDENT:
if (rval = lvn(&v, OC_PUTINDX, 0))
{ r = maketriple(OC_ZSHOWLOC);
outtype = newtriple(OC_PARAMETER);
r->operand[1] = put_tref(outtype);
r->operand[0] = put_tref(src);
lvar = newtriple(OC_PARAMETER);
outtype->operand[1] = put_tref(lvar);
lvar->operand[0] = v;
outtype->operand[0] = put_ilit(ZSHOW_LOCAL);
ins_triple(r);
}
break;
case TK_ATSIGN:
if (rval = indirection(&v))
{ r = newtriple(OC_INDRZSHOW);
r->operand[0] = put_tref(src);
r->operand[1] = v;
}
break;
default:
stx_error(ERR_VAREXPECTED);
break;
}
if (comp_fini(rval, &object, OC_RET, 0, s2->str.len))
{ cache_put(indir_zshow, &s2->str, &object);
*ind_source_sp++ = s1;
if (ind_source_sp >= ind_source_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(&object);
}
return;
}
void op_indlvadr(mval *target)
{
error_def(ERR_VAREXPECTED);
bool rval;
mstr object, *obj;
oprtype v;
triple *s;
MV_FORCE_STR(target);
if (!(obj = cache_get(indir_lvadr, &target->str)))
{
comp_init(&target->str);
switch (window_token)
{
case TK_IDENT:
rval = lvn(&v, OC_PUTINDX, 0);
if (comp_fini(rval, &object, OC_IRETMVAD, &v, target->str.len))
{ cache_put(indir_lvadr, &target->str, &object);
comp_indr(&object);
}
break;
case TK_ATSIGN:
if (rval = indirection(&v))
{
s = newtriple(OC_INDLVADR);
s->operand[0] = v;
v = put_tref(s);
if (comp_fini(rval, &object, OC_IRETMVAD, &v, target->str.len))
{ cache_put(indir_lvadr, &target->str, &object);
comp_indr(&object);
}
}
break;
default:
stx_error(ERR_VAREXPECTED);
break;
}
}
else
{
comp_indr(obj);
}
}
void op_indlvarg(mval *v, mval *dst)
{
bool rval;
mstr *obj, object;
oprtype x;
triple *ref;
icode_str indir_src;
error_def(ERR_INDMAXNEST);
error_def(ERR_VAREXPECTED);
MV_FORCE_STR(v);
if (v->str.len < 1)
rts_error(VARLSTCNT(1) ERR_VAREXPECTED);
if (valid_mname(&v->str))
{
*dst = *v;
dst->mvtype &= ~MV_ALIASCONT; /* Make sure alias container property does not pass */
return;
}
if (*v->str.addr == '@')
{
indir_src.str = v->str;
indir_src.code = indir_lvarg;
if (NULL == (obj = cache_get(&indir_src)))
{
object.addr = v->str.addr;
object.len = v->str.len;
comp_init(&object);
if (rval = indirection(&x))
{
ref = newtriple(OC_INDLVARG);
ref->operand[0] = x;
x = put_tref(ref);
}
if (comp_fini(rval, &object, OC_IRETMVAL, &x, object.len))
{
indir_src.str.addr = v->str.addr;
cache_put(&indir_src, &object);
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(&object);
return;
}
} else
{
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
comp_indr(obj);
return;
}
}
rts_error(VARLSTCNT(1) ERR_VAREXPECTED);
}
void op_commarg(mval *v, unsigned char argcode)
{
bool rval;
mstr *obj, object;
icode_str indir_src;
error_def (ERR_INDEXTRACHARS);
MV_FORCE_STR(v);
assert(argcode >=3 && argcode < SIZEOF(indir_fcn) / SIZEOF(indir_fcn[0]));
indir_src.str = v->str;
indir_src.code = argcode;
if (NULL == (obj = cache_get(&indir_src)))
{
if (((indir_do == argcode) || (indir_goto == argcode)) &&
(frame_pointer->type & SFT_COUNT) && v->str.len && (v->str.len < MAX_MIDENT_LEN) &&
!proc_act_type && do_indir_do(v, argcode))
{
return;
}
comp_init(&v->str);
for (;;)
{
if (!(rval = (*indir_fcn[argcode])()))
break;
if (TK_EOL == window_token)
break;
if (TK_COMMA == window_token)
advancewindow();
else
{ /* Allow trailing spaces/comments that we will ignore */
while (TK_SPACE == window_token)
advancewindow();
if (TK_EOL == window_token)
break;
rts_error(VARLSTCNT(1) ERR_INDEXTRACHARS);
}
}
if (comp_fini(rval, &object, OC_RET, 0, v->str.len))
{
indir_src.str.addr = v->str.addr; /* we reassign because v->str.addr
might have been changed by stp_gcol() */
cache_put(&indir_src, &object);
comp_indr(&object);
if (indir_linetail == argcode)
frame_pointer->type = SFT_COUNT;
}
} else
{
comp_indr(obj);
if (indir_linetail == argcode)
frame_pointer->type = SFT_COUNT;
}
}
void op_indlvarg(mval *v, mval *dst)
{
icode_str indir_src;
int rval;
mstr *obj, object;
oprtype x;
triple *ref;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if (TREF(ind_result_sp) >= TREF(ind_result_top))
rts_error(VARLSTCNT(1) ERR_INDMAXNEST); /* mdbcondition_handler resets ind_result_sp */
MV_FORCE_STR(v);
if (v->str.len < 1)
rts_error(VARLSTCNT(1) ERR_VAREXPECTED);
if (valid_mname(&v->str))
{
*dst = *v;
dst->mvtype &= ~MV_ALIASCONT; /* Make sure alias container property does not pass */
return;
}
if (*v->str.addr != '@')
rts_error(VARLSTCNT(1) ERR_VAREXPECTED);
indir_src.str = v->str;
indir_src.code = indir_lvarg;
if (NULL == (obj = cache_get(&indir_src)))
{
obj = &object;
obj->addr = v->str.addr;
obj->len = v->str.len;
comp_init(obj);
if (EXPR_FAIL != (rval = indirection(&x))) /* NOTE assignment */
{
ref = newtriple(OC_INDLVARG);
ref->operand[0] = x;
x = put_tref(ref);
}
if (EXPR_FAIL == comp_fini(rval, obj, OC_IRETMVAL, &x, obj->len))
return;
indir_src.str.addr = v->str.addr;
cache_put(&indir_src, obj);
/* Fall into code activation below */
}
*(TREF(ind_result_sp))++ = dst; /* Where to store return value */
comp_indr(obj);
return;
}
void op_inddevparms(mval *devpsrc, int4 ok_iop_parms, mval *devpiopl)
{
int rval;
icode_str indir_src;
mstr *obj, object;
oprtype devpopr, plist, getdst;
triple *indref;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
MV_FORCE_STR(devpsrc);
indir_src.str = devpsrc->str;
indir_src.code = indir_devparms;
if (NULL == (obj = cache_get(&indir_src))) /* NOTE assignment */
{ /* No cached version, compile it now */
obj = &object;
comp_init(&devpsrc->str, &getdst);
if (TK_ATSIGN == TREF(window_token))
{ /* For the indirection-obsessive */
if (EXPR_FAIL != (rval = indirection(&devpopr))) /* NOTE assignment */
{
indref = newtriple(OC_INDDEVPARMS);
indref->operand[0] = devpopr;
indref->operand[1] = put_ilit(ok_iop_parms);
plist = put_tref(indref);
}
} else /* We have the parm string to process now */
rval = deviceparameters(&plist, ok_iop_parms);
if (EXPR_FAIL == comp_fini(rval, obj, OC_IRETMVAL, &plist, &getdst, devpsrc->str.len))
return;
indir_src.str.addr = devpsrc->str.addr;
cache_put(&indir_src, obj);
/* Fall into code activation below */
}
TREF(ind_result) = devpiopl; /* Where to store return value */
comp_indr(obj);
return;
}
void op_indtext(mval *lab, mint offset, mval *rtn, mval *dst)
{
bool rval;
mstr *obj, object;
mval mv_off;
oprtype opt;
triple *ref;
icode_str indir_src;
error_def(ERR_INDMAXNEST);
error_def(ERR_STACKOFLOW);
error_def(ERR_STACKCRIT);
MV_FORCE_STR(lab);
indir_src.str.len = lab->str.len;
indir_src.str.len += SIZEOF("+^") - 1;
indir_src.str.len += MAX_NUM_SIZE;
indir_src.str.len += rtn->str.len;
ENSURE_STP_FREE_SPACE(indir_src.str.len);
DBG_MARK_STRINGPOOL_UNEXPANDABLE; /* Now that we have ensured enough space in the stringpool, we dont expect any more
* garbage collections or expansions until we are done with the below initialization.
*/
/* Push an mval pointing to the complete entry ref on to the stack so the string is valid even
* if garbage collection occurs before cache_put() */
PUSH_MV_STENT(MVST_MVAL);
mv_chain->mv_st_cont.mvs_mval.mvtype = 0; /* so stp_gcol (if invoked below) does not get confused by this otherwise
* incompletely initialized mval in the M-stack */
mv_chain->mv_st_cont.mvs_mval.str.addr = (char *)stringpool.free;
memcpy(stringpool.free, lab->str.addr, lab->str.len);
stringpool.free += lab->str.len;
*stringpool.free++ = '+';
MV_FORCE_MVAL(&mv_off, offset);
MV_FORCE_STRD(&mv_off); /* goes at stringpool.free. we already made enough space in the stp_gcol() call */
*stringpool.free++ = '^';
memcpy(stringpool.free, rtn->str.addr, rtn->str.len);
stringpool.free += rtn->str.len;
mv_chain->mv_st_cont.mvs_mval.str.len = INTCAST(stringpool.free - (unsigned char*)mv_chain->mv_st_cont.mvs_mval.str.addr);
mv_chain->mv_st_cont.mvs_mval.mvtype = MV_STR; /* initialize mvtype now that mval has been otherwise completely set up */
DBG_MARK_STRINGPOOL_EXPANDABLE; /* Now that we are done with stringpool.free initializations, mark as free for expansion */
indir_src.str = mv_chain->mv_st_cont.mvs_mval.str;
indir_src.code = indir_text;
if (NULL == (obj = cache_get(&indir_src)))
{
comp_init(&indir_src.str);
rval = f_text(&opt, OC_FNTEXT);
if (!comp_fini(rval, &object, OC_IRETMVAL, &opt, indir_src.str.len))
{
assert(mv_chain->mv_st_type == MVST_MVAL);
POP_MV_STENT();
return;
}
indir_src.str.addr = mv_chain->mv_st_cont.mvs_mval.str.addr;
cache_put(&indir_src, &object);
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
assert(mv_chain->mv_st_type == MVST_MVAL);
POP_MV_STENT(); /* unwind the mval entry before the new frame gets added by comp_indir below */
comp_indr(&object);
return;
}
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
assert(mv_chain->mv_st_type == MVST_MVAL);
POP_MV_STENT(); /* unwind the mval entry before the new frame gets added by comp_indir below */
comp_indr(obj);
return;
}
void op_indlvadr(mval *target)
{
boolean_t rval;
char *ptr;
icode_str indir_src;
mname_entry *targ_key;
mstr object, *obj;
mval *saved_indx;
oprtype v;
triple *s;
uint4 align_padlen, len;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
MV_FORCE_STR(target);
indir_src.str = target->str;
indir_src.code = indir_lvadr;
saved_indx = NULL;
if (NULL == (obj = cache_get(&indir_src)))
{
comp_init(&target->str);
switch (window_token)
{
case TK_IDENT:
rval = lvn(&v, OC_SAVPUTINDX, NULL);
s = v.oprval.tref; /* this ugliness serves to return a flag compiled code can use to adjust flow */
if (OC_SAVPUTINDX != s->opcode)
{ /* this block grabs a way to look up the name later and is similar to some code in op_savputindx */
assert(MVAR_REF == s->operand->oprclass);
saved_indx = (mval *)malloc(SIZEOF(mval) + SIZEOF(mname_entry) + SIZEOF(mident_fixed));
saved_indx->mvtype = MV_STR;
ptr = (char *)saved_indx + SIZEOF(mval);
saved_indx->str.addr = ptr;
targ_key = (mname_entry *)ptr;
ptr += SIZEOF(mname_entry);
targ_key->var_name.addr = ptr;
len = s->operand[0].oprval.vref->mvname.len;
assert(SIZEOF(mident_fixed) > len);
memcpy(ptr, s->operand[0].oprval.vref->mvname.addr, len);
targ_key->var_name.len = len;
saved_indx->str.len = SIZEOF(mname_entry) + len;
COMPUTE_HASH_MNAME(targ_key);
targ_key->marked = FALSE;
MANAGE_FOR_INDX(frame_pointer, TREF(for_nest_level), saved_indx);
}
break;
case TK_ATSIGN:
if (rval = indirection(&v))
{ /* if the indirection nests, for_ctrl_indr_subs doesn't matter until we get the "real" lvn */
s = newtriple(OC_INDLVADR);
s->operand[0] = v;
v = put_tref(s);
}
break;
default:
stx_error(ERR_VAREXPECTED);
break;
}
if (comp_fini(rval, &object, OC_IRETMVAD, &v, target->str.len))
{ /* before cache and execute, tack a little something on at end of object */
assert(indir_src.str.addr == target->str.addr);
len = SIZEOF(uint4) * 2;
if (NULL != saved_indx)
len += SIZEOF(mval) + SIZEOF(mname_entry) + SIZEOF(mident_fixed); /* overlength, but ends aligned */
align_padlen = mstr_native_align ? PADLEN(stringpool.free, NATIVE_WSIZE) : 0;
len += align_padlen;
ptr = object.addr + object.len + align_padlen;
assert((char *)stringpool.free - align_padlen == ptr);
assert(ptr + len <= (char *)stringpool.top); /* ind_code, called by comp_fini, reserves to prevent gc */
if (NULL != saved_indx)
{ /* it's an unsubscripted name, so save the name infomation with the cached object */
memcpy(ptr, (char *)saved_indx, SIZEOF(mval) + saved_indx->str.len);
ptr += (len - (SIZEOF(uint4) * 2));
*(uint4 *)ptr = align_padlen;
}
ptr += SIZEOF(uint4);
*(uint4 *)ptr = len;
stringpool.free += len;
assert((ptr + SIZEOF(uint4)) == (char *)stringpool.free);
object.len += len;
cache_put(&indir_src, &object); /* this copies the "extended" object to the cache */
comp_indr(&object);
}
} else
{ /* if cached, the object has stuff at the end that might need pulling into the run-time context */
ptr = (char *)(obj->addr + obj->len);
len = *(uint4 *)(ptr - SIZEOF(uint4));
if (SIZEOF(mval) < len) /* not nested and not subscripted ? */
{ /* grab the name information at the end of the cached indirect object and copy it to be useful to FOR */
align_padlen = *(uint4 *)(ptr - (SIZEOF(uint4) * 2));
assert(NATIVE_WSIZE > align_padlen);
assert(SIZEOF(mval) + SIZEOF(mname_entry) + SIZEOF(mident_fixed) + (SIZEOF(uint4) * 2)
+ NATIVE_WSIZE > len);
ptr -= (len + align_padlen);
saved_indx = (mval *)ptr;
assert(MV_STR == saved_indx->mvtype);
len = SIZEOF(mval) + saved_indx->str.len;
ptr = malloc(len);
memcpy(ptr, (char *)saved_indx, len);
saved_indx = (mval *)ptr;
ptr += SIZEOF(mval);
saved_indx->str.addr = ptr;
assert(MAX_MIDENT_LEN >= ((mname_entry *)(saved_indx->str.addr))->var_name.len);
assert((SIZEOF(mname_entry) + ((mname_entry *)(saved_indx->str.addr))->var_name.len)
== saved_indx->str.len);
ptr += SIZEOF(mname_entry);
((mname_entry *)(saved_indx->str.addr))->var_name.addr = ptr;
len = SIZEOF(mval) + SIZEOF(mname_entry) + SIZEOF(mident_fixed) + (SIZEOF(uint4) * 2);
assert(*(uint4 *)(obj->addr + obj->len - SIZEOF(uint4)) == len);
MANAGE_FOR_INDX(frame_pointer, TREF(for_nest_level), saved_indx);
}
comp_indr(obj);
}
return;
}
void op_indget(mval *dst, mval *target, mval *value)
{
icode_str indir_src;
int rval;
ht_ent_mname *tabent;
mstr *obj, object;
oprtype v;
triple *s, *src, *oldchain, tmpchain, *r, *triptr;
var_tabent targ_key;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if ((TREF(ind_source_sp) >= TREF(ind_source_top)) || (TREF(ind_result_sp) >= TREF(ind_result_top)))
rts_error(VARLSTCNT(1) ERR_INDMAXNEST); /* mdbcondition_handler resets ind_result_sp & ind_source_sp */
MV_FORCE_DEFINED(value);
MV_FORCE_STR(target);
indir_src.str = target->str;
indir_src.code = indir_get;
if (NULL == (obj = cache_get(&indir_src)))
{
obj = &object;
if (valid_mname(&target->str))
{
targ_key.var_name = target->str;
COMPUTE_HASH_MNAME(&targ_key);
tabent = lookup_hashtab_mname(&curr_symval->h_symtab, &targ_key);
if (!tabent || !LV_IS_VAL_DEFINED(tabent->value))
*dst = *value;
else
*dst = ((lv_val *)tabent->value)->v;
dst->mvtype &= ~MV_ALIASCONT; /* Make sure alias container property does not pass */
return;
}
comp_init(&target->str);
src = newtriple(OC_IGETSRC);
switch (TREF(window_token))
{
case TK_IDENT:
if (EXPR_FAIL != (rval = lvn(&v, OC_SRCHINDX, 0))) /* NOTE assignment */
{
s = newtriple(OC_FNGET2);
s->operand[0] = v;
s->operand[1] = put_tref(src);
}
break;
case TK_CIRCUMFLEX:
if (EXPR_FAIL != (rval = gvn())) /* NOTE assignment */
{
r = newtriple(OC_FNGVGET1);
s = newtriple(OC_FNGVGET2);
s->operand[0] = put_tref(r);
s->operand[1] = put_tref(src);
}
break;
case TK_ATSIGN:
TREF(saw_side_effect) = TREF(shift_side_effects);
if (TREF(shift_side_effects) && (GTM_BOOL == TREF(gtm_fullbool)))
{
dqinit(&tmpchain, exorder);
oldchain = setcurtchain(&tmpchain);
if (EXPR_FAIL != (rval = indirection(&v))) /* NOTE assignment */
{
s = newtriple(OC_INDGET);
s->operand[0] = v;
s->operand[1] = put_tref(src);
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));
} else
setcurtchain(oldchain);
} else
{
if (EXPR_FAIL != (rval = indirection(&v))) /* NOTE assignment */
{
s = newtriple(OC_INDGET);
s->operand[0] = v;
s->operand[1] = put_tref(src);
}
}
break;
default:
stx_error(ERR_VAREXPECTED);
rval = EXPR_FAIL;
break;
}
v = put_tref(s);
if (EXPR_FAIL == comp_fini(rval, obj, OC_IRETMVAL, &v, target->str.len))
return;
indir_src.str.addr = target->str.addr;
cache_put(&indir_src, obj);
/* Fall into code activation below */
}
*(TREF(ind_result_sp))++ = dst;
*(TREF(ind_source_sp))++ = value;
comp_indr(obj);
return;
}
void op_indrzshow(mval *s1, mval *s2)
{
icode_str indir_src;
int rval;
mstr *obj, object;
oprtype v;
triple *lvar, *outtype, *r, *src;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if (TREF(ind_source_sp) >= TREF(ind_source_top))
rts_error(VARLSTCNT(1) ERR_INDMAXNEST); /* mdbcondition_handler resets ind_source_sp */
MV_FORCE_STR(s2);
indir_src.str = s2->str;
indir_src.code = indir_zshow;
if (NULL == (obj = cache_get(&indir_src)))
{
obj = &object;
comp_init(&s2->str);
src = maketriple(OC_IGETSRC);
ins_triple(src);
switch(TREF(window_token))
{
case TK_CIRCUMFLEX:
if (EXPR_FAIL != (rval = gvn())) /* NOTE assignment */
{
r = maketriple(OC_ZSHOW);
outtype = newtriple(OC_PARAMETER);
r->operand[1] = put_tref(outtype);
r->operand[0] = put_tref(src);
outtype->operand[0] = put_ilit(ZSHOW_GLOBAL);
ins_triple(r);
}
break;
case TK_IDENT:
if (EXPR_FAIL != (rval = lvn(&v, OC_PUTINDX, 0))) /* NOTE assignment */
{
r = maketriple(OC_ZSHOWLOC);
outtype = newtriple(OC_PARAMETER);
r->operand[1] = put_tref(outtype);
r->operand[0] = put_tref(src);
lvar = newtriple(OC_PARAMETER);
outtype->operand[1] = put_tref(lvar);
lvar->operand[0] = v;
outtype->operand[0] = put_ilit(ZSHOW_LOCAL);
ins_triple(r);
}
break;
case TK_ATSIGN:
if (EXPR_FAIL != (rval = indirection(&v))) /* NOTE assignment */
{
r = newtriple(OC_INDRZSHOW);
r->operand[0] = put_tref(src);
r->operand[1] = v;
}
break;
default:
stx_error(ERR_VAREXPECTED);
rval = EXPR_FAIL;
break;
}
if (EXPR_FAIL == comp_fini(rval, obj, OC_RET, 0, s2->str.len))
return;
indir_src.str = s2->str;
indir_src.code = indir_zshow;
cache_put(&indir_src, obj);
/* Fall into code activation below */
}
*(TREF(ind_source_sp))++ = s1; /* Where to store return value */
comp_indr(obj);
return;
}