/* 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; }