void lvzwr_out(lv_val *lvp)
{
char buff;
uchar_ptr_t lastc;
int n, nsubs, sbs_depth;
lv_val *dst_lv, *res_lv, *lvpc;
mstr one;
mval *subscp, *val, outindx;
ht_ent_addr *tabent_addr;
ht_ent_mname *tabent_mname;
boolean_t htent_added, dump_container;
zwr_alias_var *newzav, *zav;
mident_fixed zwrt_varname;
lvzwrite_datablk *newzwrb;
gparam_list param_list; /* for op_putindx call through callg */
gvnh_reg_t *gvnh_reg;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
val = &lvp->v;
assert(lvzwrite_block);
if (!merge_args)
{ /* The cases that exist here are:
* 1) This is a container variable. If the lv_val it refers to has been printed, show that association.
* Else, "create" a $ZWRTACxxx var/index that will define the value. Then before returning, cause
* that container var to be dumped with the appropriate $ZWRTACxxx index as the var name.
* 2) This is an alias base variable. If first time seen, we print normally but record it and put a
* ";#" tag on the end to signify it is an alias var (doesn't affect value). If we look it up and it
* is not the first time this lv_val has been printed, then we instead print the statement needed to
* alias it to the first seen var.
* 3) This is just a normal var needing to be printed normally.
*/
htent_added = FALSE;
one.addr = &buff;
one.len = 1;
lvzwrite_block->zav_added = FALSE;
if (lvp->v.mvtype & MV_ALIASCONT)
{ /* Case 1 -- have an alias container */
assert(curr_symval->alias_activity);
assert(!LV_IS_BASE_VAR(lvp)); /* verify is subscripted var */
lvpc = (lv_val *)lvp->v.str.addr;
assert(lvpc);
assert(LV_IS_BASE_VAR(lvpc)); /* Verify base var lv_val */
if (tabent_addr = (ht_ent_addr *)lookup_hashtab_addr(&zwrhtab->h_zwrtab, (char **)&lvpc))
{ /* The value was found, we have a reference we can print now */
assert(HTENT_VALID_ADDR(tabent_addr, zwr_alias_var, zav));
*one.addr = '*';
zshow_output(zwr_output, &one);
lvzwr_out_targkey(&one);
*one.addr = '=';
zshow_output(zwr_output, &one);
zav = (zwr_alias_var *)tabent_addr->value;
assert(0 < zav->zwr_var.len);
zwr_output->flush = TRUE;
zshow_output(zwr_output, (const mstr *)&zav->zwr_var);
return;
}
/* This lv_val isn't known to us yet. Scan the hash curr_symval hash table to see if it is known as a
* base variable as we could have a "forward reference" here.
*/
tabent_mname = als_lookup_base_lvval(lvpc);
/* note even though both paths below add a zav, not bothering to set zav_added because that flag is
* really only (currently) cared about in reference to processing a basevar so we wouldn't
* be in this code path anyway. Comment here to record potential usage if that changes.
*/
if (tabent_mname)
{ /* Found a base var it can reference -- create a zwrhtab entry for it */
assert(tabent_mname->key.var_name.len);
newzav = als_getzavslot();
newzav->zwr_var = tabent_mname->key.var_name;
htent_added = add_hashtab_addr(&zwrhtab->h_zwrtab, (char **)&lvpc, newzav, &tabent_addr);
assert(htent_added);
dump_container = FALSE;
} else
{ /* Unable to find lv_val .. must be "orphaned" so we generate a new $ZWRTAC var for it. The first
* check however is if this is the first $ZWRTAC var being generated for this $ZWR. If yes, generate
* a $ZWRTAC="" line to preceed it. This will be a flag to load to clear out all existing $ZWRTAC
* temp vars so there is no pollution between loads of ZWRitten data.
*/
if (0 == zwrtacindx++)
{ /* Put out "dummy" statement that will clear all the $ZWRTAC vars for a clean slate */
zwr_output->flush = TRUE;
zshow_output(zwr_output, &dzwrtac_clean);
}
MEMCPY_LIT(zwrt_varname.c, DOLLAR_ZWRTAC);
lastc = i2asc((uchar_ptr_t)zwrt_varname.c + STR_LIT_LEN(DOLLAR_ZWRTAC), zwrtacindx);
newzav = als_getzavslot();
newzav->zwr_var.addr = zwrt_varname.c;
newzav->zwr_var.len = INTCAST(((char *)lastc - &zwrt_varname.c[0]));
s2pool(&newzav->zwr_var);
htent_added = add_hashtab_addr(&zwrhtab->h_zwrtab, (char **)&lvpc, newzav, &tabent_addr);
assert(htent_added);
dump_container = TRUE;
}
/* Note value_printed flag in newzav not set since we are NOT dumping the value at this point
* but only the association. Since the flag is not set, we *will* dump it when we get to that
* actual variable.
*/
*one.addr = '*';
zshow_output(zwr_output, &one);
lvzwr_out_targkey(&one);
*one.addr = '=';
zshow_output(zwr_output, &one);
zwr_output->flush = TRUE;
zshow_output(zwr_output, (const mstr *)&newzav->zwr_var);
if (dump_container)
{ /* We want to dump the entire container variable but the name doesn't match the var we are
* currently dumping so push a new lvzwrite_block onto the stack, fill it in for the current var
* and call lvzwr_var() to handle it. When done, dismantle the temp lvzwrite_block.
*/
newzwrb = (lvzwrite_datablk *)malloc(SIZEOF(lvzwrite_datablk));
memset(newzwrb, 0, SIZEOF(lvzwrite_datablk));
newzwrb->sub = (zwr_sub_lst *)malloc(SIZEOF(zwr_sub_lst) * MAX_LVSUBSCRIPTS);
newzwrb->curr_name = &newzav->zwr_var;
newzwrb->prev = lvzwrite_block;
lvzwrite_block = newzwrb;
lvzwr_var(lvpc, 0);
assert(newzav->value_printed);
assert(newzwrb == lvzwrite_block);
free(newzwrb->sub);
lvzwrite_block = newzwrb->prev;
free(newzwrb);
}
return;
} else if (LV_IS_BASE_VAR(lvp) && IS_ALIASLV(lvp))
{ /* Case 2 -- alias base variable (only base vars have reference counts). Note this can occur with
* TP save/restore vars since we increment both trefcnt and crefcnt for these hidden copied references.
* Because of that, we can't assert alias_activity but otherwise it shouldn't affect processing.
*/
if (!(htent_added = add_hashtab_addr(&zwrhtab->h_zwrtab, (char **)&lvp, NULL, &tabent_addr)))
{ /* Entry already existed -- need to output association rather than values */
assert(tabent_addr);
zav = (zwr_alias_var *)tabent_addr->value;
assert(zav);
if (zav->value_printed)
{ /* Value has already been output -- print association this time */
*one.addr = '*'; /* Flag as creating an alias */
zshow_output(zwr_output, &one);
/* Now for (new) variable name */
zshow_output(zwr_output, lvzwrite_block->curr_name);
*one.addr = '=';
zshow_output(zwr_output, &one);
/* .. and the var name aliasing to (the first seen with this lv_val) */
assert(zav->zwr_var.len);
zwr_output->flush = TRUE;
zshow_output(zwr_output, &zav->zwr_var);
return;
}
/* Else the value for this entry has not yet been printed so let us fall into case 3
* and get that done. Also set the flag so we mark it as an alias. Note this can happen if
* a container value for a name is encountered before the base var it points to. We will
* properly resolve the entry but its value won't have been printed until we actually encounter
* it in the tree.
*/
htent_added = TRUE; /* to force the ;# tag at end of value printing */
zav->value_printed = TRUE; /* value will be output shortly below */
} else
{ /* Entry was added so is first appearance -- give it a value to hold onto and print it */
newzav = als_getzavslot();
newzav->zwr_var = *lvzwrite_block->curr_name;
newzav->value_printed = TRUE; /* or rather it will be shortly.. */
tabent_addr->value = (void *)newzav;
lvzwrite_block->zav_added = TRUE;
/* Note fall into case 3 to print var and value if exists */
}
}
/* Case 3 - everything else */
if (!MV_DEFINED(val))
return;
MV_FORCE_STR(val);
lvzwr_out_targkey(&one);
*one.addr = '=';
zshow_output(zwr_output, &one);
mval_write(zwr_output, val, !htent_added);
if (htent_added)
{ /* output the ";#" tag to indicate this is an alias output */
zwr_output->flush = TRUE;
zshow_output(zwr_output, &semi_star);
}
} else
{ /* MERGE assignment from local variable */
nsubs = lvzwrite_block->curr_subsc;
if (MARG1_IS_GBL(merge_args))
{ /* Target is a global var : i.e. MERGE ^gvn1=lcl1.
* In this case, mglvnp->gblp[IND1]->gvkey_nsubs would have been initialized in op_merge.c already.
* Use that to check if the target node in ^gvn1 exceeds max # of subscripts.
*/
if (MAX_GVSUBSCRIPTS <= (mglvnp->gblp[IND1]->gvkey_nsubs + nsubs))
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(3) ERR_MERGEINCOMPL, 0, ERR_MAXNRSUBSCRIPTS);
memcpy(gv_currkey->base, mglvnp->gblp[IND1]->s_gv_currkey->base, mglvnp->gblp[IND1]->s_gv_currkey->end + 1);
gv_currkey->end = mglvnp->gblp[IND1]->s_gv_currkey->end;
for (n = 0; n < nsubs; n++)
{
subscp = ((zwr_sub_lst *)lvzwrite_block->sub)->subsc_list[n].actual;
MV_FORCE_STR(subscp);
mval2subsc(subscp, gv_currkey, gv_cur_region->std_null_coll);
if (!subscp->str.len && (ALWAYS != gv_cur_region->null_subs))
sgnl_gvnulsubsc();
}
MV_FORCE_STR(val);
gvnh_reg = TREF(gd_targ_gvnh_reg); /* set by op_gvname/op_gvextnam/op_gvnaked done before op_merge */
/* If gvnh_reg corresponds to a spanning global, then determine
* gv_cur_region/gv_target/gd_targ_* variables based on updated gv_currkey.
*/
GV_BIND_SUBSNAME_FROM_GVNH_REG_IF_GVSPAN(gvnh_reg, (TREF(gd_targ_addr)), gv_currkey);
/* For spanning globals, "gv_cur_region" points to the target region for ^gvn1 only now.
* So do the GVSUBOFLOW check (both for spanning and non-spanning globals) now.
*/
if (gv_currkey->end >= gv_cur_region->max_key_size)
ISSUE_GVSUBOFLOW_ERROR(gv_currkey, KEY_COMPLETE_TRUE);
op_gvput(val);
} else
{ /* Target is a local var : pre-process target in case it is a container */
assert(MARG1_IS_LCL(merge_args));
dst_lv = mglvnp->lclp[IND1];
if (!LV_IS_BASE_VAR(dst_lv))
{
LV_SBS_DEPTH(dst_lv, FALSE, sbs_depth);
if (MAX_LVSUBSCRIPTS < (sbs_depth + nsubs))
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(3) ERR_MERGEINCOMPL, 0, ERR_MAXNRSUBSCRIPTS);
}
param_list.arg[0] = dst_lv; /* this is already protected from stp_gcol by op_merge so no need to
* push this into the stack for stp_gcol protection. */
for (n = 0 ; n < nsubs; n++)
{ /* Note: no need to do push these mvals on the stack before calling op_putindx
* as lvzwrite_block->sub is already protected by stp_gcol_src.h.
*/
param_list.arg[n+1] = ((zwr_sub_lst *)lvzwrite_block->sub)->subsc_list[n].actual;
}
param_list.n = n + 1;
dst_lv = (lv_val *)callg((callgfnptr)op_putindx, ¶m_list);
MV_FORCE_STR(val);
assert(!(MV_ALIASCONT & dst_lv->v.mvtype)); /* op_putindx would have already done DECR_AC_REF for us */
dst_lv->v = *val;
dst_lv->v.mvtype &= ~MV_ALIASCONT; /* Make sure alias container property does not pass */
}
}
}
void jobchild_init(void)
{
unsigned int status;
job_params_type jparms;
/* Transfer data */
unsigned char *transfer_addr;
rhdtyp *base_addr;
unsigned short i, arg_len;
char run_file_name[FILE_NAME_SIZE + 2], *c;
gcall_args job_arglist;
mval job_args[MAX_ACTUALS];
error_def (ERR_RUNPARAMERR);
static char interactive_mode_buf[] = "INTERACTIVE";
static char other_mode_buf[] = "OTHER";
error_def(ERR_TEXT);
ESTABLISH(job_init_ch);
/*
* Check if environment variable ppid - job parent pid
* exists. If it does not, we are a regular gtm process,
* else, we are a child process of a job command.
*/
if ((c = GETENV(CHILD_FLAG_ENV)) && strlen(c))
{
/*
* We are a Jobbed process.
* Get Job parameters and set up environment
* to run the Job command
*/
/* Clear the environment variable so that subsequent child
* mumps processes can start normal initialization. */
if (PUTENV(CLEAR_CHILD_FLAG_ENV))
{
util_out_print("Unable to clear gtmj0 process !UL exiting.", TRUE, process_id);
rts_error(VARLSTCNT(1) errno);
}
/* read parameters into parameter structure */
ojchildparms(&jparms, &job_arglist, job_args);
/* Execute the command to be run before executing the actual M routine */
if (jparms.startup.len)
SYSTEM(jparms.startup.addr);
/* Set up job's input, output and error files. Redirect them, if necessary. */
/* It is needed since the middle process would not have always done this(under jobpid == TRUE cases) */
if (!(status = ojchildioset(&jparms)))
rts_error(VARLSTCNT(4) ERR_TEXT, 2, LEN_AND_LIT("Failed to set STDIN/OUT/ERR for the job"));
job_addr(&jparms.routine, &jparms.label, jparms.offset, (char **)&base_addr, (char **)&transfer_addr);
/* Set process priority */
if (jparms.baspri)
nice((int) jparms.baspri);
/* Set up $ZMODE to "OTHER" */
dollar_zmode.mvtype = MV_STR;
dollar_zmode.str.addr = &other_mode_buf[0];
dollar_zmode.str.len = sizeof(other_mode_buf) -1;
} else
{
/* If we are not a child, setup a dummy mumps routine */
if (MUMPS_RUN == invocation_mode)
{
mstr routine, label;
int offset;
arg_len = FILE_NAME_SIZE;
if (!cli_get_str("INFILE", run_file_name, &arg_len))
rts_error(VARLSTCNT(1) ERR_RUNPARAMERR);
lref_parse((uchar_ptr_t)run_file_name, &routine, &label, &offset);
job_addr(&routine, &label, offset, (char **)&base_addr, (char **)&transfer_addr);
} else if (MUMPS_CALLIN & invocation_mode) /* call-in mode */
{
base_addr = make_cimode();
transfer_addr = PTEXT_ADR(base_addr);
} else /* direct mode */
{
base_addr = make_dmode();
transfer_addr = PTEXT_ADR(base_addr);
}
job_arglist.callargs = 0;
/* Set up $ZMODE to "INTERACTIVE" */
dollar_zmode.mvtype = MV_STR;
dollar_zmode.str.addr = &interactive_mode_buf[0];
dollar_zmode.str.len = sizeof(interactive_mode_buf) -1;
}
gtm_init_env(base_addr, transfer_addr);
if (MUMPS_CALLIN & invocation_mode)
{
SET_CI_ENV(ci_ret_code_exit);
}
if (job_arglist.callargs)
{
callg((int(*)())push_parm, &job_arglist);
frame_pointer->type |= SFT_EXTFUN;
}
REVERT;
}
void callg_signal(void *arg)
{
(void)callg((callgfnptr) rts_error, (void *)arg);
}
