/*
* ------------------------------------------
* Hang the process for a specified time.
*
* Goes to sleep for a positive value.
* Any caught signal will terminate the sleep
* following the execution of that signal's catching routine.
*
* Arguments:
* num - time to sleep
*
* Return:
* none
* ------------------------------------------
*/
void op_hang(mval* num)
{
int ms;
#ifdef VMS
uint4 time[2];
int4 efn_mask, status;
error_def(ERR_SYSCALL);
#endif
ms = 0;
MV_FORCE_NUM(num);
if (num->mvtype & MV_INT)
{
if (0 < num->m[1])
{
assert(MV_BIAS >= 1000); /* if formats change overflow may need attention */
ms = num->m[1] * (1000 / MV_BIAS);
}
} else if (0 == num->sgn) /* if sign is not 0 it means num is negative */
ms = mval2i(num) * 1000; /* too big to care about fractional amounts */
if (ms)
{
UNIX_ONLY(hiber_start(ms);)
VMS_ONLY(
time[0] = -time_low_ms(ms);
time[1] = -time_high_ms(ms) - 1;
efn_mask = (1 << efn_outofband | 1 << efn_timer);
if (SS$_NORMAL != (status = sys$setimr(efn_timer, &time, NULL, &time, 0)))
rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$setimr"), CALLFROM, status);
if (SS$_NORMAL != (status = sys$wflor(efn_outofband, efn_mask)))
rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$wflor"), CALLFROM, status);
)
if (outofband)
void cdbg_dump_mval(int indent, mval *mv)
{
boolean_t first;
double mvf;
int4 mvd;
PRINTF("%s Type: 0x%1x (", cdbg_indent(indent), mv->mvtype);
first = TRUE;
if (mv->mvtype & MV_NM)
{
PRINTF("Number");
first = FALSE;
}
if (mv->mvtype & MV_INT)
{
if (!first)
PRINTF(", ");
PRINTF("Integer");
first = FALSE;
}
if (mv->mvtype & MV_STR)
{
if (!first)
PRINTF(", ");
PRINTF("String");
first = FALSE;
}
if (first)
{
PRINTF("Undefined MVAL)\n");
return;
}
PRINTF(") Sign: %d Exp: %d\n", mv->sgn, mv->e);
if (mv->mvtype & MV_NUM_MASK)
{
if (mv->mvtype & MV_INT)
{
mvd = mval2i(mv);
PRINTF("%s Integer value: %d\n", cdbg_indent(indent), mvd);
} else
{
mvf = mval2double(mv);
PRINTF("%s Double value: %f\n", cdbg_indent(indent), mvf);
}
}
if (mv->mvtype & MV_STR)
{
if (!mv->str.len)
PRINTF("%s String value: <null value>\n", cdbg_indent(indent));
else
cdbg_dump_mstr(indent, &mv->str);
}
}
/* Set ^#t(<gbl>,"#TRHASH",hash_code,nnn)=<gbl>_$c(0)_trigindx where gv_currkey is ^#t(<gbl>).
* Note: This routine has code very similar to that in "add_trigger_hash_entry". There is just
* not enough commonality to justify merging the two.
*/
STATICFNDEF void gvtr_set_hashtrhash(char *trigvn, int trigvn_len, uint4 hash_code, int trigindx)
{
uint4 curend;
mval mv_indx, *mv_indx_ptr;
mval mv_hash;
int hash_indx, num_len;
char name_and_index[MAX_MIDENT_LEN + 1 + MAX_DIGITS_IN_INT];
char *ptr;
char indx_str[MAX_DIGITS_IN_INT];
uint4 len;
int4 result;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
curend = gv_currkey->end; /* note down gv_currkey->end before changing it so we can restore it before function returns */
assert(KEY_DELIMITER == gv_currkey->base[curend]);
assert(gv_target->gd_csa == cs_addrs);
/* Set ^#t(<gvn>,"#TRHASH",kill_hash_code,i). To do that, first determine the
* highest i such that ^#t(<gvn>,"#TRHASH",kill_hash_code,i) exists. Set
* ^#t(<gvn>,"#TRHASH",kill_hash_code,i+1)=kill_hash_code in that case.
*/
MV_FORCE_UMVAL(&mv_hash, hash_code);
BUILD_HASHT_SUB_SUB_MSUB_SUB_CURRKEY(trigvn, trigvn_len, LITERAL_HASHTRHASH, STRLEN(LITERAL_HASHTRHASH), mv_hash, "", 0);
op_zprevious(&mv_indx);
mv_indx_ptr = &mv_indx;
hash_indx = (0 == mv_indx.str.len) ? 1 : (mval2i(mv_indx_ptr) + 1);
i2mval(mv_indx_ptr, hash_indx);
MV_FORCE_STR(mv_indx_ptr);
/* Prepare the value of the SET */
num_len = 0;
I2A(indx_str, num_len, trigindx);
assert(MAX_MIDENT_LEN >= trigvn_len);
memcpy(name_and_index, trigvn, trigvn_len);
ptr = name_and_index + trigvn_len;
*ptr++ = '\0';
memcpy(ptr, indx_str, num_len);
len = trigvn_len + 1 + num_len;
/* Do the SET */
SET_TRIGGER_GLOBAL_SUB_SUB_MSUB_MSUB_STR(trigvn, trigvn_len,
LITERAL_HASHTRHASH, STRLEN(LITERAL_HASHTRHASH), mv_hash, mv_indx, name_and_index, len, result);
assert(PUT_SUCCESS == result);
gv_currkey->end = curend; /* reset gv_currkey->end to what it was at function entry */
gv_currkey->base[curend] = KEY_DELIMITER; /* restore terminator for entire key so key is well-formed */
return;
}
void op_svput(int varnum, mval *v)
{
int i, ok, state;
char *vptr;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
switch (varnum)
{
case SV_X:
MV_FORCE_NUM(v);
io_curr_device.out->dollar.x = (short)MV_FORCE_INT(v);
if ((short)(io_curr_device.out->dollar.x) < 0)
io_curr_device.out->dollar.x = 0;
break;
case SV_Y:
MV_FORCE_NUM(v);
io_curr_device.out->dollar.y = (short)MV_FORCE_INT(v);
if ((short)(io_curr_device.out->dollar.y) < 0)
io_curr_device.out->dollar.y = 0;
break;
case SV_ZCOMPILE:
MV_FORCE_STR(v);
if ((TREF(dollar_zcompile)).addr)
free ((TREF(dollar_zcompile)).addr);
(TREF(dollar_zcompile)).addr = (char *)malloc(v->str.len);
memcpy((TREF(dollar_zcompile)).addr, v->str.addr, v->str.len);
(TREF(dollar_zcompile)).len = v->str.len;
break;
case SV_ZSTEP:
MV_FORCE_STR(v);
op_commarg(v,indir_linetail);
op_unwind();
dollar_zstep = *v;
break;
case SV_ZGBLDIR:
MV_FORCE_STR(v);
if ((dollar_zgbldir.str.len != v->str.len)
|| memcmp(dollar_zgbldir.str.addr, v->str.addr, dollar_zgbldir.str.len))
{
if (0 == v->str.len)
{
/* set $zgbldir="" */
dpzgbini();
gd_header = NULL;
} else
{
gd_header = zgbldir(v);
/* update the gd_map */
SET_GD_MAP;
dollar_zgbldir.str.len = v->str.len;
dollar_zgbldir.str.addr = v->str.addr;
s2pool(&dollar_zgbldir.str);
}
if (NULL != gv_currkey)
{
gv_currkey->base[0] = '\0';
gv_currkey->prev = gv_currkey->end = 0;
} else if (NULL != gd_header)
gvinit();
if (NULL != gv_target)
gv_target->clue.end = 0;
}
break;
case SV_ZMAXTPTIME:
dollar_zmaxtptime = mval2i(v);
break;
case SV_ZROUTINES:
MV_FORCE_STR(v);
/* The string(v) should be parsed and loaded before setting $zroutines
* to retain the old value in case errors occur while loading */
zro_load(&v->str);
if ((TREF(dollar_zroutines)).addr)
free ((TREF(dollar_zroutines)).addr);
(TREF(dollar_zroutines)).addr = (char *)malloc(v->str.len);
memcpy((TREF(dollar_zroutines)).addr, v->str.addr, v->str.len);
(TREF(dollar_zroutines)).len = v->str.len;
break;
case SV_ZSOURCE:
MV_FORCE_STR(v);
dollar_zsource.mvtype = MV_STR;
dollar_zsource.str = v->str;
break;
case SV_ZTRAP:
# ifdef GTM_TRIGGER
if (0 < gtm_trigger_depth)
rts_error(VARLSTCNT(1) ERR_NOZTRAPINTRIG);
# endif
MV_FORCE_STR(v);
if (ztrap_new)
op_newintrinsic(SV_ZTRAP);
dollar_ztrap.mvtype = MV_STR;
dollar_ztrap.str = v->str;
/* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
if (!v->str.len)
{
dollar_etrap.mvtype = MV_STR;
dollar_etrap.str = v->str;
ztrap_explicit_null = TRUE;
} else /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
{
ztrap_explicit_null = FALSE;
if (dollar_etrap.str.len > 0)
gtm_newintrinsic(&dollar_etrap);
}
if (ztrap_form & ZTRAP_POP)
ztrap_save_ctxt();
if (tp_timeout_deferred && !dollar_zininterrupt)
/* A tp timeout was deferred. Now that $ETRAP is no longer in effect and no job interrupt is in
* effect, the timeout need no longer be deferred and can be recognized.
*/
tptimeout_set(0);
break;
case SV_ZSTATUS:
MV_FORCE_STR(v);
dollar_zstatus.mvtype = MV_STR;
dollar_zstatus.str = v->str;
break;
case SV_PROMPT:
MV_FORCE_STR(v);
MV_FORCE_LEN_STRICT(v); /* Ensure that direct mode prompt will not have BADCHARs,
* otherwise the BADCHAR error may fill up the filesystem
*/
if (v->str.len <= SIZEOF_prombuf)
(TREF(gtmprompt)).len = v->str.len;
else if (!gtm_utf8_mode)
(TREF(gtmprompt)).len = SIZEOF_prombuf;
# ifdef UNICODE_SUPPORTED
else
{
UTF8_LEADING_BYTE(v->str.addr + SIZEOF_prombuf, v->str.addr, vptr);
(TREF(gtmprompt)).len = INTCAST(vptr - v->str.addr);
}
# endif
memcpy((TREF(gtmprompt)).addr, v->str.addr, (TREF(gtmprompt)).len);
break;
case SV_ECODE:
MV_FORCE_STR(v);
if (v->str.len)
{
/* Format must be like ,Mnnn,Mnnn,Zxxx,Uxxx,
* Mnnn are ANSI standard error codes
* Zxxx are implementation-specific codes
* Uxxx are end-user defined codes
* Note that there must be commas at the start and at the end
*/
for (state = 2, i = 0; (i < v->str.len) && (state <= 2); i++)
{
switch(state)
{
case 2: state = (v->str.addr[i] == ',') ? 1 : 101;
break;
case 1: state = ((v->str.addr[i] == 'M') ||
(v->str.addr[i] == 'U') ||
(v->str.addr[i] == 'Z')) ? 0 : 101;
break;
case 0: state = (v->str.addr[i] == ',') ? 1 : 0;
break;
}
}
/* The above check would pass strings like ","
* so double-check that there are at least three characters
* (starting comma, ending comma, and something in between)
*/
if ((state != 1) || (v->str.len < 3))
{
/* error, ecode = M101 */
rts_error(VARLSTCNT(4) ERR_INVECODEVAL, 2, v->str.len, v->str.addr);
}
}
if (v->str.len > 0)
{
ecode_add(&v->str);
rts_error(VARLSTCNT(2) ERR_SETECODE, 0);
} else
{
NULLIFY_DOLLAR_ECODE; /* reset $ECODE related variables to correspond to $ECODE = NULL state */
NULLIFY_ERROR_FRAME; /* we are no more in error-handling mode */
if (tp_timeout_deferred && !dollar_zininterrupt)
/* A tp timeout was deferred. Now that we are clear of error handling and no job interrupt
* is in process, allow the timeout to be recognized.
*/
tptimeout_set(0);
}
break;
case SV_ETRAP:
MV_FORCE_STR(v);
dollar_etrap.mvtype = MV_STR;
dollar_etrap.str = v->str;
/* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
if (!v->str.len)
{
dollar_ztrap.mvtype = MV_STR;
dollar_ztrap.str = v->str;
} else if (dollar_ztrap.str.len > 0)
{ /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
assert(FALSE == ztrap_explicit_null);
gtm_newintrinsic(&dollar_ztrap);
}
ztrap_explicit_null = FALSE;
break;
case SV_ZERROR:
MV_FORCE_STR(v);
dollar_zerror.mvtype = MV_STR;
dollar_zerror.str = v->str;
break;
case SV_ZYERROR:
MV_FORCE_STR(v);
dollar_zyerror.mvtype = MV_STR;
dollar_zyerror.str = v->str;
break;
case SV_SYSTEM:
assert(FALSE);
rts_error(VARLSTCNT(4) ERR_SYSTEMVALUE, 2, v->str.len, v->str.addr);
break;
case SV_ZDIR:
setzdir(v, NULL); /* change directory to v */
getzdir(); /* update dollar_zdir with current working directory */
break;
case SV_ZINTERRUPT:
MV_FORCE_STR(v);
dollar_zinterrupt.mvtype = MV_STR;
dollar_zinterrupt.str = v->str;
break;
case SV_ZDATE_FORM:
MV_FORCE_NUM(v);
TREF(zdate_form) = (short)MV_FORCE_INT(v);
break;
case SV_ZTEXIT:
MV_FORCE_STR(v);
dollar_ztexit.mvtype = MV_STR;
dollar_ztexit.str = v->str;
/* Coercing $ZTEXIT to boolean at SET command is more efficient than coercing before each
* rethrow at TR/TRO. Since we want to maintain dollar_ztexit as a string, coercion should
* not be performed on dollar_ztext, but on a temporary (i.e. parameter v)
*/
dollar_ztexit_bool = MV_FORCE_BOOL(v);
break;
case SV_ZQUIT:
dollar_zquit_anyway = MV_FORCE_BOOL(v);
break;
case SV_ZTVALUE:
# ifdef GTM_TRIGGER
assert(!dollar_tlevel || (tstart_trigger_depth <= gtm_trigger_depth));
if (!dollar_tlevel || (tstart_trigger_depth == gtm_trigger_depth))
rts_error(VARLSTCNT(4) ERR_SETINTRIGONLY, 2, RTS_ERROR_TEXT("$ZTVALUE"));
if (dollar_ztriggerop != &gvtr_cmd_mval[GVTR_CMDTYPE_SET])
rts_error(VARLSTCNT(4) ERR_SETINSETTRIGONLY, 2, RTS_ERROR_TEXT("$ZTVALUE"));
assert(0 < gtm_trigger_depth);
memcpy(dollar_ztvalue, v, SIZEOF(mval));
dollar_ztvalue->mvtype &= ~MV_ALIASCONT; /* Make sure to shut off alias container flag on copy */
assert(NULL != ztvalue_changed_ptr);
*ztvalue_changed_ptr = TRUE;
break;
# else
rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTWORMHOLE:
# ifdef GTM_TRIGGER
MV_FORCE_STR(v);
/* See jnl.h for why MAX_ZTWORMHOLE_SIZE should be less than minimum alignsize */
assert(MAX_ZTWORMHOLE_SIZE < (JNL_MIN_ALIGNSIZE * DISK_BLOCK_SIZE));
if (MAX_ZTWORMHOLE_SIZE < v->str.len)
rts_error(VARLSTCNT(4) ERR_ZTWORMHOLE2BIG, 2, v->str.len, MAX_ZTWORMHOLE_SIZE);
dollar_ztwormhole.mvtype = MV_STR;
dollar_ztwormhole.str = v->str;
break;
# else
rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
# endif
case SV_ZTSLATE:
# ifdef GTM_TRIGGER
assert(!dollar_tlevel || (tstart_trigger_depth <= gtm_trigger_depth));
if (!dollar_tlevel || (tstart_trigger_depth == gtm_trigger_depth))
rts_error(VARLSTCNT(4) ERR_SETINTRIGONLY, 2, RTS_ERROR_TEXT("$ZTSLATE"));
assert(0 < gtm_trigger_depth);
MV_FORCE_DEFINED(v);
memcpy((char *)&dollar_ztslate, v, SIZEOF(mval));
dollar_ztslate.mvtype &= ~MV_ALIASCONT; /* Make sure to shut off alias container flag on copy */
break;
# else
rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
# endif
default:
GTMASSERT;
}
return;
}
void op_svput(int varnum, mval *v)
{
int i, ok, state;
error_def(ERR_UNIMPLOP);
error_def(ERR_TEXT);
error_def(ERR_INVECODEVAL);
error_def(ERR_SETECODE);
error_def(ERR_SYSTEMVALUE);
switch (varnum)
{
case SV_X:
MV_FORCE_NUM(v);
io_curr_device.out->dollar.x = (short)MV_FORCE_INT(v);
if ((short)(io_curr_device.out->dollar.x) < 0)
io_curr_device.out->dollar.x = 0;
break;
case SV_Y:
MV_FORCE_NUM(v);
io_curr_device.out->dollar.y = (short)MV_FORCE_INT(v);
if ((short)(io_curr_device.out->dollar.y) < 0)
io_curr_device.out->dollar.y = 0;
break;
case SV_ZCOMPILE:
MV_FORCE_STR(v);
if (dollar_zcompile.addr)
free (dollar_zcompile.addr);
dollar_zcompile.addr = (char *)malloc(v->str.len);
memcpy (dollar_zcompile.addr, v->str.addr, v->str.len);
dollar_zcompile.len = v->str.len;
break;
case SV_ZSTEP:
MV_FORCE_STR(v);
op_commarg(v,indir_linetail);
op_unwind();
dollar_zstep = *v;
break;
case SV_ZGBLDIR:
MV_FORCE_STR(v);
if (!(dollar_zgbldir.str.len == v->str.len &&
!memcmp(dollar_zgbldir.str.addr, v->str.addr,
dollar_zgbldir.str.len)))
{
if(v->str.len == 0)
{
/* set $zgbldir="" */
dpzgbini();
gd_header = NULL;
} else
{
gd_header = zgbldir(v);
dollar_zgbldir.str.len = v->str.len;
dollar_zgbldir.str.addr = v->str.addr;
s2pool(&dollar_zgbldir.str);
}
if (gv_currkey)
gv_currkey->base[0] = 0;
if (gv_target)
gv_target->clue.end = 0;
}
break;
case SV_ZMAXTPTIME:
dollar_zmaxtptime = mval2i(v);
break;
case SV_ZROUTINES:
MV_FORCE_STR(v);
/* The string(v) should be parsed and loaded before setting $zroutines
* to retain the old value in case errors occur while loading */
zro_load(&v->str);
if (dollar_zroutines.addr)
free (dollar_zroutines.addr);
dollar_zroutines.addr = (char *)malloc(v->str.len);
memcpy (dollar_zroutines.addr, v->str.addr, v->str.len);
dollar_zroutines.len = v->str.len;
break;
case SV_ZSOURCE:
MV_FORCE_STR(v);
dollar_zsource = v->str;
break;
case SV_ZTRAP:
MV_FORCE_STR(v);
if (ztrap_new)
op_newintrinsic(SV_ZTRAP);
dollar_ztrap.mvtype = MV_STR;
dollar_ztrap.str = v->str;
/* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
if (!v->str.len)
{
dollar_etrap.mvtype = MV_STR;
dollar_etrap.str = v->str;
ztrap_explicit_null = TRUE;
} else /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
{
ztrap_explicit_null = FALSE;
if (dollar_etrap.str.len > 0)
gtm_newintrinsic(&dollar_etrap);
}
if (ztrap_form & ZTRAP_POP)
ztrap_save_ctxt();
break;
case SV_ZSTATUS:
MV_FORCE_STR(v);
dollar_zstatus.mvtype = MV_STR;
dollar_zstatus.str = v->str;
break;
case SV_PROMPT:
MV_FORCE_STR(v);
gtmprompt.len = v->str.len < sizeof(prombuf) ? v->str.len : sizeof(prombuf);
memcpy(gtmprompt.addr,v->str.addr,gtmprompt.len);
break;
case SV_ECODE:
MV_FORCE_STR(v);
if (v->str.len)
{
/* Format must be like ,Mnnn,Mnnn,Zxxx,Uxxx,
* Mnnn are ANSI standard error codes
* Zxxx are implementation-specific codes
* Uxxx are end-user defined codes
* Note that there must be commas at the start and at the end
*/
for (state = 2, i = 0; (i < v->str.len) && (state <= 2); i++)
{
switch(state)
{
case 2:
state = (v->str.addr[i] == ',') ? 1 : 101;
break;
case 1:
state = ((v->str.addr[i] == 'M') ||
(v->str.addr[i] == 'U') ||
(v->str.addr[i] == 'Z')) ? 0 : 101;
break;
case 0:
state = (v->str.addr[i] == ',') ? 1 : 0;
break;
}
}
/* The above check would pass strings like ","
* so double-check that there are at least three characters
* (starting comma, ending comma, and something in between)
*/
if ((state != 1) || (v->str.len < 3))
{
/* error, ecode = M101 */
rts_error(VARLSTCNT(4) ERR_INVECODEVAL, 2, v->str.len, v->str.addr);
}
}
if (v->str.len > 0)
{
ecode_add(&v->str);
rts_error(VARLSTCNT(2) ERR_SETECODE, 0);
} else
{
NULLIFY_DOLLAR_ECODE; /* reset $ECODE related variables to correspond to $ECODE = NULL state */
NULLIFY_ERROR_FRAME; /* we are no more in error-handling mode */
}
break;
case SV_ETRAP:
MV_FORCE_STR(v);
dollar_etrap.mvtype = MV_STR;
dollar_etrap.str = v->str;
/* Setting either $ZTRAP or $ETRAP to empty causes any current error trapping to be canceled */
if (!v->str.len)
{
dollar_ztrap.mvtype = MV_STR;
dollar_ztrap.str = v->str;
} else if (dollar_ztrap.str.len > 0)
{ /* Ensure that $ETRAP and $ZTRAP are not both active at the same time */
assert(FALSE == ztrap_explicit_null);
gtm_newintrinsic(&dollar_ztrap);
}
ztrap_explicit_null = FALSE;
break;
case SV_ZERROR:
MV_FORCE_STR(v);
dollar_zerror.mvtype = MV_STR;
dollar_zerror.str = v->str;
break;
case SV_ZYERROR:
MV_FORCE_STR(v);
dollar_zyerror.mvtype = MV_STR;
dollar_zyerror.str = v->str;
break;
case SV_SYSTEM:
ok = 1;
if (!(v->mvtype & MV_STR))
ok = 0;
if (ok && v->str.addr[0] != '4')
ok = 0;
if (ok && v->str.addr[1] != '7')
ok = 0;
if ((' ' != v->str.addr[2]) && !ispunct(v->str.addr[2]))
ok = 0;
if (ok)
dollar_system.str = v->str;
else
rts_error(VARLSTCNT(4) ERR_SYSTEMVALUE, 2, v->str.len, v->str.addr);
break;
case SV_ZDIR:
setzdir(v, NULL); /* change directory to v */
getzdir(); /* update dollar_zdir with current working directory */
break;
case SV_ZINTERRUPT:
MV_FORCE_STR(v);
dollar_zinterrupt.mvtype = MV_STR;
dollar_zinterrupt.str = v->str;
break;
case SV_ZDATE_FORM:
MV_FORCE_NUM(v);
zdate_form = (short)MV_FORCE_INT(v);
break;
case SV_ZTEXIT:
MV_FORCE_STR(v);
dollar_ztexit.mvtype = MV_STR;
dollar_ztexit.str = v->str;
/* Coercing $ZTEXIT to boolean at SET command is more efficient than coercing before each
* rethrow at TR/TRO. Since we want to maintain dollar_ztexit as a string, coercion should
* not be performed on dollar_ztext, but on a temporary (i.e. parameter v) */
dollar_ztexit_bool = MV_FORCE_BOOL(v);
break;
default:
GTMASSERT;
}
return;
}
/* Upgrade ^#t global in "reg" region */
void trigger_upgrade(gd_region *reg)
{
boolean_t est_first_pass, do_upgrade, is_defined;
boolean_t was_null = FALSE, is_null = FALSE;
int seq_num, trig_seq_num;
int currlabel;
mval tmpmval, xecuteimval, *gvname, *tmpmv, *tmpmv2;
int4 result, tmpint4;
uint4 curend, gvname_prev, xecute_curend;
uint4 hash_code, kill_hash_code;
int count, i, xecutei, tncount;
char *trigname, *trigindex, *ptr;
char name_and_index[MAX_MIDENT_LEN + 1 + MAX_DIGITS_IN_INT];
char trigvn[MAX_MIDENT_LEN + 1 + MAX_DIGITS_IN_INT], nullbyte[1];
uint4 trigname_len, name_index_len;
int ilen;
sgmnt_addrs *csa;
jnl_private_control *jpc;
uint4 sts;
int close_res;
hash128_state_t hash_state, kill_hash_state;
uint4 hash_totlen, kill_hash_totlen;
int trig_protected_mval_push_count;
# ifdef DEBUG
int save_dollar_tlevel;
# endif
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(gv_cur_region == reg);
assert(!dollar_tlevel); /* caller should have ensured this. this is needed as otherwise things get complicated. */
assert(!is_replicator); /* caller should have ensured this. this is needed so we dont bump jnl_seqno (if replicating) */
csa = &FILE_INFO(reg)->s_addrs;
assert(csa->hdr->hasht_upgrade_needed);
/* If before-image journaling is turned on in this region (does not matter if replication is turned on or not),
* once this transaction is done, we need to switch to new journal file and cut the back link because
* otherwise it is possible for backward journal recovery (or rollback) or source server to encounter
* the journal records generated in this ^#t-upgrade-transaction in which case they dont know to handle
* it properly (e.g. rollback or backward recovery does not know to restore csa->hdr->hasht_upgrade_needed
* if it rolls back this transaction). To achieve this, we set hold_onto_crit to TRUE and do the jnl link
* cut AFTER the transaction commits but before anyone else can sneak in to do any more updates.
* Since most often we expect databases to be journaled, we do this hold_onto_crit even for the non-journaled case.
*/
grab_crit(reg);
csa->hold_onto_crit = TRUE;
DEBUG_ONLY(save_dollar_tlevel = dollar_tlevel);
assert(!donot_INVOKE_MUMTSTART);
DEBUG_ONLY(donot_INVOKE_MUMTSTART = TRUE);
op_tstart(IMPLICIT_TSTART, TRUE, &literal_batch, 0); /* 0 ==> save no locals but RESTART OK */
ESTABLISH_NORET(trigger_upgrade_ch, est_first_pass);
/* On a TP restart anywhere down below, this line is where the restart resumes execution from */
assert(donot_INVOKE_MUMTSTART); /* Make sure still set for every try/retry of TP transaction */
change_reg(); /* TP_CHANGE_REG wont work as we need to set sgm_info_ptr */
assert(NULL != cs_addrs);
assert(csa == cs_addrs);
SET_GVTARGET_TO_HASHT_GBL(csa); /* sets up gv_target */
assert(NULL != gv_target);
INITIAL_HASHT_ROOT_SEARCH_IF_NEEDED; /* Needed to do every retry in case restart was due to an online rollback.
* This also sets up gv_currkey */
/* Do actual upgrade of ^#t global.
*
* Below is a sample layout of the label 2 ^#t global
* -------------------------------------------------------
* ^#t("#TNAME","x")="a"_$C(0)_"1" (present in DEFAULT only)
* ^#t("#TRHASH",89771515,1)="a"_$C(0)_"1" (present in DEFAULT only)
* ^#t("#TRHASH",106937755,1)="a"_$C(0)_"1" (present in DEFAULT only)
* ^#t("a",1,"BHASH")="106937755"
* ^#t("a",1,"CHSET")="M"
* ^#t("a",1,"CMD")="S"
* ^#t("a",1,"LHASH")="89771515"
* ^#t("a",1,"TRIGNAME")="x#"
* ^#t("a",1,"XECUTE")=" do ^twork"
* ^#t("a","#COUNT")="1"
* ^#t("a","#CYCLE")="1"
* ^#t("a","#LABEL")="2"
*
* Below is a sample layout of the label 3 ^#t global
* -------------------------------------------------------
* ^#t("#LABEL")="3" (present only after upgrade, not regular trigger load)
* ^#t("#TNAME","x")="a"_$C(0)_"1" (present in CURRENT region)
* ^#t("a",1,"BHASH")="71945627"
* ^#t("a",1,"CHSET")="M"
* ^#t("a",1,"CMD")="S"
* ^#t("a",1,"LHASH")="71945627"
* ^#t("a",1,"TRIGNAME")="x#"
* ^#t("a",1,"XECUTE")=" do ^twork"
* ^#t("a","#COUNT")="1"
* ^#t("a","#CYCLE")="2"
* ^#t("a","#LABEL")="3"
* ^#t("a","#TRHASH",71945627,1)="a"_$C(0)_"1"
*
* Key aspects of the format change
* ----------------------------------
* 1) New ^#t("#LABEL")="3" to indicate the format of the ^#t global. This is in addition to
* ^#t("a","#LABEL") etc. which is already there. This way we have a #LABEL for not just the installed
* triggers but also for the name information stored in the #TNAME nodes.
* 2) In the BHASH and LHASH fields. The hash computation is different so there are more chances of BHASH and LHASH
* matching in which case we store only one #TRHASH entry (instead of two). So thre is fewer ^#t records in the new
* format in most cases.
* 3) ^#t("a","#LABEL") bumps from 2 to 3. Similarly ^#t("a","#CYCLE") bumps by one (to make sure triggers for this
* global get re-read if and when we implement an -ONLINE upgrade).
* 4) DEFAULT used to have ^#t("#TNAME",...) nodes corresponding to triggers across ALL regions in the gbldir and
* other regions used to have NO ^#t("#TNAME",...) nodes whereas after the upgrade every region have
* ^#t("#TNAME",...) nodes corresponding to triggers installed in that region. So it is safer to kill ^#t("#TNAME")
* nodes and add them as needed.
* 5) #TRHASH has moved from ^#t() to ^#t(<gbl>). So it is safer to kill ^#t("#TRHASH") nodes and add them as needed.
*
* Below is a sample layout of the label 4 ^#t global
* -------------------------------------------------------
* ^#t("#TNAME","x")="a"_$C(0)_"1" (present in CURRENT region)
* ^#t("a",1,"BHASH")="71945627"
* ^#t("a",1,"CHSET")="M"
* ^#t("a",1,"CMD")="S"
* ^#t("a",1,"LHASH")="71945627"
* ^#t("a",1,"TRIGNAME")="x#"
* ^#t("a",1,"XECUTE")=" do ^twork"
* ^#t("a","#COUNT")="1"
* ^#t("a","#CYCLE")="2"
* ^#t("a","#LABEL")="4"
* ^#t("a","#TRHASH",71945627,1)="a"_$C(0)_"1"
*
* Key aspects of the format change
* ----------------------------------
* 1) Removed ^#t("#LABEL") as it is redundant information and trigger load does not include it
* 2) Multiline triggers were incorrectly processed resulting in incorrect BHASH and LHASH values. Upgrade fixes this
* 3) ^#t("a","#LABEL") bumps from 3 to 4. Similarly ^#t("a","#CYCLE") bumps by one (to make sure
* triggers for this global get re-read if and when we implement an -ONLINE upgrade).
*/
tmpmv = &tmpmval; /* At all points maintain this relationship. The two are used interchangeably below */
if (gv_target->root)
do_upgrade = TRUE;
/* The below logic assumes ^#t global does not have any integrity errors */
assert(do_upgrade); /* caller should have not invoked us otherwise */
if (do_upgrade)
{ /* kill ^#t("#TRHASH"), ^#t("#TNAME") and ^#t("#LABEL") first. Regenerate each again as we process ^#t(<gbl>,...) */
csa->incr_db_trigger_cycle = TRUE; /* so that we increment csd->db_trigger_cycle at commit time.
* this forces concurrent processes to read upgraded triggers.
*/
if (JNL_WRITE_LOGICAL_RECS(csa))
{ /* Note that the ^#t upgrade is a physical layout change. But it has no logical change (i.e. users
* see the same MUPIP TRIGGER -SELECT output as before). So write only a dummy LGTRIG journal
* record for this operation. Hence write a string that starts with a trigger comment character ";".
*/
assert(!gv_cur_region->read_only);
jnl_format(JNL_LGTRIG, NULL, (mval *)&literal_trigjnlrec, 0);
}
/* KILL ^#t("#LABEL") unconditionally */
BUILD_HASHT_SUB_CURRKEY(LITERAL_HASHLABEL, STRLEN(LITERAL_HASHLABEL));
if (0 != gvcst_data())
gvcst_kill(TRUE);
/* KILL ^#t("#TNAME") unconditionally and regenerate */
BUILD_HASHT_SUB_CURRKEY(LITERAL_HASHTNAME, STRLEN(LITERAL_HASHTNAME));
if (0 != gvcst_data())
gvcst_kill(TRUE);
/* KILL ^#t("#TRHASH") unconditionally and regenerate */
BUILD_HASHT_SUB_CURRKEY(LITERAL_HASHTRHASH, STRLEN(LITERAL_HASHTRHASH));
if (0 != gvcst_data())
gvcst_kill(TRUE);
/* Loop through all global names for which ^#t(<gvn>) exists. The only first-level subscripts of ^#t starting
* with # are #TNAME and #TRHASH in collation order. So after #TRHASH we expect to find subscripts that are
* global names. Hence the HASHTRHASH code is placed AFTER the HASHTNAME code above.
*/
TREF(gd_targ_gvnh_reg) = NULL; /* needed so op_gvorder below goes through gvcst_order (i.e. focuses only
* on the current region) and NOT through gvcst_spr_order (which does not
* apply anyways in the case of ^#t).
*/
nullbyte[0] = '\0';
trig_protected_mval_push_count = 0;
INCR_AND_PUSH_MV_STENT(gvname); /* Protect gvname from garbage collection */
do
{
op_gvorder(gvname);
if (0 == gvname->str.len)
break;
assert(ARRAYSIZE(trigvn) > gvname->str.len);
memcpy(&trigvn[0], gvname->str.addr, gvname->str.len);
gvname->str.addr = &trigvn[0]; /* point away from stringpool to avoid stp_gcol issues */
/* Save gv_currkey->prev so it is restored before next call to op_gvorder (which cares about this field).
* gv_currkey->prev gets tampered with in the for loop below (e.g. BUILD_HASHT_SUB_CURRKEY macro).
* No need to do this for gv_currkey->end since the body of the for loop takes care of restoring it.
*/
gvname_prev = gv_currkey->prev;
BUILD_HASHT_SUB_CURRKEY(gvname->str.addr, gvname->str.len);
/* At this point, gv_currkey is ^#t(<gvn>) */
/* Increment ^#t(<gvn>,"#CYCLE") */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_hashcycle, tmpmv);
assert(is_defined);
tmpint4 = mval2i(tmpmv);
tmpint4++;
i2mval(tmpmv, tmpint4);
gvtr_set_hasht_gblsubs((mval *)&literal_hashcycle, tmpmv);
/* Read ^#t(<gvn>,"#COUNT") */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_hashcount, tmpmv);
if (is_defined)
{
tmpint4 = mval2i(tmpmv);
count = tmpint4;
/* Get ^#t(<gvn>,"#LABEL"), error out for invalid values. Upgrade disallowed for label 1 triggers */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_hashlabel, tmpmv);
assert(is_defined);
currlabel = mval2i(tmpmv);
if ((V19_HASHT_GBL_LABEL_INT >= currlabel) || (HASHT_GBL_CURLABEL_INT <= currlabel))
rts_error_csa(CSA_ARG(csa) VARLSTCNT(8) ERR_TRIGUPBADLABEL, 6, currlabel,
HASHT_GBL_CURLABEL_INT, gvname->str.len, gvname->str.addr,
REG_LEN_STR(reg));
/* Set ^#t(<gvn>,"#LABEL")=HASHT_GBL_CURLABEL */
gvtr_set_hasht_gblsubs((mval *)&literal_hashlabel, (mval *)&literal_curlabel);
} else
count = 0;
/* Kill ^#t(<gvn>,"#TRHASH") unconditionally and regenerate */
gvtr_kill_hasht_gblsubs((mval *)&literal_hashtrhash, TRUE);
/* At this point, gv_currkey is ^#t(<gvn>) */
for (i = 1; i <= count; i++)
{
/* At this point, gv_currkey is ^#t(<gvn>) */
curend = gv_currkey->end; /* note gv_currkey->end before changing it so we can restore it later */
assert(KEY_DELIMITER == gv_currkey->base[curend]);
assert(gv_target->gd_csa == cs_addrs);
i2mval(tmpmv, i);
COPY_SUBS_TO_GVCURRKEY(tmpmv, gv_cur_region, gv_currkey, was_null, is_null);
/* At this point, gv_currkey is ^#t(<gvn>,i) */
/* Compute new LHASH and BHASH hash values.
* LHASH uses : GVSUBS, XECUTE
* BHASH uses : GVSUBS, DELIM, ZDELIM, PIECES, XECUTE
* So reach each of these pieces and compute hash along the way.
*/
STR_PHASH_INIT(hash_state, hash_totlen);
STR_PHASH_PROCESS(hash_state, hash_totlen, gvname->str.addr, gvname->str.len);
STR_PHASH_PROCESS(hash_state, hash_totlen, nullbyte, 1);
/* Read in ^#t(<gvn>,i,"GVSUBS") */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_gvsubs, tmpmv);
if (is_defined)
{
STR_PHASH_PROCESS(hash_state, hash_totlen, tmpmval.str.addr, tmpmval.str.len);
STR_PHASH_PROCESS(hash_state, hash_totlen, nullbyte, 1);
}
/* Copy over SET hash state (2-tuple <state,totlen>) to KILL hash state before adding
* the PIECES, DELIM, ZDELIM portions (those are only part of the SET hash).
*/
kill_hash_state = hash_state;
kill_hash_totlen = hash_totlen;
/* Read in ^#t(<gvn>,i,"PIECES") */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_pieces, tmpmv);
if (is_defined)
{
STR_PHASH_PROCESS(hash_state, hash_totlen, tmpmval.str.addr, tmpmval.str.len);
STR_PHASH_PROCESS(hash_state, hash_totlen, nullbyte, 1);
}
/* Read in ^#t(<gvn>,i,"DELIM") */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_delim, tmpmv);
if (is_defined)
{
STR_PHASH_PROCESS(hash_state, hash_totlen, tmpmval.str.addr, tmpmval.str.len);
STR_PHASH_PROCESS(hash_state, hash_totlen, nullbyte, 1);
}
/* Read in ^#t(<gvn>,i,"ZDELIM") */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_zdelim, tmpmv);
if (is_defined)
{
STR_PHASH_PROCESS(hash_state, hash_totlen, tmpmval.str.addr, tmpmval.str.len);
STR_PHASH_PROCESS(hash_state, hash_totlen, nullbyte, 1);
}
/* Read in ^#t(<gvn>,i,"XECUTE").
* Note: The XECUTE portion of the trigger definition is used in SET and KILL hash.
* But since we have started maintaining "hash_state" and "kill_hash_state" separately
* (due to PIECES, DELIM, ZDELIM) we need to update the hash for both using same input string.
*/
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_xecute, tmpmv);
if (is_defined)
{
STR_PHASH_PROCESS(hash_state, hash_totlen, tmpmval.str.addr, tmpmval.str.len);
STR_PHASH_PROCESS(kill_hash_state, kill_hash_totlen, tmpmval.str.addr, tmpmval.str.len);
} else
{ /* Multi-record XECUTE string */
/* At this point, gv_currkey is ^#t(<gvn>,i) */
xecute_curend = gv_currkey->end; /* note gv_currkey->end so we can restore it later */
assert(KEY_DELIMITER == gv_currkey->base[xecute_curend]);
tmpmv2 = (mval *)&literal_xecute;
COPY_SUBS_TO_GVCURRKEY(tmpmv2, gv_cur_region, gv_currkey, was_null, is_null);
xecutei = 1;
do
{
i2mval(&xecuteimval, xecutei);
is_defined = gvtr_get_hasht_gblsubs(&xecuteimval, tmpmv);
if (!is_defined)
break;
STR_PHASH_PROCESS(hash_state, hash_totlen, tmpmval.str.addr, tmpmval.str.len);
STR_PHASH_PROCESS(kill_hash_state, kill_hash_totlen,
tmpmval.str.addr, tmpmval.str.len);
xecutei++;
} while (TRUE);
/* Restore gv_currkey to ^#t(<gvn>,i) */
gv_currkey->end = xecute_curend;
gv_currkey->base[xecute_curend] = KEY_DELIMITER;
}
STR_PHASH_RESULT(hash_state, hash_totlen, hash_code);
STR_PHASH_RESULT(kill_hash_state, kill_hash_totlen, kill_hash_code);
/* Set ^#t(<gvn>,i,"LHASH") */
MV_FORCE_UMVAL(tmpmv, kill_hash_code);
gvtr_set_hasht_gblsubs((mval *)&literal_lhash, tmpmv);
/* Set ^#t(<gvn>,i,"BHASH") */
MV_FORCE_UMVAL(tmpmv, hash_code);
gvtr_set_hasht_gblsubs((mval *)&literal_bhash, tmpmv);
/* Read in ^#t(<gvn>,i,"TRIGNAME") to determine if #SEQNUM/#TNCOUNT needs to be maintained */
is_defined = gvtr_get_hasht_gblsubs((mval *)&literal_trigname, tmpmv);
assert(is_defined);
assert('#' == tmpmval.str.addr[tmpmval.str.len - 1]);
tmpmval.str.len--;
if ((tmpmval.str.len <= ARRAYSIZE(name_and_index)) &&
(NULL != (ptr = memchr(tmpmval.str.addr, '#', tmpmval.str.len))))
{ /* Auto-generated name. Need to maintain #SEQNUM/#TNCOUNT */
/* Take copy of trigger name into non-stringpool location to avoid stp_gcol issues */
trigname_len = ptr - tmpmval.str.addr;
ptr++;
name_index_len = (tmpmval.str.addr + tmpmval.str.len) - ptr;
assert(ARRAYSIZE(name_and_index) >= (trigname_len + 1 + name_index_len));
trigname = &name_and_index[0];
trigindex = ptr;
memcpy(trigname, tmpmval.str.addr, tmpmval.str.len);
A2I(ptr, ptr + name_index_len, trig_seq_num);
/* At this point, gv_currkey is ^#t(<gvn>,i) */
/* $get(^#t("#TNAME",<trigger name>,"#SEQNUM")) */
BUILD_HASHT_SUB_SUB_SUB_CURRKEY(LITERAL_HASHTNAME, STR_LIT_LEN(LITERAL_HASHTNAME),
trigname, trigname_len, LITERAL_HASHSEQNUM, STR_LIT_LEN(LITERAL_HASHSEQNUM));
seq_num = gvcst_get(tmpmv) ? mval2i(tmpmv) : 0;
if (trig_seq_num > seq_num)
{ /* Set ^#t("#TNAME",<trigger name>,"#SEQNUM") = trig_seq_num */
SET_TRIGGER_GLOBAL_SUB_SUB_SUB_STR(LITERAL_HASHTNAME,
STR_LIT_LEN(LITERAL_HASHTNAME), trigname, trigname_len,
LITERAL_HASHSEQNUM, STR_LIT_LEN(LITERAL_HASHSEQNUM),
trigindex, name_index_len, result);
assert(PUT_SUCCESS == result);
}
/* set ^#t("#TNAME",<trigger name>,"#TNCOUNT")++ */
BUILD_HASHT_SUB_SUB_SUB_CURRKEY(LITERAL_HASHTNAME, STR_LIT_LEN(LITERAL_HASHTNAME),
trigname, trigname_len, LITERAL_HASHTNCOUNT, STR_LIT_LEN(LITERAL_HASHTNCOUNT));
tncount = gvcst_get(tmpmv) ? mval2i(tmpmv) + 1 : 1;
i2mval(tmpmv, tncount);
SET_TRIGGER_GLOBAL_SUB_SUB_SUB_MVAL(LITERAL_HASHTNAME, STR_LIT_LEN(LITERAL_HASHTNAME),
trigname, trigname_len, LITERAL_HASHTNCOUNT, STR_LIT_LEN(LITERAL_HASHTNCOUNT),
tmpmval, result);
trigname_len += 1 + name_index_len; /* in preparation for ^#t("#TNAME") set below */
assert(PUT_SUCCESS == result);
BUILD_HASHT_SUB_CURRKEY(gvname->str.addr, gvname->str.len);
/* At this point, gv_currkey is ^#t(<gvn>) */
} else
{
/* Take copy of trigger name into non-stringpool location to avoid stp_gcol issues */
trigname = &name_and_index[0]; /* in preparation for ^#t("#TNAME") set below */
trigname_len = MIN(tmpmval.str.len, ARRAYSIZE(name_and_index));
assert(ARRAYSIZE(name_and_index) >= trigname_len);
memcpy(trigname, tmpmval.str.addr, trigname_len);
/* Restore gv_currkey to what it was at beginning of for loop iteration */
gv_currkey->end = curend;
gv_currkey->base[curend] = KEY_DELIMITER;
}
/* At this point, gv_currkey is ^#t(<gvn>) */
if (kill_hash_code != hash_code)
gvtr_set_hashtrhash(gvname->str.addr, gvname->str.len, kill_hash_code, i);
/* Set ^#t(<gvn>,"#TRHASH",hash_code,i) */
gvtr_set_hashtrhash(gvname->str.addr, gvname->str.len, hash_code, i);
/* Set ^#t("#TNAME",<trigname>)=<gvn>_$c(0)_<trigindx> */
/* The upgrade assumes that the region does not contain two triggers with the same name.
* V62000 and before could potentially have this out of design case. Once implemented
* the trigger integrity check will warn users of this edge case */
ptr = &trigvn[gvname->str.len];
*ptr++ = '\0';
ilen = 0;
I2A(ptr, ilen, i);
ptr += ilen;
assert(ptr <= ARRAYTOP(trigvn));
SET_TRIGGER_GLOBAL_SUB_SUB_STR(LITERAL_HASHTNAME, STR_LIT_LEN(LITERAL_HASHTNAME),
trigname, trigname_len, trigvn, ptr - gvname->str.addr, result);
assert(PUT_SUCCESS == result);
BUILD_HASHT_SUB_CURRKEY(gvname->str.addr, gvname->str.len);
/* At this point, gv_currkey is ^#t(<gvn>) */
}
/* At this point, gv_currkey is ^#t(<gvn>) i.e. gv_currkey->end is correct but gv_currkey->prev
* might have been tampered with. Restore it to proper value first.
*/
gv_currkey->prev = gvname_prev;
gvname->mvtype = 0; /* can now be garbage collected in the next iteration */
} while (TRUE);
}
op_tcommit();
REVERT; /* remove our condition handler */
DEBUG_ONLY(donot_INVOKE_MUMTSTART = FALSE;)
if (csa->hold_onto_crit)
/*
* ------------------------------------------
* Hang the process for a specified time.
*
* Goes to sleep for a positive value.
* Any caught signal will terminate the sleep
* following the execution of that signal's catching routine.
*
* Arguments:
* num - time to sleep
*
* Return:
* none
* ------------------------------------------
*/
void op_hang(mval* num)
{
int ms;
mv_stent *mv_zintcmd;
ABS_TIME cur_time, end_time;
# ifdef VMS
uint4 time[2];
int4 efn_mask, status;
# endif
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
ms = 0;
MV_FORCE_NUM(num);
if (num->mvtype & MV_INT)
{
if (0 < num->m[1])
{
assert(MV_BIAS >= 1000); /* if formats change overflow may need attention */
ms = num->m[1] * (1000 / MV_BIAS);
}
} else if (0 == num->sgn) /* if sign is not 0 it means num is negative */
ms = mval2i(num) * 1000; /* too big to care about fractional amounts */
if (ms)
{
if (TREF(tpnotacidtime) * 1000 < ms)
TPNOTACID_CHECK(HANGSTR);
# if defined(DEBUG) && defined(UNIX)
if (gtm_white_box_test_case_enabled
&& (WBTEST_DEFERRED_TIMERS == gtm_white_box_test_case_number)
&& (3 > gtm_white_box_test_case_count)
&& (123000 == ms))
{
DEFER_INTERRUPTS(INTRPT_NO_TIMER_EVENTS);
DBGFPF((stderr, "OP_HANG: will sleep for 20 seconds\n"));
LONG_SLEEP(20);
DBGFPF((stderr, "OP_HANG: done sleeping\n"));
ENABLE_INTERRUPTS(INTRPT_NO_TIMER_EVENTS);
return;
}
if (gtm_white_box_test_case_enabled
&& (WBTEST_BREAKMPC == gtm_white_box_test_case_number)
&& (0 == gtm_white_box_test_case_count)
&& (999 == ms))
{
frame_pointer->old_frame_pointer->mpc = (unsigned char *)GTM64_ONLY(0xdeadbeef12345678)
NON_GTM64_ONLY(0xdead1234);
return;
}
/* Upon seeing a .999s hang this white-box test launches a timer that pops with a period of UTIL_OUT_SYSLOG_INTERVAL
* and prints a long message via util_out_ptr.
*/
if (gtm_white_box_test_case_enabled
&& (WBTEST_UTIL_OUT_BUFFER_PROTECTION == gtm_white_box_test_case_number)
&& (0 == gtm_white_box_test_case_count)
&& (999 == ms))
{
start_timer((TID)&util_out_syslog_dump, UTIL_OUT_SYSLOG_INTERVAL, util_out_syslog_dump, 0, NULL);
return;
}
# endif
sys_get_curr_time(&cur_time);
mv_zintcmd = find_mvstent_cmd(ZINTCMD_HANG, restart_pc, restart_ctxt, FALSE);
if (!mv_zintcmd)
add_int_to_abs_time(&cur_time, ms, &end_time);
else
{
end_time = mv_zintcmd->mv_st_cont.mvs_zintcmd.end_or_remain;
cur_time = sub_abs_time(&end_time, &cur_time); /* get remaing time to sleep */
if (0 <= cur_time.at_sec)
ms = (int4)(cur_time.at_sec * 1000 + cur_time.at_usec / 1000);
else
ms = 0; /* all done */
/* restore/pop previous zintcmd_active[ZINTCMD_HANG] hints */
TAREF1(zintcmd_active, ZINTCMD_HANG).restart_pc_last = mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_prior;
TAREF1(zintcmd_active, ZINTCMD_HANG).restart_ctxt_last
= mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_ctxt_prior;
TAREF1(zintcmd_active, ZINTCMD_HANG).count--;
assert(0 <= TAREF1(zintcmd_active, ZINTCMD_HANG).count);
if (mv_chain == mv_zintcmd)
POP_MV_STENT(); /* just pop if top of stack */
else
{ /* flag as not active */
mv_zintcmd->mv_st_cont.mvs_zintcmd.command = ZINTCMD_NOOP;
mv_zintcmd->mv_st_cont.mvs_zintcmd.restart_pc_check = NULL;
}
if (0 == ms)
return; /* done HANGing */
}
UNIX_ONLY(hiber_start(ms);)
VMS_ONLY(
time[0] = -time_low_ms(ms);
time[1] = -time_high_ms(ms) - 1;
efn_mask = (1 << efn_outofband | 1 << efn_timer);
if (SS$_NORMAL != (status = sys$setimr(efn_timer, &time, NULL, &time, 0)))
rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$setimr"), CALLFROM, status);
if (SS$_NORMAL != (status = sys$wflor(efn_outofband, efn_mask)))
rts_error(VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("$wflor"), CALLFROM, status);
)
if (outofband)
