void ztrap_save_ctxt(void)
{
int level;
error_def(ERR_STACKOFLOW);
error_def(ERR_STACKCRIT);
level = dollar_zlevel();
if (level == MV_FORCE_INT(&ztrap_pop2level))
return;
PUSH_MV_STENT(MVST_MSAV);
mv_chain->mv_st_cont.mvs_msav.v = ztrap_pop2level;
mv_chain->mv_st_cont.mvs_msav.addr = &ztrap_pop2level;
MV_FORCE_MVAL(&ztrap_pop2level, level);
return;
}
void op_fnstack2(int level, mval *info, mval *result)
{
int cur_zlevel;
stack_mode_t mode;
unsigned char info_upper[SIZEOF("MCODE")];
error_def(ERR_INVSTACODE);
mode = DOLLAR_STACK_INVALID;
/* make sure that info is one of the three valid strings */
MV_FORCE_STR(info); /* force input string to null string in case it is undefined */
if (info->str.len == 5)
{
lower_to_upper(info_upper, (unsigned char *)info->str.addr, 5);
if (!memcmp("MCODE", info_upper, SIZEOF("MCODE")-1))
mode = DOLLAR_STACK_MCODE;
else if (!memcmp("ECODE", info_upper, SIZEOF("ECODE")-1))
mode = DOLLAR_STACK_ECODE;
else if (!memcmp("PLACE", info_upper, SIZEOF("PLACE")-1))
mode = DOLLAR_STACK_PLACE;
}
if (DOLLAR_STACK_INVALID == mode)
rts_error(VARLSTCNT(4) ERR_INVSTACODE, 2, info->str.len, info->str.addr);
result->mvtype = MV_STR;
result->str.len = 0; /* set result to null string before any processing */
cur_zlevel = dollar_zlevel();
if (0 <= level)
{
if (!dollar_stack.index)
{
if (level < cur_zlevel)
{
GET_FRAME_INFO(level, mode, cur_zlevel, result);
}
} else if (level < dollar_stack.index)
get_dollar_stack_info(level, mode, result);
else if (!dollar_stack.incomplete && (1 == dollar_ecode.index)
&& (error_frame == dollar_ecode.first_ecode_error_frame) && (level < cur_zlevel))
{
GET_FRAME_INFO(level, mode, cur_zlevel, result);
}
}
return;
}
void op_fnstack1(int level, mval *result)
{
int cur_zlevel;
result->mvtype = MV_STR;
cur_zlevel = dollar_zlevel();
if (-1 == level)
{
if (!dollar_ecode.index)
{
MV_FORCE_MVAL(result, cur_zlevel - 1);
} else if ((1 < dollar_ecode.index) || (error_frame != dollar_ecode.first_ecode_error_frame))
MV_FORCE_MVAL(result, dollar_stack.index - 1);
else
{ /* we are in first ECODE error-handler */
if (cur_zlevel > dollar_stack.index)
{
MV_FORCE_MVAL(result, cur_zlevel - 1);
} else
{
MV_FORCE_MVAL(result, dollar_stack.index - 1);
}
}
} else if (0 > level)
result->str.len = 0;
else if (0 == level)
get_command_line(result, FALSE); /* FALSE to indicate we want actual (not processed) command line */
else if (!dollar_stack.index)
{
if (level < cur_zlevel)
get_frame_creation_info(level, cur_zlevel, result);
else
result->str.len = 0;
} else if (level < dollar_stack.index)
get_dollar_stack_info(level, DOLLAR_STACK_MODE, result);
else if (!dollar_stack.incomplete && (1 == dollar_ecode.index)
&& (error_frame == dollar_ecode.first_ecode_error_frame) && (level < cur_zlevel))
get_frame_creation_info(level, cur_zlevel, result);
else
result->str.len = 0;
return;
}
boolean_t ecode_add(mstr *str) /* add "str" to $ECODE and return whether SUCCESS or FAILURE as TRUE/FALSE */
{
int ecode_index, stack_index;
boolean_t shrink;
int cur_zlevel, level;
char eclostmid_buf[MAX_DIGITS_IN_INT + STR_LIT_LEN(",Z,")], *dest;
ssize_t space_left, eclostmid_len;
error_def(ERR_ECLOSTMID);
dest = &eclostmid_buf[0];
*dest++ = ',';
*dest++ = 'Z';
dest = (char *)i2asc((unsigned char *)dest, ERR_ECLOSTMID);
*dest++ = ',';
eclostmid_len = dest - &eclostmid_buf[0];
assert(SIZEOF(eclostmid_buf) >= eclostmid_len);
assert(str->len < DOLLAR_ECODE_ALLOC);
space_left = dollar_ecode.top - dollar_ecode.end;
ecode_index = dollar_ecode.index;
shrink = FALSE;
if (space_left < str->len)
{
shrink = TRUE;
assert(1 == shrink); /* since we need a value of 1 (instead of any non-zero) for usage below */
space_left -= eclostmid_len - 1;/* note : space_left can become negative but code below handles that */
}
if (ecode_index >= (DOLLAR_ECODE_MAXINDEX - shrink))
{
assert(DOLLAR_ECODE_MAXINDEX >= ecode_index);
if (DOLLAR_ECODE_MAXINDEX == ecode_index)
{
DECR_ECODE_INDEX(ecode_index);
shrink = TRUE;
}
if (shrink)
{
DECR_ECODE_INDEX(ecode_index);
assert((DOLLAR_ECODE_MAXINDEX - 2) == ecode_index);
}
}
assert(ecode_index < DOLLAR_ECODE_MAXINDEX);
for ( ; space_left < (int)str->len; ) /* note explicit typecasting to make sure it is a signed comparison */
{
ecode_index--;
if (1 > ecode_index) /* if ecode_index == -1 ==> str->len > DOLLAR_ECODE_ALLOC so nothing can be done in PRO */
return FALSE; /* if ecode_index == 0 ==> first ECODE needs to be overlaid. we do not want to do that. */
space_left += dollar_ecode.array[ecode_index].ecode_str.len - 1;
}
for (stack_index = 0; stack_index < dollar_stack.index; stack_index++)
{
if (dollar_stack.array[stack_index].ecode_ptr > &dollar_ecode.array[ecode_index])
return FALSE; /* do not want to overlay any ECODE that $STACK(level,"ECODE") is pointing to */
}
assert(0 <= ecode_index);
if (dollar_ecode.index != ecode_index)
{
dollar_ecode.end = dollar_ecode.array[ecode_index].ecode_str.addr;
dollar_ecode.index = ecode_index;
}
if (shrink)
{
INCR_ECODE_INDEX(dollar_ecode.index, &eclostmid_buf[0], (mstr_len_t)eclostmid_len);
}
INCR_ECODE_INDEX(dollar_ecode.index, str->addr, str->len);
if ((1 == dollar_ecode.index)
|| ((!dollar_stack.incomplete) && (2 == dollar_ecode.index)
&& (dollar_ecode.first_ecode_error_frame == error_frame)))
{ /* need to fill in $STACK entries if either the first ECODE or if an error in the first ECODE error-handler.
* do not fill in nested error $STACK info if the first ECODE's $STACK info itself was incompletely filled in */
if (1 == dollar_ecode.index)
{ /* first ECODE. note down error_frame info in "first_ecode_error_frame" as well as $STACK(level) info */
dollar_ecode.first_ecode_error_frame = frame_pointer;
assert(0 == dollar_stack.index);
}
cur_zlevel = dollar_zlevel();
assert(dollar_stack.index <= cur_zlevel);
for (level = dollar_stack.index; level < MIN(cur_zlevel, DOLLAR_STACK_MAXINDEX); )
{ /* we do not store $STACK(level) info for levels > 256 */
if (fill_dollar_stack_level(level, level, cur_zlevel))
level++; /* update array_level only if we had enough space to fill in all of above */
else
break;
}
if ((2 == dollar_ecode.index) && (cur_zlevel == dollar_stack.index) && (DOLLAR_STACK_MAXINDEX > cur_zlevel))
{ /* if nested error occurred at the same frame_level as the first error,
* store $STACK information for the nested error in $STACK(frame_level+1)
*/
assert(level == dollar_stack.index);
if (fill_dollar_stack_level(level, cur_zlevel - 1, cur_zlevel))
level++;
}
dollar_stack.index = level;
}
return TRUE;
}
void error_return(void)
{
int parent_level;
stack_frame *curframe, *cur_counted_frame, *parent_counted_frame;
boolean_t rethrow_needed = FALSE, dev_act_err;
DBGEHND((stderr, "error_return: Entered\n"));
assert((frame_pointer->flags & SFF_ETRAP_ERR) || (error_frame == frame_pointer));
/* Determine counted frame at the current $zlevel */
for (curframe = frame_pointer; (NULL != curframe) && !(curframe->type & SFT_COUNT) && !BASE_FRAME(curframe);
curframe = curframe->old_frame_pointer)
;
cur_counted_frame = curframe;
NULLIFY_ERROR_FRAME; /* reset error_frame */
dev_act_err = ((NULL != cur_counted_frame) && (cur_counted_frame->flags & SFF_ETRAP_ERR)
&& (cur_counted_frame->flags & SFF_DEV_ACT_ERR));
/* If the top level error is a device exception error, we do not want to unwind upto the parent frame but instead
* rethrow the error at the current level and use $ztrap/$etrap exception handling. In case even that fails,
* we will come again to error_return at which point, we will do the unwind upto the parent frame.
*/
if (!dev_act_err && (NULL != curframe)) /* Determine counted frame at the parent $zlevel */
for (curframe = curframe->old_frame_pointer;
(NULL != curframe) && !(curframe->type & SFT_COUNT) && !BASE_FRAME(curframe);
curframe = curframe->old_frame_pointer)
;
parent_counted_frame = curframe;
/* Exit if we are at the bottom of the stack */
parent_level = dollar_zlevel() - 1;
if ((NULL == parent_counted_frame) || (1 > parent_level))
EXIT(dollar_ecode.error_last_ecode);
assert(parent_level > 0);
if (dev_act_err || (!BASE_FRAME(parent_counted_frame) && dollar_ecode.index))
rethrow_needed = TRUE;
DBGEHND((stderr, "error_return: rethrow_needed: %d dev_act_err: %d\n", rethrow_needed, dev_act_err));
if (!dev_act_err)
{
if (parent_counted_frame->type & SFT_DM)
{ /* hack to retain SFT_DM frame from being unwound by golevel */
parent_counted_frame->type |= SFT_COUNT;
GOLEVEL(parent_level + 1, FALSE);
parent_counted_frame->type &= ~SFT_COUNT;
assert(parent_counted_frame->type & SFT_DM);
} else
GOLEVEL(parent_level, FALSE);
/* Check that we have unwound exactly upto the parent counted frame. */
assert(parent_counted_frame == frame_pointer);
} else
{
GOLEVEL(parent_level + 1, FALSE);
/* Check that we have unwound exactly upto the current counted frame. */
assert(cur_counted_frame == frame_pointer);
}
assert(!proc_act_type);
if (rethrow_needed)
{
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_REPEATERROR);
assert(FALSE); /* the previous rts_error() should not return */
}
/* zero the error device just to be safe */
assert(NULL == gtm_err_dev);
gtm_err_dev = NULL;
}
error_def(ERR_ZGOTOINVLVL2);
error_def(ERR_ZGOTOLTZERO);
error_def(ERR_ZGOTOTOOBIG);
void op_zgoto(mval *rtn_name, mval *lbl_name, int offset, int level)
{
stack_frame *fp, *fpprev, *base_frame;
int4 curlvl;
mval rtnname, lblname;
rhdtyp *rtnhdr;
lnr_tabent USHBIN_ONLY(*)*lnrptr;
char rtnname_buff[SIZEOF(mident_fixed)], lblname_buff[SIZEOF(mident_fixed)];
DEBUG_ONLY(int4 dlevel;)
/* Validate level parm */
curlvl = dollar_zlevel();
if (0 > level)
{ /* Negative level specified, means to use relative level change */
if ((-level) > curlvl)
rts_error(VARLSTCNT(1) ERR_ZGOTOLTZERO);
level += curlvl; /* Compute relative desired level */
} else
{ /* Else level is the level we wish to achieve - compute unrolls necessary */
if (0 > (curlvl - level))
/* Couldn't get to the level we were trying to unwind to */
rts_error(VARLSTCNT(1) ERR_ZGOTOTOOBIG);
}
/* Migrate mval parm contents to private buffers since the mvals could die as we unwind things */
MV_FORCE_STR(rtn_name);
MV_FORCE_STR(lbl_name);
rtnname = *rtn_name;
void op_svget(int varnum, mval *v)
{
io_log_name *tl;
int count;
gtm_uint64_t ucount;
char *c1, *c2;
mval *mvp;
# ifdef UNIX
d_rm_struct *d_rm;
# endif
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
# if defined(UNIX) && defined(DEBUG)
if (gtm_white_box_test_case_enabled && (WBTEST_HUGE_ALLOC == gtm_white_box_test_case_number))
{
if (1 == gtm_white_box_test_case_count)
totalAlloc = totalAllocGta = totalRmalloc = totalRallocGta = totalUsed = totalUsedGta = 0xffff;
else if (2 == gtm_white_box_test_case_count)
totalAlloc = totalAllocGta = totalRmalloc = totalRallocGta = totalUsed = totalUsedGta = 0xfffffff;
else if (3 == gtm_white_box_test_case_count)
{
# ifdef GTM64
if (8 == SIZEOF(size_t))
totalAlloc = totalAllocGta = totalRmalloc = totalRallocGta
= totalUsed = totalUsedGta = 0xfffffffffffffff;
else
# endif
totalAlloc = totalAllocGta = totalRmalloc = totalRallocGta = totalUsed = totalUsedGta = 0xfffffff;
} else
totalAlloc = totalAllocGta = totalRmalloc = totalRallocGta = totalUsed
= totalUsedGta = GTM64_ONLY(SIZEOF(size_t)) NON_GTM64_ONLY(SIZEOF(size_t) > 4 ? 4 : SIZEOF(size_t));
}
# endif
switch (varnum)
{
case SV_HOROLOG:
op_horolog(v);
break;
case SV_ZGBLDIR:
v->mvtype = MV_STR;
v->str = dollar_zgbldir.str;
break;
case SV_PRINCIPAL:
tl = dollar_principal ? dollar_principal : io_root_log_name->iod->trans_name;
v->str.addr = tl->dollar_io;
v->str.len = tl->len;
/*** The following should be in the I/O code ***/
if (ESC == *v->str.addr)
{
if (5 > v->str.len)
v->str.len = 0;
else
{
v->str.addr += ESC_OFFSET;
v->str.len -= ESC_OFFSET;
}
}
s2pool(&(v->str));
v->mvtype = MV_STR;
break;
case SV_ZIO:
v->mvtype = MV_STR;
/* NOTE: This is **NOT** equivalent to :
* io_curr_log_name->dollar_io
*/
v->str.addr = io_curr_device.in->trans_name->dollar_io;
v->str.len = io_curr_device.in->trans_name->len;
if (ESC == *v->str.addr)
{
if (5 > v->str.len)
v->str.len = 0;
else
{
v->str.addr += ESC_OFFSET;
v->str.len -= ESC_OFFSET;
}
}
s2pool(&(v->str));
break;
case SV_JOB:
*v = dollar_job;
break;
case SV_REFERENCE:
get_reference(v);
break;
case SV_SYSTEM:
*v = dollar_system;
break;
case SV_STORAGE:
/* double2mval(v, getstorage()); Causes issues with unaligned stack on x86_64 - remove until fixed */
i2mval(v, getstorage());
break;
case SV_TLEVEL:
count = (int)dollar_tlevel;
MV_FORCE_MVAL(v, count);
break;
case SV_TRESTART:
MV_FORCE_MVAL(v, (int)((MAX_VISIBLE_TRESTART < dollar_trestart) ? MAX_VISIBLE_TRESTART : dollar_trestart));
break;
case SV_X:
count = (int)io_curr_device.out->dollar.x;
MV_FORCE_MVAL(v, count);
break;
case SV_Y:
count = (int)io_curr_device.out->dollar.y;
MV_FORCE_MVAL(v, count);
break;
case SV_ZA:
count = (int)io_curr_device.in->dollar.za;
MV_FORCE_MVAL(v, count);
break;
case SV_ZB:
c1 = (char *)io_curr_device.in->dollar.zb;
c2 = c1 + SIZEOF(io_curr_device.in->dollar.zb);
ENSURE_STP_FREE_SPACE(SIZEOF(io_curr_device.in->dollar.zb));
v->mvtype = MV_STR;
v->str.addr = (char *)stringpool.free;
while (c1 < c2 && *c1)
*stringpool.free++ = *c1++;
v->str.len = INTCAST((char *)stringpool.free - v->str.addr);
break;
case SV_ZC: /****THESE ARE DUMMY VALUES ONLY!!!!!!!!!!!!!!!!!****/
MV_FORCE_MVAL(v, 0);
break;
case SV_ZCMDLINE:
get_command_line(v, TRUE); /* TRUE to indicate we want $ZCMDLINE
(i.e. processed not actual command line) */
break;
case SV_ZEOF:
# ifdef UNIX
if (rm == io_curr_device.in->type)
{
d_rm = (d_rm_struct *)io_curr_device.in->dev_sp;
if (RM_READ != d_rm->lastop)
{
*v = literal_zero;
break;
}
}
# endif
*v = io_curr_device.in->dollar.zeof ? literal_one : literal_zero;
break;
case SV_ZQUIT:
*v = dollar_zquit_anyway ? literal_one : literal_zero;
break;
case SV_IO:
v->str.addr = io_curr_device.in->name->dollar_io;
v->str.len = io_curr_device.in->name->len;
/*** The following should be in the I/O code ***/
if (ESC == *v->str.addr)
{
if (5 > v->str.len)
v->str.len = 0;
else
{
v->str.addr += ESC_OFFSET;
v->str.len -= ESC_OFFSET;
}
}
s2pool(&(v->str));
v->mvtype = MV_STR;
break;
case SV_PROMPT:
v->mvtype = MV_STR;
v->str.addr = (TREF(gtmprompt)).addr;
v->str.len = (TREF(gtmprompt)).len;
s2pool(&v->str);
break;
case SV_ZCOMPILE:
v->mvtype = MV_STR;
v->str = TREF(dollar_zcompile);
s2pool(&(v->str));
break;
case SV_ZDIR:
setzdir(NULL, v);
if (v->str.len != dollar_zdir.str.len || 0 != memcmp(v->str.addr, dollar_zdir.str.addr, v->str.len))
gtm_putmsg_csa(CSA_ARG(NULL) VARLSTCNT(6) ERR_ZDIROUTOFSYNC, 4, v->str.len, v->str.addr,
dollar_zdir.str.len, dollar_zdir.str.addr);
SKIP_DEVICE_IF_NOT_NEEDED(v);
s2pool(&(v->str));
break;
case SV_ZSTEP:
*v = dollar_zstep;
break;
case SV_ZMODE:
*v = TREF(dollar_zmode);
break;
case SV_ZMAXTPTIME:
i2mval(v, TREF(dollar_zmaxtptime));
break;
case SV_ZPOS:
getzposition(v);
break;
case SV_ZPROC:
getzprocess();
*v = dollar_zproc;
break;
case SV_ZLEVEL:
count = dollar_zlevel();
MV_FORCE_MVAL(v, count);
break;
case SV_ZROUTINES:
if (!TREF(zro_root))
zro_init();
v->mvtype = MV_STR;
v->str = TREF(dollar_zroutines);
s2pool(&(v->str));
break;
case SV_ZSOURCE:
v->mvtype = MV_STR;
v->str = dollar_zsource.str;
break;
case SV_ZSTATUS:
*v = dollar_zstatus;
s2pool(&(v->str));
break;
case SV_ZTRAP:
v->mvtype = MV_STR;
v->str = dollar_ztrap.str;
assert(!v->str.len || !ztrap_explicit_null);
s2pool(&(v->str));
break;
case SV_DEVICE:
get_dlr_device(v);
break;
case SV_KEY:
get_dlr_key(v);
break;
case SV_ZVERSION:
v->mvtype = MV_STR;
v->str.addr = (char *)gtm_release_name;
v->str.len = gtm_release_name_len;
break;
case SV_ZSYSTEM:
MV_FORCE_MVAL(v, dollar_zsystem);
break;
case SV_ZCSTATUS:
/* Maintain the external $ZCSTATUS == 1 for SUCCESS on UNIX while internal good is 0 */
MV_FORCE_MVAL(v, UNIX_ONLY((0 == TREF(dollar_zcstatus)) ? 1 : ) TREF(dollar_zcstatus));
break;
case SV_ZEDITOR:
MV_FORCE_MVAL(v, dollar_zeditor);
break;
case SV_QUIT:
MV_FORCE_MVAL(v, dollar_quit());
break;
case SV_ECODE:
ecode_get(-1, v);
break;
case SV_ESTACK:
count = (dollar_zlevel() - 1) - dollar_estack_delta.m[0];
MV_FORCE_MVAL(v, count);
break;
case SV_ETRAP:
v->mvtype = MV_STR;
v->str = dollar_etrap.str;
assert(!v->str.len || !ztrap_explicit_null);
s2pool(&(v->str));
break;
case SV_STACK:
count = (dollar_zlevel() - 1);
MV_FORCE_MVAL(v, count);
break;
case SV_ZERROR:
v->mvtype = MV_STR;
v->str = dollar_zerror.str;
s2pool(&(v->str));
break;
case SV_ZYERROR:
v->mvtype = MV_STR;
v->str = dollar_zyerror.str;
s2pool(&(v->str));
break;
case SV_ZINTERRUPT:
v->mvtype = MV_STR;
v->str = dollar_zinterrupt.str;
s2pool(&(v->str));
break;
case SV_ZININTERRUPT:
MV_FORCE_MVAL(v, dollar_zininterrupt);
break;
case SV_ZJOB:
MV_FORCE_UMVAL(v, dollar_zjob);
break;
case SV_ZDATE_FORM:
MV_FORCE_MVAL(v, TREF(zdate_form));
break;
case SV_ZTEXIT:
*v = dollar_ztexit;
break;
case SV_ZALLOCSTOR:
ucount = (gtm_uint64_t)totalAlloc + (gtm_uint64_t)totalAllocGta;
ui82mval(v, ucount);
break;
case SV_ZREALSTOR:
ucount = (gtm_uint64_t)totalRmalloc + (gtm_uint64_t)totalRallocGta;
ui82mval(v, ucount);
break;
case SV_ZUSEDSTOR:
ucount = (gtm_uint64_t)totalUsed + (gtm_uint64_t)totalUsedGta;
ui82mval(v, ucount);
break;
case SV_ZCHSET:
v->mvtype = MV_STR;
v->str = dollar_zchset;
break;
case SV_ZPATNUMERIC:
v->mvtype = MV_STR;
v->str = dollar_zpatnumeric;
break;
case SV_ZTNAME:
case SV_ZTCODE: /* deprecated */
# ifdef GTM_TRIGGER
if (NULL == dollar_ztname)
memcpy(v, &literal_null, SIZEOF(mval));
else
{
v->mvtype = MV_STR;
v->str.addr = dollar_ztname->addr;
v->str.len = dollar_ztname->len;
}
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTDATA:
# ifdef GTM_TRIGGER
/* Value comes from GT.M, but it might be numeric and need conversion to a string */
assert(!dollar_ztdata || MV_DEFINED(dollar_ztdata));
if (NULL != dollar_ztdata)
MV_FORCE_STR(dollar_ztdata);
memcpy(v, (NULL != dollar_ztdata) ? dollar_ztdata : &literal_null, SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTDELIM:
# ifdef GTM_TRIGGER
assert(!dollar_ztdelim || MV_DEFINED(dollar_ztdelim));
if (NULL == dollar_ztdelim || !(MV_STR & dollar_ztdelim->mvtype) || (0 == dollar_ztdelim->str.len))
memcpy(v, &literal_null, SIZEOF(mval));
else
memcpy(v, dollar_ztdelim, SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTOLDVAL:
# ifdef GTM_TRIGGER
/* Value comes from GT.M, but it might be numeric and need conversion to a string */
assert(!dollar_ztoldval || MV_DEFINED(dollar_ztoldval));
if (NULL != dollar_ztoldval)
MV_FORCE_STR(dollar_ztoldval);
memcpy(v, (NULL != dollar_ztoldval) ? dollar_ztoldval : &literal_null, SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTRIGGEROP:
# ifdef GTM_TRIGGER
/* Value comes from GT.M, but assert it's a string */
assert(!dollar_ztriggerop || (MV_STR & dollar_ztriggerop->mvtype));
memcpy(v, (NULL != dollar_ztriggerop) ? dollar_ztriggerop : &literal_null, SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTUPDATE:
# ifdef GTM_TRIGGER
/* Value comes from GT.M, but if there were no delims involved, the value will be undefined, and
* we return a "literal_null".
*/
memcpy(v, ((NULL != dollar_ztupdate && (MV_STR & dollar_ztupdate->mvtype)) ? dollar_ztupdate
: &literal_null), SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTVALUE:
# ifdef GTM_TRIGGER
/* Value comes from user-land so make sure things are proper */
assert(!dollar_ztvalue || MV_DEFINED(dollar_ztvalue));
if (NULL != dollar_ztvalue)
MV_FORCE_STR(dollar_ztvalue);
memcpy(v, (NULL != dollar_ztvalue) ? dollar_ztvalue : &literal_null, SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTWORMHOLE:
# ifdef GTM_TRIGGER
/* Value comes from user-land so make sure things are proper */
mvp = &dollar_ztwormhole;
if (MV_DEFINED(mvp))
{
MV_FORCE_STR(mvp);
memcpy(v, mvp, SIZEOF(mval));
} else
memcpy(v, &literal_null, SIZEOF(mval));
ztwormhole_used = TRUE;
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTSLATE:
# ifdef GTM_TRIGGER
/* Value comes from user-land so make sure things are proper */
assert(MV_DEFINED((&dollar_ztslate)));
mvp = &dollar_ztslate;
MV_FORCE_STR(mvp);
memcpy(v, mvp, SIZEOF(mval));
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTLEVEL:
# ifdef GTM_TRIGGER
MV_FORCE_MVAL(v, gtm_trigger_depth);
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZONLNRLBK:
# ifdef UNIX
count = TREF(dollar_zonlnrlbk);
MV_FORCE_MVAL(v, count);
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZCLOSE:
# ifdef UNIX
count = TREF(dollar_zclose);
MV_FORCE_MVAL(v, count);
break;
# else
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZKEY:
get_dlr_zkey(v);
break;
default:
assertpro(FALSE);
}
}
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);
}
