void goframes(int4 frames) #endif { mval *ret_targ; GTMTRIG_ONLY(goframes_unwound_trigger = FALSE); for (ret_targ = NULL; frames--; ) { while (tp_pointer && tp_pointer->fp <= frame_pointer) { OP_TROLLBACK(-1); } if (0 == frames) { ret_targ = (mval *)get_ret_targ(NULL); /* If alias_retarg is non-NULL, *ret_targ would have been already initialized so no need to set it. * Setting it to literal_null in that case would cause reference counts to not be decremented later * in op_unwind/mdb_condition_handler so it is actually necessary to skip it in that case. */ if ((NULL != ret_targ) && (NULL == alias_retarg)) { *ret_targ = literal_null; ret_targ->mvtype |= MV_RETARG; } } skip_error_ret = TRUE; # ifdef GTM_TRIGGER if (!(SFT_TRIGR & frame_pointer->type)) { /* Normal frame unwind */ DBGTRIGR((stderr, "goframes: unwinding regular frame at %016lx\n", frame_pointer)); op_unwind(); DBGTRIGR((stderr, "goframes: after regular frame unwind: frame_pointer 0x%016lx ctxt value: 0x%016lx\n", frame_pointer, ctxt)); } else { /* Trigger base frame unwind (special case) */ DBGTRIGR((stderr, "goframes: unwinding trigger base frame at %016lx\n", frame_pointer)); gtm_trigger_fini(TRUE, fromzgoto); goframes_unwound_trigger = TRUE; } # else /* If triggers are not enabled, just a normal unwind */ DBGEHND((stderr, "goframes: unwinding regular frame at %016lx\n", frame_pointer)); op_unwind(); # endif assert(FALSE == skip_error_ret); /* op_unwind() should have read and reset this */ skip_error_ret = FALSE; /* be safe in PRO versions */ } # ifdef GTM_TRIGGER if (unwtrigrframe && (SFT_TRIGR & frame_pointer->type)) { /* If we landed on a trigger base frame after unwinding everything, we are in the same boat as if we had run into * one while we were unwinding. We cannot return this frame to (for example) zgoto which is going to morph it into * something else (unwtrigrframe only set when ZGOTO with entryref specified). So if the flag says we should never * land on a trigger frame, go ahead and unwind that one too. */ DBGTRIGR((stderr, "goframes: unwinding trailing trigger base frame at %016lx\n", frame_pointer)); gtm_trigger_fini(TRUE, fromzgoto); goframes_unwound_trigger = TRUE; } # endif return; }
/* 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; }
void zshow_svn(zshow_out *output) { mstr x; mval var, zdir; io_log_name *tl; stack_frame *fp; int count, save_dollar_zlevel; char *c1, *c2; char zdir_error[3 * GTM_MAX_DIR_LEN + 128]; /* PATH_MAX + "->" + GTM-W-ZDIROUTOFSYNC, <text of ZDIROUTOFSYNC> */ error_def(ERR_ZDIROUTOFSYNC); /* SV_DEVICE */ get_dlr_device(&var); ZS_VAR_EQU(&x, device_text); mval_write(output, &var, TRUE); /* SV_ECODE */ ecode_get(-1, &var); ZS_VAR_EQU(&x, ecode_text); mval_write(output, &var, TRUE); /* SV_ESTACK */ save_dollar_zlevel = dollar_zlevel(); count = (save_dollar_zlevel - 1) - dollar_estack_delta.m[0]; MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, estack_text); mval_write(output, &var, TRUE); /* SV_ETRAP */ var.mvtype = MV_STR; var.str = dollar_etrap.str; ZS_VAR_EQU(&x, etrap_text); mval_write(output, &var, TRUE); /* SV_HOROLOG */ op_horolog(&var); ZS_VAR_EQU(&x, horolog_text); mval_write(output, &var, TRUE); /* SV_IO */ var.str.addr = io_curr_device.in->name->dollar_io; var.str.len = io_curr_device.in->name->len; /*** The following should be in the I/O code ***/ if (ESC == *var.str.addr) { if (5 > var.str.len) var.str.len = 0; else { var.str.addr += ESC_OFFSET; var.str.len -= ESC_OFFSET; } } var.mvtype = MV_STR; ZS_VAR_EQU(&x, io_text); mval_write(output, &var, TRUE); /* SV_JOB */ ZS_VAR_EQU(&x, job_text); mval_write(output, &dollar_job, TRUE); /* SV_KEY */ get_dlr_key(&var); ZS_VAR_EQU(&x, key_text); mval_write(output, &var, TRUE); /* SV_PRINCIPAL */ if (dollar_principal) tl = dollar_principal; else tl = io_root_log_name->iod->trans_name; var.str.addr = tl->dollar_io; var.str.len = tl->len; /*** The following should be in the I/O code ***/ if (ESC == *var.str.addr) { if (5 > var.str.len) var.str.len = 0; else { var.str.addr += ESC_OFFSET; var.str.len -= ESC_OFFSET; } } var.mvtype = MV_STR; ZS_VAR_EQU(&x, principal_text); mval_write(output, &var, TRUE); /* SV_QUIT */ count = ((NULL == get_ret_targ()) ? 0 : 1); MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, quit_text); mval_write(output, &var, TRUE); /* SV_REFERENCE */ get_reference(&var); ZS_VAR_EQU(&x, reference_text); mval_write(output, &var, TRUE); /* SV_STACK */ count = (save_dollar_zlevel - 1); MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, stack_text); mval_write(output, &var, TRUE); /* SV_STORAGE */ i2mval(&var, getstorage()); ZS_VAR_EQU(&x, storage_text); mval_write(output, &var, TRUE); /* SV_SYSTEM */ var.mvtype = MV_STR; var.str = dollar_system.str; ZS_VAR_EQU(&x, system_text); mval_write(output, &var, TRUE); /* SV_TEST */ i2mval(&var, (int)op_dt_get()); ZS_VAR_EQU(&x, test_text); mval_write(output, &var, TRUE); /* SV_TLEVEL */ count = (int)dollar_tlevel; MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, tlevel_text); mval_write(output, &var, TRUE); /* SV_TRESTART */ MV_FORCE_MVAL(&var, (int)((MAX_VISIBLE_TRESTART < dollar_trestart) ? MAX_VISIBLE_TRESTART : dollar_trestart)); ZS_VAR_EQU(&x, trestart_text); mval_write(output, &var, TRUE); /* SV_X */ count = (int)io_curr_device.out->dollar.x; MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, x_text); mval_write(output, &var, TRUE); /* SV_Y */ count = (int)io_curr_device.out->dollar.y; MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, y_text); mval_write(output, &var, TRUE); /* SV_ZA */ count = (int)io_curr_device.in->dollar.za; MV_FORCE_MVAL(&var, count); ZS_VAR_EQU(&x, za_text); mval_write(output, &var, TRUE); /* SV_ZB */ c1 = (char *)io_curr_device.in->dollar.zb; c2 = c1 + sizeof(io_curr_device.in->dollar.zb); var.mvtype = MV_STR; var.str.addr = (char *)io_curr_device.in->dollar.zb; while (c1 < c2 && *c1) c1++; var.str.len = (char *)c1 - var.str.addr; ZS_VAR_EQU(&x, zb_text); mval_write(output, &var, TRUE); /* SV_ZCMDLINE */ get_command_line(&var, TRUE); /* TRUE to indicate we want $ZCMDLINE (i.e. processed not actual command line) */ ZS_VAR_EQU(&x, zcmdline_text); mval_write(output, &var, TRUE); /* SV_ZCOMPILE */ var.mvtype = MV_STR; var.str = dollar_zcompile; ZS_VAR_EQU(&x, zcompile_text); mval_write(output, &var, TRUE); /* SV_ZCSTATUS */ MV_FORCE_MVAL(&var, dollar_zcstatus); ZS_VAR_EQU(&x, zcstatus_text); mval_write(output, &var, TRUE); /* SV_ZDATEFORM */ MV_FORCE_MVAL(&var, zdate_form); ZS_VAR_EQU(&x, zdate_form_text); mval_write(output, &var, TRUE); /* SV_ZDIR */ ZS_VAR_EQU(&x, zdirectory_text); setzdir(NULL, &zdir); if (zdir.str.len != dollar_zdir.str.len || 0 != memcmp(zdir.str.addr, dollar_zdir.str.addr, zdir.str.len)) { memcpy(zdir_error, zdir.str.addr, zdir.str.len); memcpy(&zdir_error[zdir.str.len], arrow_text, STR_LIT_LEN(arrow_text)); sgtm_putmsg(&zdir_error[zdir.str.len + STR_LIT_LEN(arrow_text)], VARLSTCNT(6) ERR_ZDIROUTOFSYNC, 4, zdir.str.len, zdir.str.addr, dollar_zdir.str.len, dollar_zdir.str.addr); zdir.str.addr = zdir_error; zdir.str.len = strlen(zdir_error) - 1; /* eliminate trailing '\n' */ } SKIP_DEVICE_IF_NOT_NEEDED(&zdir); mval_write(output, &zdir, TRUE); /* SV_ZEDITOR */ MV_FORCE_MVAL(&var, dollar_zeditor); ZS_VAR_EQU(&x, zeditor_text); mval_write(output, &var, TRUE); /* SV_ZEOF */ ZS_VAR_EQU(&x, zeof_text); mval_write(output, io_curr_device.in->dollar.zeof ? (mval *)&literal_one : (mval *)&literal_zero, TRUE); /* SV_ZERROR */ var.mvtype = MV_STR; var.str = dollar_zerror.str; ZS_VAR_EQU(&x, zerror_text); mval_write(output, &var, TRUE); /* SV_ZGBLDIR */ ZS_VAR_EQU(&x, zgbldir_text); mval_write(output, &dollar_zgbldir, TRUE); /* SV_ZININTERRUPT */ MV_FORCE_MVAL(&var, dollar_zininterrupt); ZS_VAR_EQU(&x, zininterrupt_text); mval_write(output, &var, TRUE); /* SV_ZINTERRUPT */ var.mvtype = MV_STR; var.str = dollar_zinterrupt.str; ZS_VAR_EQU(&x, zinterrupt_text); mval_write(output, &var, TRUE); /* SV_ZIO */ var.mvtype = MV_STR; /* NOTE: This is **NOT** equivalent to : * io_curr_log_name->dollar_io */ var.str.addr = io_curr_device.in->trans_name->dollar_io; var.str.len = io_curr_device.in->trans_name->len; if (*var.str.addr == ESC) { if (5 > var.str.len) var.str.len = 0; else { var.str.addr += ESC_OFFSET; var.str.len -= ESC_OFFSET; } } ZS_VAR_EQU(&x, zio_text); mval_write(output, &var, TRUE); /* SV_ZJOB */ MV_FORCE_ULONG_MVAL(&var, dollar_zjob); ZS_VAR_EQU(&x, zjob_text); mval_write(output, &var, TRUE); /* SV_ZLEVEL */ MV_FORCE_MVAL(&var, save_dollar_zlevel); ZS_VAR_EQU(&x, zlevel_text); mval_write(output, &var, TRUE); /* SV_ZMAXTPTIME */ MV_FORCE_MVAL(&var, dollar_zmaxtptime); ZS_VAR_EQU(&x, zmaxtptime_text); mval_write(output, &var, TRUE); /* SV_ZMODE */ ZS_VAR_EQU(&x, zmode_text); mval_write(output, &dollar_zmode, TRUE); /* SV_ZPOS */ getzposition(&var); ZS_VAR_EQU(&x, zpos_text); mval_write(output, &var, TRUE); /* SV_ZPROC */ ZS_VAR_EQU(&x, zproc_text); mval_write(output, &dollar_zproc, TRUE); /* SV_PROMPT */ var.mvtype = MV_STR; var.str.addr = gtmprompt.addr; var.str.len = gtmprompt.len; ZS_VAR_EQU(&x, zprompt_text); mval_write(output, &var, TRUE); /* SV_ZROUTINES */ if (!zro_root) zro_init(); var.mvtype = MV_STR; var.str = dollar_zroutines; ZS_VAR_EQU(&x, zroutines_text); mval_write(output, &var, TRUE); /* SV_ZSOURCE */ var.mvtype = MV_STR; var.str = dollar_zsource; ZS_VAR_EQU(&x, zsource_text); mval_write(output, &var, TRUE); /* SV_ZSTATUS */ ZS_VAR_EQU(&x, zstatus_text); mval_write(output, &dollar_zstatus, TRUE); /* SV_ZSTEP */ ZS_VAR_EQU(&x, zstep_text); mval_write(output, &dollar_zstep, TRUE); /* SV_ZSYSTEM */ MV_FORCE_MVAL(&var, dollar_zsystem); ZS_VAR_EQU(&x, zsystem_text); mval_write(output, &var, TRUE); /* SV_ZTEXIT */ var.mvtype = MV_STR; var.str = dollar_ztexit.str; ZS_VAR_EQU(&x, ztexit_text); mval_write(output, &var, TRUE); /* SV_ZTRAP */ var.mvtype = MV_STR; var.str = dollar_ztrap.str; ZS_VAR_EQU(&x, ztrap_text); mval_write(output, &var, TRUE); /* SV_ZVERSION */ var.mvtype = MV_STR; var.str.addr = (char *)>m_release_name[0]; var.str.len = gtm_release_name_len; ZS_VAR_EQU(&x, zversion_text); mval_write(output, &var, TRUE); /* SV_ZYERROR */ var.mvtype = MV_STR; var.str = dollar_zyerror.str; ZS_VAR_EQU(&x, zyerror_text); mval_write(output, &var, TRUE); }