void op_hardret(void) { bool dmode; dmode = unwind_nocounts(); assert(frame_pointer->old_frame_pointer); assert(SFT_COUNT == frame_pointer->type); /* QUIT in dmode should + re-install SFT_DM frame that would have been unwound by unwind_nocounts + not unwind the associated SFT_COUNT frame that lies below SFT_DM frame to re-enter dmode and to preserve all mvals associated with level-1. */ if (!dmode) op_unwind(); else dm_setup(); return; }/* eor */
/* 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 flush_jmp (rhdtyp *rtn_base, unsigned char *context, unsigned char *transfer_addr) { mv_stent *mv_st_ent, *mv_st_prev; char *top; unsigned char *msp_save; int4 shift, size, mv_st_type; rhdtyp *old_rtnhdr; unwind_nocounts(); /* We are going to mutate the current frame from the program it was running to the program we want it to run. * If the current frame is marked for indr cache cleanup, do that cleanup now and unmark the frame. */ IF_INDR_FRAME_CLEANUP_CACHE_ENTRY_AND_UNMARK(frame_pointer); DBGEHND((stderr, "flush_jmp: Retargetting stack frame 0x"lvaddr" for transfer address 0x"lvaddr"\n", frame_pointer, transfer_addr)); /* Also unmark the SFF_ETRAP_ERR bit in case it is set. This way we ensure control gets transferred to * the mpc below instead of "error_return" (which is what getframe will do in case the bit is set). * It is ok to clear this bit because the global variable "error_frame" will still be set to point to * this frame so whenever we unwind out of this, we will rethrow the error at the parent frame. */ assert(!(frame_pointer->flags & SFF_ETRAP_ERR) || (NULL == error_frame) || (error_frame == frame_pointer)); assert(!(SFT_TRIGR & frame_pointer->type)); frame_pointer->flags &= SFF_ETRAP_ERR_OFF; /* clear SFF_ETRAP_ERR bit */ frame_pointer->flags &= SFF_IMPLTSTART_CALLD_OFF; /* clear SFF_IMPLTSTART_CALLD bit since this frame is being rewritten */ GTMTRIG_ONLY(DBGTRIGR((stderr, "flush_jmp: Turrning off SFF_IMPLTSTART_CALLD_OFF in frame 0x"lvaddr"\n", frame_pointer))); old_rtnhdr = frame_pointer->rvector; frame_pointer->rvector = rtn_base; /* Now that fp->rvector has been overwritten to new routine, check if the older routine had a "rtn_relinked" flag set * and if so that cleanup can be performed now. */ USHBIN_ONLY(CLEANUP_COPIED_RECURSIVE_RTN(old_rtnhdr)); /* cleanup if needed */ frame_pointer->vartab_ptr = (char *)VARTAB_ADR(rtn_base); frame_pointer->vartab_len = frame_pointer->rvector->vartab_len; frame_pointer->mpc = transfer_addr; frame_pointer->ctxt = context; #ifdef HAS_LITERAL_SECT frame_pointer->literal_ptr = (int4 *)LITERAL_ADR(rtn_base); #endif frame_pointer->temp_mvals = frame_pointer->rvector->temp_mvals; size = rtn_base->temp_size; frame_pointer->temps_ptr = (unsigned char *)frame_pointer - size; size += rtn_base->vartab_len * SIZEOF(ht_ent_mname *); frame_pointer->l_symtab = (ht_ent_mname **)((char *)frame_pointer - size); assert(frame_pointer->type & SFT_COUNT); assert((unsigned char *)mv_chain > stacktop && (unsigned char *)mv_chain <= stackbase); while (((char *)mv_chain < (char *)frame_pointer) && !mvs_save[mv_chain->mv_st_type]) { assert(MVST_TRIGR != mv_chain->mv_st_type); /* Should never unwind a trigger frame here */ msp = (unsigned char *)mv_chain; op_oldvar(); } if ((char *)mv_chain > (char *)frame_pointer) { msp_save = msp; msp = (unsigned char *)frame_pointer->l_symtab; if (msp <= stackwarn) { if (msp <= stacktop) { msp = msp_save; rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_STACKOFLOW); } else rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_STACKCRIT); } memset(msp, 0, size); DBGEHND((stderr, "flush_jmp: Old msp: 0x"lvaddr" New msp: 0x"lvaddr"\n", msp_save, msp)); return; } /* We kept one or more mv_stents for this frame. We may need to shift the stack to get room to create an l_symtab * for this re-purposed frame. In the above loop, we stopped searching the mv_stent chain at the first mv_stent we * knew we had to keep. Since we are moving things around anyway, see if there are any mv_stents associated * with this frame which don't need to be kept and can reclaim. */ mv_st_ent = mv_chain; mv_st_prev = (mv_stent *)((char *)mv_st_ent + mv_st_ent->mv_st_next); top = (char *)mv_st_ent + mvs_size[mv_st_ent->mv_st_type]; while ((char *)mv_st_prev < (char *)frame_pointer) { mv_st_type = mv_st_prev->mv_st_type; assert(MVST_TRIGR != mv_st_type); /* Should never unwind a trigger frame here */ if (!mvs_save[mv_st_type]) { /* Don't need to keep this mv_stent. Remove it from the chain */ DBGEHND((stderr, "flush_jmp: Removing no-save mv_stent addr 0x"lvaddr" and type %d\n", mv_st_prev, mv_st_type)); unw_mv_ent(mv_st_prev); mv_st_ent->mv_st_next += mv_st_prev->mv_st_next; mv_st_prev = (mv_stent *)((char *)mv_st_prev + mv_st_prev->mv_st_next); continue; } /* We found a previous mv_stent we need to keep. If we had an interveening mv_stent we don't need to * keep, migrate the new keeper mv_stent adjacent to the previous keeper. */ if (mv_st_prev != (mv_stent *)top) { DBGEHND((stderr, "flush_jmp: Migrating keeper mv_stent from 0x"lvaddr" to 0x"lvaddr" type %d\n", mv_st_prev, top, mv_st_type)); if (MVST_TPHOLD == mv_st_type) { /* If we are moving an MVST_TPHOLD mv_stent, find it in the tpstack and fix its * address there too. Else we won't unwind to the correct place on a restart. */ fix_tphold_mvc(top, (char *)mv_st_prev, ((char *)mv_st_prev + mvs_size[MVST_TPHOLD])); } memmove(top, mv_st_prev, mvs_size[mv_st_type]); } DBGEHND((stderr, "flush_jmp: Updating offsets for mv_stent at addr 0x"lvaddr" type %d\n", mv_st_ent, mv_st_ent->mv_st_type)); mv_st_ent->mv_st_next = mvs_size[mv_st_ent->mv_st_type]; mv_st_ent = (mv_stent *)top; mv_st_ent->mv_st_next += (unsigned int)((char *)mv_st_prev - top); top += mvs_size[mv_st_ent->mv_st_type]; mv_st_prev = (mv_stent *)((char *)mv_st_ent + mv_st_ent->mv_st_next); } shift = (int4)((char *)frame_pointer - top - size); DBGEHND_ONLY(msp_save = msp); if (shift) { if ((unsigned char *)mv_chain + shift <= stackwarn) { if ((unsigned char *)mv_chain + shift <= stacktop) rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_STACKOFLOW); else rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_STACKCRIT); } DBGEHND((stderr, "flush_jmp: Shifting %d bytes of stack from 0x"lvaddr" to 0x"lvaddr" by %d bytes\n", INTCAST(top - (char *)mv_chain), mv_chain, (mv_chain + shift), shift)); /* Since we are moving one or more mv_stents, it is no more difficult to check the range against the * tp_frame chain than it is to loop through the mv_stents checking each one since the tp_frame stack * is usually no more than 1-3 deep. */ fix_tphold_mvc(((char *)mv_chain + shift), (char *)mv_chain, ((char *)mv_chain + (top - (char *)mv_chain))); memmove((char *)mv_chain + shift, mv_chain, top - (char *)mv_chain); mv_chain = (mv_stent *)((char *)mv_chain + shift); mv_st_ent = (mv_stent *)((char *)mv_st_ent + shift); mv_st_ent->mv_st_next -= shift; msp = (unsigned char *)mv_chain; } memset(frame_pointer->l_symtab, 0, size); DBGEHND((stderr, "flush_jmp: Old msp: 0x"lvaddr" New msp: 0x"lvaddr"\n", msp_save, msp)); return; }
void flush_jmp (rhdtyp *rtn_base, unsigned char *context, unsigned char *transfer_addr) { mv_stent *mv_st_ent, *mv_st_prev; char *top; unsigned char *msp_save; int4 shift, size; error_def(ERR_STACKOFLOW); error_def(ERR_STACKCRIT); unwind_nocounts(); /* We are going to mutate the current frame from the program it was running to the program we want it to run. * If the current frame is marked for indr cache cleanup, do that cleanup now and unmark the frame. */ IF_INDR_FRAME_CLEANUP_CACHE_ENTRY_AND_UNMARK(frame_pointer); frame_pointer->rvector = rtn_base; frame_pointer->vartab_ptr = (char *)VARTAB_ADR(rtn_base); frame_pointer->vartab_len = frame_pointer->rvector->vartab_len; frame_pointer->mpc = transfer_addr; frame_pointer->ctxt = context; #ifdef HAS_LITERAL_SECT frame_pointer->literal_ptr = (int4 *)0; #endif frame_pointer->temp_mvals = frame_pointer->rvector->temp_mvals; size = rtn_base->temp_size; frame_pointer->temps_ptr = (unsigned char *) frame_pointer - size; size += rtn_base->vartab_len * sizeof(mval *); frame_pointer->l_symtab = (mval **)((char *) frame_pointer - size); assert(frame_pointer->type & SFT_COUNT); assert((unsigned char *) mv_chain > stacktop && (unsigned char *) mv_chain <= stackbase); while ((char *) mv_chain < (char *) frame_pointer && !mvs_save[mv_chain->mv_st_type]) { msp = (unsigned char *)mv_chain; op_oldvar(); } if ((char *) mv_chain > (char *) frame_pointer) { msp_save = msp; msp = (unsigned char *)frame_pointer->l_symtab; if (msp <= stackwarn) { if (msp <= stacktop) { msp = msp_save; rts_error(VARLSTCNT(1) ERR_STACKOFLOW); } else rts_error(VARLSTCNT(1) ERR_STACKCRIT); } memset(msp, 0, size); return; } mv_st_ent = mv_chain; mv_st_prev = (mv_stent *)((char *) mv_st_ent + mv_st_ent->mv_st_next); top = (char *) mv_st_ent + mvs_size[mv_st_ent->mv_st_type]; while ((char *) mv_st_prev < (char *) frame_pointer) { if ( !mvs_save[mv_st_prev->mv_st_type] ) { unw_mv_ent(mv_st_prev); mv_st_ent->mv_st_next += mv_st_prev->mv_st_next; mv_st_prev = (mv_stent *)((char *) mv_st_prev + mv_st_prev->mv_st_next); continue; } if (mv_st_prev != (mv_stent *)top) memmove(top, mv_st_prev, mvs_size[mv_st_prev->mv_st_type]); mv_st_ent->mv_st_next = mvs_size[mv_st_ent->mv_st_type]; mv_st_ent = (mv_stent *)top; mv_st_ent->mv_st_next += (char *) mv_st_prev - top; top += mvs_size[mv_st_ent->mv_st_type]; mv_st_prev = (mv_stent *)((char *) mv_st_ent + mv_st_ent->mv_st_next); } shift = (char *) frame_pointer - top - size; if (shift) { if ((unsigned char *)mv_chain + shift <= stackwarn) { if ((unsigned char *)mv_chain + shift <= stacktop) rts_error(VARLSTCNT(1) ERR_STACKOFLOW); else rts_error(VARLSTCNT(1) ERR_STACKCRIT); } memmove((char *) mv_chain + shift, mv_chain, top - (char *) mv_chain); mv_chain = (mv_stent *)((char *) mv_chain + shift); mv_st_ent = (mv_stent *)((char *) mv_st_ent + shift); mv_st_ent->mv_st_next -= shift; msp = (unsigned char *) mv_chain; } memset(frame_pointer->l_symtab, 0, size); return; }