fis-gtm/sr_port/op_unwind.c

151 lines
5.8 KiB
C
Raw Normal View History

/****************************************************************
* *
* Copyright 2001, 2012 Fidelity Information Services, Inc *
* *
* This source code contains the intellectual property *
* of its copyright holder(s), and is made available *
* under a license. If you do not know the terms of *
* the license, please stop and do not read further. *
* *
****************************************************************/
#include "mdef.h"
#include "gtm_stdio.h"
#include "rtnhdr.h"
#include "stack_frame.h"
#include "mv_stent.h"
#include "tp_frame.h"
#include "cache.h"
#include "cache_cleanup.h"
#include "objlabel.h"
#include "op.h"
#include "error_trap.h"
#include "error.h"
#include "tp_timeout.h"
#include "compiler.h"
#include "parm_pool.h"
#ifdef GTM_TRIGGER
# include "gtm_trigger_trc.h"
#endif
GBLREF void (*unw_prof_frame_ptr)(void);
GBLREF stack_frame *frame_pointer, *zyerr_frame;
GBLREF unsigned char *msp, *stackbase, *stacktop;
GBLREF mv_stent *mv_chain;
GBLREF tp_frame *tp_pointer;
GBLREF boolean_t is_tracing_on;
GBLREF boolean_t skip_error_ret;
GBLREF stack_frame *error_frame;
GBLREF mval *alias_retarg;
GBLREF boolean_t tp_timeout_deferred;
GBLREF dollar_ecode_type dollar_ecode;
GBLREF boolean_t ztrap_explicit_null;
GBLREF mval dollar_ztrap;
GBLREF boolean_t dollar_zininterrupt;
GBLREF boolean_t dollar_truth;
error_def(ERR_STACKUNDERFLO);
error_def(ERR_TPQUIT);
/* This has to be maintained in parallel with unw_retarg(), the unwind with a return argument (extrinisic quit) routine. */
void op_unwind(void)
{
mv_stent *mvc;
stack_frame *rfp;
DBGEHND_ONLY(stack_frame *prevfp;)
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
if (frame_pointer->type & SFT_COUNT)
{ /* If unwinding a counted frame, make sure we don't have an alias return argument in flight */
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);
/* Note that error_ret() should be invoked only after the rts_error() of TPQUIT.
* This is so the TPQUIT error gets noted down in $ECODE (which will not happen if error_ret() is called before).
*/
if (!skip_error_ret)
{
INVOKE_ERROR_RET_IF_NEEDED;
} else
{
if (NULL != error_frame)
{
assert(error_frame >= frame_pointer);
if (error_frame <= frame_pointer)
NULLIFY_ERROR_FRAME; /* ZGOTO to frame level lower than primary error level cancels error mode */
}
skip_error_ret = FALSE; /* reset at the earliest point although caller (goframes()) does reset it just in
* case an error occurs before we return to the caller
*/
}
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);
if (NULL != frame_pointer->for_ctrl_stack)
{ /* someone used an ugly FOR control variable */
if (frame_pointer->flags & SFF_INDCE)
{ /* a FOR control variable indx set up in an indirect frame belongs in the underlying "real" frame
* By "real" we mean non-indirect as in not @ induced, in other words: normal code, or XECUTE-like code
* ZTRAP is an interesting case because it might be a label rather than code, but fortunately that condition
* can't intersect with a FOR control variable, which is the case the outer if condition filters on
*/
for (rfp = frame_pointer; rfp && !(rfp->type & SFT_LINE_OF_CODE_FRAME); rfp = rfp->old_frame_pointer)
;
assert(rfp);
if (NULL == rfp->for_ctrl_stack)
rfp->for_ctrl_stack = frame_pointer->for_ctrl_stack;
else /* indirect compilation already cloned the pointer */
assert(rfp->for_ctrl_stack == frame_pointer->for_ctrl_stack);
} else /* otherwise, done with this level - clean it up */
FREE_SAVED_FOR_INDX(frame_pointer);
frame_pointer->for_ctrl_stack = NULL;
}
/* See if unwinding an indirect frame */
IF_INDR_FRAME_CLEANUP_CACHE_ENTRY(frame_pointer);
for (mvc = mv_chain; mvc < (mv_stent *)frame_pointer; )
{
unw_mv_ent(mvc);
mvc = (mv_stent *)(mvc->mv_st_next + (char *)mvc);
}
if (0 <= frame_pointer->dollar_test) /* get dollar_test if it has been set */
dollar_truth = frame_pointer->dollar_test;
if (is_tracing_on GTMTRIG_ONLY( && !(frame_pointer->type & SFT_TRIGR)))
(*unw_prof_frame_ptr)();
mv_chain = mvc;
msp = (unsigned char *)frame_pointer + SIZEOF(stack_frame);
if (msp > stackbase)
rts_error(VARLSTCNT(1) ERR_STACKUNDERFLO);
# ifdef GTM_TRIGGER
if (SFF_TRIGR_CALLD & frame_pointer->type)
DBGTRIGR((stderr, "op_unwind: Unwinding frame 0x"lvaddr" with type %d which has SFF_TRIGR_CALLD turned on\n",
frame_pointer, frame_pointer->type));
# endif
PARM_ACT_UNSTACK_IF_NEEDED;
frame_pointer = frame_pointer->old_frame_pointer;
DBGEHND((stderr, "op_unwind: 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)
{
if ((frame_pointer < (stack_frame *)msp) || (frame_pointer > (stack_frame *)stackbase)
|| (frame_pointer < (stack_frame *)stacktop))
rts_error(VARLSTCNT(1) ERR_STACKUNDERFLO);
assert((frame_pointer < frame_pointer->old_frame_pointer) || (NULL == frame_pointer->old_frame_pointer));
}
/* We just unwound a frame. May have been either a zintrupt frame and/or may have unwound a NEW'd ZTRAP or even cleared
* our error state. If we have a deferred timeout and none of the deferral conditions are anymore in effect, release
* the hounds.
*/
if (tp_timeout_deferred UNIX_ONLY(&& !dollar_zininterrupt) && ((0 == dollar_ecode.index) || !(ETRAP_IN_EFFECT)))
tptimeout_set(0);
return;
}