/* Operation - The destination variable becomes a container variable holding a pointer to source alias
*
* 1) Convert the src lvval to an alias variable if necessary (by manipulating the reference counts
* 2) Save the address of the source lv_val in the destination var, setting the mval container flag.
* 3) Whichever symval of source or destination is greatest, that is the earliest symval affected. We
* feed that to the MARK_ALIAS_ACTIVE macro to mark all intervening symvals as having alias
* activity and that covers both potential symvals so we don't have to call the macro twice.
*/
void op_setalsin2alsct(lv_val *srclv, lv_val *dstlv)
{
lv_val *dst_lvbase;
symval *sym_srclv, *sym_dstlv;
assert(srclv);
assert(LV_IS_BASE_VAR(srclv)); /* Verify base var */
assert(dstlv);
assert(!LV_IS_BASE_VAR(dstlv)); /* Verify subscripted var */
dst_lvbase = LV_GET_BASE_VAR(dstlv);
if (dollar_tlevel && (NULL != dst_lvbase->tp_var) && !dst_lvbase->tp_var->var_cloned)
TP_VAR_CLONE(dst_lvbase); /* clone the tree. */
/* Decrement alias container refs (if any) and cleanup if necessary */
DECR_AC_REF(dstlv, TRUE);
/* Reset value of lv_val to now be a container ref to the supplied base var */
memcpy(&dstlv->v, &literal_null, SIZEOF(mval));
dstlv->v.mvtype |= MV_ALIASCONT; /* Set the magic container flag */
dstlv->v.str.addr = (char *)srclv; /* And save our reference */
assert(0 < srclv->stats.trefcnt);
assert(0 <= srclv->stats.crefcnt);
INCR_TREFCNT(srclv); /* Total reference counts */
INCR_CREFCNT(srclv); /* .. and a contain reference at that.. */
assert(srclv->stats.trefcnt >= srclv->stats.crefcnt);
/* These symvals have had alias activity */
sym_srclv = LV_GET_SYMVAL(srclv);
sym_dstlv = LV_GET_SYMVAL(dst_lvbase);
MARK_ALIAS_ACTIVE(MIN(sym_srclv->symvlvl, sym_dstlv->symvlvl));
/* Last operation is to mark the base var for our container array that it now has a container in it.
* But first it must be found by going backwards through the levels.
*/
MARK_CONTAINER_ONBOARD(dst_lvbase);
}
/* This has to be maintained in parallel with op_unwind(), the unwind without a return argument (intrinsic quit) routine. */
int unw_retarg(mval *src, boolean_t alias_return)
{
mval ret_value, *trg;
boolean_t got_ret_target;
stack_frame *prevfp;
lv_val *srclv, *srclvc, *base_lv;
symval *symlv, *symlvc;
int4 srcsymvlvl;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
assert(NULL == alias_retarg);
alias_retarg = NULL;
DBGEHND_ONLY(prevfp = frame_pointer);
if (tp_pointer && tp_pointer->fp <= frame_pointer)
rts_error(VARLSTCNT(1) ERR_TPQUIT);
assert(msp <= stackbase && msp > stacktop);
assert(mv_chain <= (mv_stent *)stackbase && mv_chain > (mv_stent *)stacktop);
assert(frame_pointer <= (stack_frame *)stackbase && frame_pointer > (stack_frame *)stacktop);
got_ret_target = FALSE;
/* Before we do any unwinding or even verify the existence of the return var, check to see if we are returning
* an alias (or container). We do this now because (1) alias returns don't need to be defined and (2) the returning
* item could go out of scope in the unwinds so we have to bump the returned item's reference counts NOW.
*/
if (!alias_return)
{ /* Return of "regular" value - Verify it exists */
MV_FORCE_DEFINED(src);
ret_value = *src;
ret_value.mvtype &= ~MV_ALIASCONT; /* Make sure alias container of regular return does not propagate */
} else
{ /* QUIT *var or *var(indx..) syntax was used - see which one it was */
assert(NULL != src);
srclv = (lv_val *)src; /* Since can never be an expression, this relationship is guaranteed */
if (!LV_IS_BASE_VAR(srclv))
{ /* Have a potential container var - verify */
if (!(MV_ALIASCONT & srclv->v.mvtype))
rts_error(VARLSTCNT(1) ERR_ALIASEXPECTED);
ret_value = *src;
srclvc = (lv_val *)srclv->v.str.addr;
assert(LV_IS_BASE_VAR(srclvc)); /* Verify base var */
assert(srclvc->stats.trefcnt >= srclvc->stats.crefcnt);
assert(1 <= srclvc->stats.crefcnt); /* Verify is existing container ref */
base_lv = LV_GET_BASE_VAR(srclv);
symlv = LV_GET_SYMVAL(base_lv);
symlvc = LV_GET_SYMVAL(srclvc);
MARK_ALIAS_ACTIVE(MIN(symlv->symvlvl, symlvc->symvlvl));
DBGRFCT((stderr, "unw_retarg: Returning alias container 0x"lvaddr" pointing to 0x"lvaddr" to caller\n",
src, srclvc));
} else
{ /* Creating a new alias - create a container to pass back */
memcpy(&ret_value, &literal_null, SIZEOF(mval));
ret_value.mvtype |= MV_ALIASCONT;
ret_value.str.addr = (char *)srclv;
srclvc = srclv;
MARK_ALIAS_ACTIVE(LV_SYMVAL(srclv)->symvlvl);
DBGRFCT((stderr, "unw_retarg: Returning alias 0x"lvaddr" to caller\n", srclvc));
}
INCR_TREFCNT(srclvc);
INCR_CREFCNT(srclvc); /* This increment will be reversed if this container gets put into an alias */
/* We have a slight chicken-and-egg problem now. The mv_stent unwind loop below may pop a symbol table thus
* destroying the lv_val in our container. To prevent this, we need to locate the parm block before the symval is
* unwound and set the return value and alias_retarg appropriately so the symtab unwind logic called by
* unw_mv_ent() can work any necessary relocation magic on the return var.
*/
trg = get_ret_targ(NULL);
if (NULL != trg)
{
*trg = ret_value;
alias_retarg = trg;
got_ret_target = TRUE;
} /* else fall into below which will raise the NOTEXTRINSIC error */
}
/* Note: we are unwinding uncounted (indirect) frames here to allow the QUIT command to have indirect arguments
* and thus be executed by commarg in an indirect frame. By unrolling the indirect frames here we get back to
* the point where we can find where to put the quit value.
*/
unwind_nocounts();
assert(frame_pointer && (frame_pointer->type & SFT_COUNT));
while (mv_chain < (mv_stent *)frame_pointer)
{
msp = (unsigned char *)mv_chain;
unw_mv_ent(mv_chain);
POP_MV_STENT();
}
if (0 <= frame_pointer->dollar_test)
dollar_truth = (boolean_t)frame_pointer->dollar_test;
/* Now that we have unwound the uncounted frames, we should be left with a counted frame that
* contains some ret_value, NULL or not. If the value is non-NULL, let us restore the $TEST
* value from that frame as well as update *trg for non-alias returns.
*/
if ((trg = frame_pointer->ret_value) && !alias_return) /* CAUTION: Assignment */
{ /* If this is an alias_return arg, bypass the arg set logic which was done above. */
assert(!got_ret_target);
got_ret_target = TRUE;
*trg = ret_value;
}
/* do not throw an error if return value is expected from a non-extrinsic, but dollar_zquit_anyway is true */
if (!dollar_zquit_anyway && !got_ret_target)
rts_error(VARLSTCNT(1) ERR_NOTEXTRINSIC); /* This routine was not invoked as an extrinsic function */
/* Note that error_ret() should be invoked only after the rts_error() of TPQUIT and NOTEXTRINSIC.
* This is so the TPQUIT/NOTEXTRINSIC error gets noted down in $ECODE (which wont happen if error_ret() is called before).
*/
INVOKE_ERROR_RET_IF_NEEDED;
if (is_tracing_on)
(*unw_prof_frame_ptr)();
msp = (unsigned char *)frame_pointer + SIZEOF(stack_frame);
DRAIN_GLVN_POOL_IF_NEEDED;
PARM_ACT_UNSTACK_IF_NEEDED;
frame_pointer = frame_pointer->old_frame_pointer;
DBGEHND((stderr, "unw_retarg: Stack frame 0x"lvaddr" unwound - frame 0x"lvaddr" now current - New msp: 0x"lvaddr"\n",
prevfp, frame_pointer, msp));
if ((NULL != zyerr_frame) && (frame_pointer > zyerr_frame))
zyerr_frame = NULL;
if (!frame_pointer)
rts_error(VARLSTCNT(1) ERR_STACKUNDERFLO);
assert(frame_pointer >= (stack_frame *)msp);
/* ensuring that trg is not NULL */
if (!dollar_zquit_anyway || trg)
trg->mvtype |= MV_RETARG;
assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
return 0;
}