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;
}
/**************************************************************************************************
* Routine to perform string-level case conversion to "upper", "lower" and "title" case.
* Since ICU only supports API using UTF-16 representation, case conversion of UTF-8 strings involves
* encoding conversion as described below:
* 1. First, the UTF-8 source string is converted to UTF-16 representation (u_strFromUTF8())
* which is stored in a local buffer of size MAX_ZCONVBUFF. If this space is not sufficient,
* we try to allocate it in heap.
* 2. Since case conversion may expand the string, we compute the desired space required by
* preflighting the ICU case conversion API and then allocate the space before performing
* the real conversion.
* 3. Translating the converted UTF-16 string back to UTF-8 is done in stringpool (with similar
* preflighting to compute the required space.
* NOTE:
* Malloc is used only if the size exceeds 2K characters (a very unlikely situation esp. with
* case conversion).
*
***************************************************************************************************/
void op_fnzconvert2(mval *src, mval *kase, mval *dst)
{
int index;
int32_t src_ustr_len, src_chlen, dst_chlen, ulen, dstlen = 0;
UErrorCode status;
char *dstbase;
UChar src_ustr[MAX_ZCONVBUFF], dst_ustr[MAX_ZCONVBUFF], *src_ustr_ptr, *dst_ustr_ptr;
intrpt_state_t prev_intrpt_state;
DEFER_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
MV_FORCE_STR(kase);
if (-1 == (index = verify_case(&kase->str)))
{
ENABLE_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(4) ERR_BADCASECODE, 2, kase->str.len, kase->str.addr);
}
MV_FORCE_STR(src);
/* allocate stringpool */
if (!gtm_utf8_mode)
{
dstlen = src->str.len;
ENSURE_STP_FREE_SPACE(dstlen);
dstbase = (char *)stringpool.free;
assert(NULL != casemaps[index].m);
(*casemaps[index].m)((unsigned char *)dstbase, (unsigned char *)src->str.addr, dstlen);
} else if (0 != src->str.len)
{
MV_FORCE_LEN_STRICT(src);
if (2 * src->str.char_len <= MAX_ZCONVBUFF)
{ /* Check if the stack buffer is sufficient considering the worst case where all
characters are surrogate pairs, each of which needs 2 UChars */
src_ustr_ptr = src_ustr;
src_ustr_len = MAX_ZCONVBUFF;
} else
{
/* To avoid preflight, allocate (2 * lenght of src->str.char_len). */
src_ustr_len = 2 * src->str.char_len;
src_ustr_ptr = (UChar*)malloc(src_ustr_len * SIZEOF(UChar));
}
/* Convert UTF-8 src to UTF-16 (UChar*) representation */
status = U_ZERO_ERROR;
u_strFromUTF8(src_ustr_ptr, src_ustr_len, &src_chlen, src->str.addr, src->str.len, &status);
if (U_FAILURE(status))
{
RELEASE_IF_NOT_LOCAL(src_ustr_ptr, src_ustr);
if (U_ILLEGAL_CHAR_FOUND == status || U_INVALID_CHAR_FOUND == status)
utf8_len_strict((unsigned char *)src->str.addr, src->str.len); /* to report BADCHAR error */
ENABLE_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(3) ERR_ICUERROR,
1, status); /* ICU said bad, we say good or don't recognize error*/
}
status = U_ZERO_ERROR;
dst_ustr_ptr = dst_ustr;
dst_chlen = (*casemaps[index].u)(dst_ustr_ptr, MAX_ZCONVBUFF, src_ustr_ptr, src_chlen, NULL, &status);
if ( U_BUFFER_OVERFLOW_ERROR == status )
{
status = U_ZERO_ERROR;
dst_ustr_ptr = (UChar*)malloc(dst_chlen * SIZEOF(UChar));
/* Now, perform the real conversion with sufficient buffers */
dst_chlen = (*casemaps[index].u)(dst_ustr_ptr, dst_chlen, src_ustr_ptr, src_chlen, NULL, &status);
} else if ( U_FILE_ACCESS_ERROR == status )
{
RELEASE_IF_NOT_LOCAL(src_ustr_ptr, src_ustr);
ENABLE_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(3) ERR_ICUERROR,
1, status);
}
RELEASE_IF_NOT_LOCAL(src_ustr_ptr, src_ustr);
/* Fake the conversion from UTF-16 to UTF-8 to compute the required buffer size */
status = U_ZERO_ERROR;
dstlen = 0;
u_strToUTF8(NULL, 0, &dstlen, dst_ustr_ptr, dst_chlen, &status);
assert(U_BUFFER_OVERFLOW_ERROR == status || U_SUCCESS(status));
if (MAX_STRLEN < dstlen)
{
RELEASE_IF_NOT_LOCAL(dst_ustr_ptr, dst_ustr);
ENABLE_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MAXSTRLEN);
}
ENSURE_STP_FREE_SPACE(dstlen);
dstbase = (char *)stringpool.free;
status = U_ZERO_ERROR;
u_strToUTF8(dstbase, dstlen, &ulen, dst_ustr_ptr, dst_chlen, &status);
if (U_FAILURE(status))
{
RELEASE_IF_NOT_LOCAL(src_ustr_ptr, src_ustr);
RELEASE_IF_NOT_LOCAL(dst_ustr_ptr, dst_ustr);
ENABLE_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(3) ERR_ICUERROR,
1, status); /* ICU said bad, but same call above just returned OK */
}
assertpro(ulen == dstlen);
RELEASE_IF_NOT_LOCAL(dst_ustr_ptr, dst_ustr);
}
MV_INIT_STRING(dst, dstlen, dstbase);
stringpool.free += dstlen;
ENABLE_INTERRUPTS(INTRPT_IN_FUNC_WITH_MALLOC, prev_intrpt_state);
}
