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_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_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_zrupdate(int argcnt, ...)
{
mval *objfilespec;
va_list var;
mval objpath;
char tranbuf[MAX_FBUFF + 1], *chptr, chr;
open_relinkctl_sgm *linkctl;
relinkrec_t *rec;
plength plen;
int status, fextlen, fnamlen, fcnt;
parse_blk pblk;
struct stat outbuf;
int stat_res;
boolean_t seenfext, fileexists;
mstr objdir, rtnname;
uint4 hash, prev_hash_index;
/* Currently only expecting one value per invocation right now. That will change in phase 2 hence the stdarg setup */
va_start(var, argcnt);
assert(1 == argcnt);
objfilespec = va_arg(var, mval *);
va_end(var);
MV_FORCE_STR(objfilespec);
/* First some pre-processing to determine if an explicit file name or type was specified. If so, it must be ".o" for
* this phase of implementation. Later phases may allow ".m" to be specified but not initially. Use parse_file() to
* parse everything out and isolate any extention.
*/
memset(&pblk, 0, SIZEOF(pblk));
pblk.buffer = tranbuf;
pblk.buff_size = (unsigned char)(MAX_FBUFF); /* Pass size of buffer - 1 (standard protocol for parse_file) */
pblk.def1_buf = DOTOBJEXT; /* Default .o file type if not specified */
pblk.def1_size = SIZEOF(DOTOBJEXT) - 1;
pblk.fop = F_SYNTAXO; /* Syntax check only - bypass directory existence check */
status = parse_file(&objfilespec->str, &pblk);
if (ERR_PARNORMAL != status)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(5) ERR_FILEPARSE, 2, objfilespec->str.len, objfilespec->str.addr, status);
tranbuf[pblk.b_esl] = '\0'; /* Needed for subsequent STAT_FILE */
seenfext = FALSE;
if (0 != pblk.b_ext)
{ /* If a file extension was specified - get the extension sans any potential wildcard character */
for (chptr = pblk.l_ext + 1, fextlen = pblk.b_ext - 1; 0 < fextlen; chptr++, fextlen--)
{ /* Check each character in the extension except first which is the dot if ext exists at all */
if (WILDCARD != *chptr)
{ /* We see a char that isn't a wildcard character. If we've already seen our "o" file extension,
* this char makes our requirement filetype impossible so raise an error.
*/
if (seenfext || (OBJEXT != *chptr))
/* No return from this error */
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) ERR_FILEPARSE,
2, objfilespec->str.len, objfilespec->str.addr,
ERR_TEXT, 2, RTS_ERROR_TEXT("Unsupported filetype specified"));
seenfext = TRUE;
}
}
}
/* Do a simlar check for the file type */
if (0 != pblk.b_name)
{ /* A file name was specified (if not, tiz probably hard to find the file but that can be dealt with later).
* Like in the above, the name must be comprised of valid chars for routine names.
*/
for (chptr = pblk.l_name, fnamlen = pblk.b_name; 0 < fnamlen; chptr++, fnamlen--)
{
if (WILDCARD != *chptr)
{ /* Substitute '%' for '_'. While this substitution is really only valid on the first char, only the
* first char check allows "%" so a 2nd or later char check would fail the '%' substitution anyway.
*/
chr = ('_' == *chptr) ? '%' : *chptr;
/* We see a char that isn't a wildcard character. If this is the first character, it can be
* alpha or percent. If the second or later character, it can be alphanumeric.
*/
if (((fnamlen != pblk.b_name) && !VALID_MNAME_NFCHAR(chr)) /* 2nd char or later check */
|| ((fnamlen == pblk.b_name) && !VALID_MNAME_FCHAR(chr))) /* 1st char check */
{
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) ERR_FILEPARSE,
2, objfilespec->str.len, objfilespec->str.addr,
ERR_TEXT, 2, RTS_ERROR_TEXT("Filename is not a valid routine name"));
}
}
}
}
/* When specifying a non-wildcarded object file, it is possible for the file to have been removed, in which case we still
* need to update its relinkctl entry (if exists) to notify other processes about the object's deletion.
*/
if (!(pblk.fnb & F_WILD) & seenfext)
{ /* If no wildcards in path and saw the extension we want - no need to wash through zsearch() */
objdir.addr = pblk.l_dir;
objdir.len = pblk.b_dir;
linkctl = relinkctl_attach(&objdir); /* Create/attach/open relinkctl file */
if (NULL == linkctl) /* Non-existant path and no associated relinkctl file */
/* Note this reference to errno depends on nothing in relinkctl_attach() doing anything to modify
* errno after the realpath() call. No return from this error.
*/
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(5) ERR_FILEPARSE, 2, objfilespec->str.len, objfilespec->str.addr,
errno);
/* What we do at this point depends on the following conditions:
*
* 1) If the specified file exists, we can add it to relinkctl file and/or update its cycle.
* 2) If the file doesn't exist on disk but the routine is found in the relinkctl file, update cycle.
* 3) If no file and no entry, just ignore it and do nothing (info error removed by request).
*/
STAT_FILE(tranbuf, &outbuf, stat_res);
if (-1 == stat_res)
{
if (ENOENT != errno)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(5) ERR_FILEPARSE, 2, objfilespec->str.len,
objfilespec->str.addr, errno);
fileexists = FALSE;
} else
fileexists = TRUE;
rtnname.len = pblk.b_name;
rtnname.addr = pblk.l_name;
CONVERT_FILENAME_TO_RTNNAME(rtnname); /* Set rtnname right before searching in relinkctl file */
assert(valid_mname(&rtnname));
COMPUTE_RELINKCTL_HASH(&rtnname, hash);
rec = relinkctl_find_record(linkctl, &rtnname, hash, &prev_hash_index);
if ((NULL == rec) && !fileexists)
return; /* No file and no entry - ignore */
/* Either the file exists or the entry exists so add or update it */
rec = relinkctl_insert_record(linkctl, &rtnname);
RELINKCTL_CYCLE_INCR(rec, linkctl); /* Increment cycle indicating change to world */
return;
}
/* If we have a wildcarded request or one without the object filetype, reprocess the string with $ZSEARCH using our
* defined stream to resolve wildcards. Then loop through processing each file returned. In this loop, we just ignore
* any file that doesn't have a ".o" extension.
*/
op_fnzsearch((mval *)&literal_null, STRM_ZRUPDATE, 0, &objpath); /* Clear any existing cache */
for (fcnt = 0; ; fcnt++)
{
plen.p.pint = op_fnzsearch(objfilespec, STRM_ZRUPDATE, 0, &objpath);
if (0 == objpath.str.len)
{ /* End of file list */
if (0 == fcnt)
/* Still looking to process our first file - give no objects found message as a "soft" message
* (INFO level message - supressed in other than direct mode)
*/
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) MAKE_MSG_INFO(ERR_FILEPARSE), 2, objfilespec->str.len,
objfilespec->str.addr, ERR_TEXT, 2, RTS_ERROR_TEXT("No object files found"));
break;
}
/* The extension contains the extension-start character ('.') so we are looking for the extension '.o' hence
* the length must be 2 and the 2nd char must be OBJEXT.
*/
if ((2 == plen.p.pblk.b_ext) && (OBJEXT == *(objpath.str.addr + plen.p.pblk.b_dir + plen.p.pblk.b_name + 1)))
{ /* This is (probably) an object file. Double check file is a file and not a directory */
memcpy(tranbuf, objpath.str.addr, objpath.str.len); /* Need null terminated version for STAT */
tranbuf[objpath.str.len] = '\0'; /* Not guaranteed null termination from op_fnzsearch */
STAT_FILE(tranbuf, &outbuf, stat_res);
/* If either something happened to the file since op_fnzsearch() saw it or the file is not a file, then
* ignore it.
*/
if ((-1 == stat_res) || !S_ISREG(outbuf.st_mode))
{
fcnt--; /* Don't count files not found for whatever reason */
continue;
}
/* Before opening the relinkctl file, verify we actually do have a valid routine name */
rtnname.len = plen.p.pblk.b_name;
rtnname.addr = objpath.str.addr + plen.p.pblk.b_dir;
CONVERT_FILENAME_TO_RTNNAME(rtnname); /* Set rtnname right before searching in relinkctl file */
if (!valid_mname(&rtnname))
{
fcnt--;
continue; /* Ignore files that are invalid wildcard matches */
}
objdir.addr = objpath.str.addr;
objdir.len = plen.p.pblk.b_dir;
linkctl = relinkctl_attach(&objdir); /* Create/attach/open relinkctl file */
if (NULL == linkctl)
{
fcnt--; /* Path disappeared - don't count it */
continue;
}
rec = relinkctl_insert_record(linkctl, &rtnname);
RELINKCTL_CYCLE_INCR(rec, linkctl); /* Increment cycle indicating change to world */
} else
fcnt--; /* Don't count ignored files */
}
}
void view_arg_convert(viewtab_entry *vtp, int vtp_parm, mval *parm, viewparm *parmblk, boolean_t is_dollar_view)
{
static int4 first_time = TRUE;
char *cptr;
char *strtokptr;
gd_binding *gd_map;
gd_region *gd_reg_start, *r_ptr, *r_top;
gvnh_reg_t *gvnh_reg;
gvnh_spanreg_t *gvspan;
gv_namehead *tmp_gvt;
ht_ent_mname *tabent;
int n, reg_index;
mident_fixed lcl_buff;
mname_entry gvent, lvent;
mstr namestr, tmpstr;
unsigned char *c, *c_top, *dst, *dst_top, global_names[1024], *nextsrc, *src, *src_top, stashed, y;
switch (vtp_parm)
{
case VTP_NULL:
if (parm != 0)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
break;
case (VTP_NULL | VTP_VALUE):
if (NULL == parm)
{
parmblk->value = (mval *)&literal_one;
break;
}
/* caution: fall through */
case VTP_VALUE:
if (NULL == parm)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
parmblk->value = parm;
break;
case (VTP_NULL | VTP_DBREGION):
if (!is_dollar_view && ((NULL == parm) || ((1 == parm->str.len) && ('*' == *parm->str.addr))))
{
parmblk->gv_ptr = NULL;
break;
}
/* caution: fall through */
case VTP_DBREGION:
if (NULL == parm)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
if (!gd_header) /* IF GD_HEADER ==0 THEN OPEN GBLDIR */
gvinit();
r_ptr = gd_header->regions;
if (!parm->str.len && vtp->keycode == VTK_GVNEXT) /* "" => 1st region */
parmblk->gv_ptr = r_ptr;
else
{
for (cptr = parm->str.addr, n = 0; n < parm->str.len; cptr++, n++)
lcl_buff.c[n] = TOUPPER(*cptr); /* Region names are upper-case ASCII */
namestr.len = n;
namestr.addr = &lcl_buff.c[0];
for (r_top = r_ptr + gd_header->n_regions; ; r_ptr++)
{
if (r_ptr >= r_top)
{
format2zwr((sm_uc_ptr_t)parm->str.addr, parm->str.len, global_names, &n);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_NOREGION,2, n, global_names);
}
tmpstr.len = r_ptr->rname_len;
tmpstr.addr = (char *)r_ptr->rname;
MSTR_CMP(tmpstr, namestr, n);
if (0 == n)
break;
}
parmblk->gv_ptr = r_ptr;
}
break;
case VTP_DBKEY:
if (NULL == parm)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
if (!parm->str.len)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_NOTGBL, 2, parm->str.len, NULL);
if (!gd_header) /* IF GD_HEADER ==0 THEN OPEN GBLDIR */
gvinit();
c = (unsigned char *)parm->str.addr;
if ('^' != *c)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_NOTGBL, 2, parm->str.len, c);
c_top = c + parm->str.len;
c++; /* skip initial '^' */
parmblk->str.addr = (char *)c;
for ( ; (c < c_top) && ('(' != *c); c++)
;
parmblk->str.len = (char *)c - parmblk->str.addr;
if (MAX_MIDENT_LEN < parmblk->str.len)
parmblk->str.len = MAX_MIDENT_LEN;
if (!valid_mname(&parmblk->str))
{
format2zwr((sm_uc_ptr_t)parm->str.addr, parm->str.len, global_names, &n);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWGVN, 2, n, global_names);
}
break;
case VTP_RTNAME:
if (NULL == parm)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
memset(&parmblk->ident.c[0], 0, SIZEOF(parmblk->ident));
if (parm->str.len > 0)
memcpy(&parmblk->ident.c[0], parm->str.addr,
(parm->str.len <= MAX_MIDENT_LEN ? parm->str.len : MAX_MIDENT_LEN));
break;
case VTP_NULL | VTP_DBKEYLIST:
if (NULL == parm || 0 == parm->str.len)
{
parmblk->ni_list.gvnh_list = NULL;
parmblk->ni_list.type = NOISOLATION_NULL;
break;
}
/* caution : explicit fall through */
case VTP_DBKEYLIST:
if (NULL == parm)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
if (!gd_header)
gvinit();
if (first_time)
{
noisolation_buddy_list = (buddy_list *)malloc(SIZEOF(buddy_list));
initialize_list(noisolation_buddy_list, SIZEOF(noisolation_element), NOISOLATION_INIT_ALLOC);
gvt_pending_buddy_list = (buddy_list *)malloc(SIZEOF(buddy_list));
initialize_list(gvt_pending_buddy_list, SIZEOF(gvt_container), NOISOLATION_INIT_ALLOC);
first_time = FALSE;
}
assertpro(SIZEOF(global_names) > parm->str.len);
tmpstr.len = parm->str.len; /* we need to change len and should not change parm->str, so take a copy */
tmpstr.addr = parm->str.addr;
if (0 != tmpstr.len)
{
switch (*tmpstr.addr)
{
case '+' :
parmblk->ni_list.type = NOISOLATION_PLUS;
tmpstr.addr++;
tmpstr.len--;
break;
case '-' :
parmblk->ni_list.type = NOISOLATION_MINUS;
tmpstr.addr++;
tmpstr.len--;
break;
default :
parmblk->ni_list.type = NOISOLATION_NULL;
break;
}
if (!tmpstr.len)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWGVN, 2, tmpstr.len, NULL);
memcpy(global_names, tmpstr.addr, tmpstr.len);
global_names[tmpstr.len] = '\0';
src = (unsigned char *)STRTOK_R((char *)global_names, ",", &strtokptr);
REINITIALIZE_LIST(noisolation_buddy_list); /* reinitialize the noisolation buddy_list */
parmblk->ni_list.gvnh_list = NULL;
for ( ; src < &global_names[tmpstr.len + 1]; src = nextsrc)
{
nextsrc = (unsigned char *)STRTOK_R(NULL, ",", &strtokptr);
if (NULL == nextsrc)
nextsrc = &global_names[tmpstr.len + 1];
if (nextsrc - src >= 2 && '^' == *src)
{
namestr.addr = (char *)src + 1; /* skip initial '^' */
namestr.len = INTCAST(nextsrc - src - 2); /* don't count initial ^ and trailing 0 */
if (namestr.len > MAX_MIDENT_LEN)
namestr.len = MAX_MIDENT_LEN;
if (valid_mname(&namestr))
{
memcpy(&lcl_buff.c[0], namestr.addr, namestr.len);
gvent.var_name.len = namestr.len;
} else
{
memcpy(&lcl_buff.c[0], src, nextsrc - src - 1);
format2zwr((sm_uc_ptr_t)&lcl_buff.c, nextsrc - src - 1, global_names, &n);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWGVN, 2, n, global_names);
}
} else
{
memcpy(&lcl_buff.c[0], src, nextsrc - src - 1);
format2zwr((sm_uc_ptr_t)&lcl_buff.c, nextsrc - src - 1, global_names, &n);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWGVN, 2, n, global_names);
}
tmp_gvt = NULL;
gvent.var_name.addr = &lcl_buff.c[0];
COMPUTE_HASH_MNAME(&gvent);
if (NULL != (tabent = lookup_hashtab_mname(gd_header->tab_ptr, &gvent)))
{
gvnh_reg = (gvnh_reg_t *)tabent->value;
assert(NULL != gvnh_reg);
tmp_gvt = gvnh_reg->gvt;
} else
{
gd_map = gv_srch_map(gd_header, gvent.var_name.addr, gvent.var_name.len,
SKIP_BASEDB_OPEN_FALSE);
r_ptr = gd_map->reg.addr;
tmp_gvt = (gv_namehead *)targ_alloc(r_ptr->max_key_size, &gvent, r_ptr);
GVNH_REG_INIT(gd_header, gd_header->tab_ptr, gd_map, tmp_gvt,
r_ptr, gvnh_reg, tabent);
/* In case of a global spanning multiple regions, the gvt pointer corresponding to
* the region where the unsubscripted global reference maps to is stored in TWO
* locations (one in gvnh_reg->gvspan->gvt_array[index] and one in gvnh_reg->gvt.
* So pass in both these pointer addresses to be stored in the pending list in
* case this gvt gets reallocated (due to different keysizes between gld and db).
*/
if (NULL == (gvspan = gvnh_reg->gvspan))
{
ADD_TO_GVT_PENDING_LIST_IF_REG_NOT_OPEN(r_ptr, &gvnh_reg->gvt, NULL);
} else
{
gd_reg_start = &gd_header->regions[0];
GET_REG_INDEX(gd_header, gd_reg_start, r_ptr, reg_index);
/* the above sets "reg_index" */
assert(reg_index >= gvspan->min_reg_index);
assert(reg_index <= gvspan->max_reg_index);
reg_index -= gvspan->min_reg_index;
ADD_TO_GVT_PENDING_LIST_IF_REG_NOT_OPEN(r_ptr,
&gvspan->gvt_array[reg_index], &gvnh_reg->gvt);
}
}
ADD_GVT_TO_VIEW_NOISOLATION_LIST(tmp_gvt, parmblk);
if (!is_dollar_view && (NULL != gvnh_reg->gvspan))
{ /* Global spans multiple regions. Make sure gv_targets corresponding to ALL
* spanned regions are allocated so NOISOLATION status can be set in all of
* them even if the corresponding regions are not open yet. Do this only for
* VIEW "NOISOLATION" commands which change the noisolation characteristic.
* $VIEW("NOISOLATION") only examines the characteristics and so no need to
* allocate all the gv-targets in that case. Just one is enough.
*/
gvnh_spanreg_subs_gvt_init(gvnh_reg, gd_header, parmblk);
}
}
} else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWGVN, 2, tmpstr.len, tmpstr.addr);
break;
case VTP_LVN:
if (NULL == parm)
rts_error_csa(CSA_ARG(NULL)
VARLSTCNT(4) ERR_VIEWARGCNT, 2, strlen((const char *)vtp->keyword), vtp->keyword);
if (0 < parm->str.len)
{
lvent.var_name.addr = parm->str.addr;
lvent.var_name.len = parm->str.len;
if (lvent.var_name.len > MAX_MIDENT_LEN)
lvent.var_name.len = MAX_MIDENT_LEN;
if (!valid_mname(&lvent.var_name))
{
format2zwr((sm_uc_ptr_t)parm->str.addr, parm->str.len, global_names, &n);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWLVN, 2, n, global_names);
}
} else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWLVN, 2, parm->str.len, parm->str.addr);
/* Now look up the name.. */
COMPUTE_HASH_MNAME(&lvent);
if ((tabent = lookup_hashtab_mname(&curr_symval->h_symtab, &lvent)) && (NULL != tabent->value))
parmblk->value = (mval *)tabent->value; /* Return lv_val ptr */
else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_VIEWLVN, 2, parm->str.len, parm->str.addr);
break;
default:
assertpro(FALSE && vtp_parm);
}
}
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;
}
