int op_readfl(mval *v, int4 length, int4 timeout)
{
int4 stat; /* status */
size_t cnt, insize, outsize;
char *start_ptr, *save_ptr;
unsigned char *temp_ch;
int b_length;
if (timeout < 0)
timeout = 0;
/* Length is in units of characters, MAX_STRLEN and allocation unit in stp is bytes. Compute the worst case need in bytes.
* Worst case, every Unicode char is 4 bytes
*/
b_length = (!IS_UTF_CHSET(io_curr_device.in->ichset)) ? length : (length * 4);
if (0 >= length)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_RDFLTOOSHORT);
/* This check is more useful in "M" mode. For UTF-8 mode, checks have to be done while reading */
if (MAX_STRLEN < length)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_RDFLTOOLONG);
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
v->mvtype = MV_STR;
v->str.len = 0; /* Nothing kept from any old value */
ENSURE_STP_FREE_SPACE(b_length + ESC_LEN);
v->str.addr = (char *)stringpool.free;
active_device = io_curr_device.in;
stat = (io_curr_device.in->disp_ptr->readfl)(v, length, timeout);
if (IS_AT_END_OF_STRINGPOOL(v->str.addr, 0))
stringpool.free += v->str.len; /* see UNIX iott_readfl */
assert((int4)v->str.len <= b_length);
assert(stringpool.free <= stringpool.top);
# if defined(KEEP_zOS_EBCDIC) || defined(VMS)
if (DEFAULT_CODE_SET != active_device->in_code_set)
{
cnt = insize = outsize = v->str.len;
assert(stringpool.free >= stringpool.base);
ENSURE_STP_FREE_SPACE(cnt);
temp_ch = stringpool.free;
save_ptr = v->str.addr;
start_ptr = (char *)temp_ch;
stringpool.free += cnt;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
ICONVERT(active_device->input_conv_cd, (unsigned char **)&(v->str.addr), &insize, &temp_ch, &outsize);
v->str.addr = start_ptr;
}
# endif
active_device = 0;
if (NO_M_TIMEOUT != timeout)
return (stat);
return FALSE;
}
void gvcmx_unlock(unsigned char rmv_locks, bool specific, char incr)
{
struct CLB *p;
unsigned char operation1,operation2,*ptr;
if (!ntd_root || !ntd_root->cqh.fl || (specific && !remlkreq))
return;
if (rmv_locks == CM_ZALLOCATES)
{
operation1 = CM_ZALLOCATES;
operation2 = REMOTE_ZALLOCATES;
} else
{
operation1 = CM_LOCKS;
operation2 = REMOTE_LOCKS;
}
operation1 |= incr;
for (p = (struct CLB *)RELQUE2PTR(ntd_root->cqh.fl); p != (struct CLB *)ntd_root; p = (struct CLB *)RELQUE2PTR(p->cqe.fl))
{
p->ast = 0;
ENSURE_STP_FREE_SPACE(p->mbl);
p->mbf = stringpool.free;
if (remlkreq)
{
if (((link_info*)(p->usr))->lck_info & REQUEST_PENDING)
gvcmz_sndlkremove(p, operation1, CMMS_L_LKDELETE);
} else if (((link_info*)(p->usr))->lck_info & (REMOTE_LOCKS | REMOTE_ZALLOCATES))
{
gvcmz_sndlkremove(p, operation1, CMMS_L_LKCANALL);
((link_info*)(p->usr))->lck_info &= ~operation2;
}
}
}
/* This function does the bulk of the conversion for i82mval and ui82mval. The primary routines set the sgn flag and pass the
* absolute value to xi82mval(). In the case of a >18 digit number, xi82mval() examines the sgn flag to determine whether to
* switch back to a signed value before string conversion.
*/
void xi82mval(mval *v, gtm_uint64_t i)
{
int exp;
uint4 low;
uint4 high;
char buf[21]; /* [possible] sign, [up to] 19L/20UL digits, and terminator. */
int len;
if (i < INT_HI)
{
v->mvtype |= MV_INT;
v->m[1] = MV_BIAS * (v->sgn ? -(int4)i : (uint4)i);
} else
{
if (i < MANT_HI)
{
low = 0;
high = i;
exp = EXP_IDX_BIAL;
while (high < MANT_LO)
{
high *= 10;
exp--;
}
v->e = exp;
v->m[0] = low;
v->m[1] = high;
} else if (i < (gtm_uint64_t)MANT_HI * MANT_HI)
{
low = i % MANT_HI;
high = i / MANT_HI;
exp = EXP_IDX_BIAL + 9;
while (high < MANT_LO)
{
high = (high * 10) + (low / MANT_LO);
low = (low % MANT_LO) * 10;
exp--;
}
v->e = exp;
v->m[0] = low;
v->m[1] = high;
} else
{ /* The value won't fit in 18 digits, so return a string. */
if (v->sgn)
len = SPRINTF(buf, "%lld", -(gtm_int64_t)i);
else
len = SPRINTF(buf, "%llu", i);
assert(18 < len);
ENSURE_STP_FREE_SPACE(len);
memcpy(stringpool.free, buf, len);
v->mvtype = MV_STR;
v->str.len = len;
v->str.addr = (char *)stringpool.free;
stringpool.free += len;
}
assert((v->mvtype != MV_NM) || (v->m[1] < MANT_HI));
assert((v->mvtype != MV_NM) || (v->m[1] >= MANT_LO));
}
}
int gtm_conv(UConverter* from, UConverter* to, mstr *src, char* dstbuff, int* bufflen)
{
char *dstptr, *dstbase, *srcptr;
const char *ichset;
int dstlen, src_charlen, srclen;
UErrorCode status, status1;
if (0 == src->len)
return 0;
if (NULL == dstbuff)
{
/* Compute the stringpool buffer space needed for conversion given that source
* is encoded in the ichset representation. The ICU functions ucnv_getMinCharSize()
* and ucnv_getMaxCharSize() are used to compute the minimum and maximum number of
* bytes required per UChar if converted from/to ichset/ochset respectively
*/
src_charlen = (src->len / ucnv_getMinCharSize(from)) + 1; /* number of UChar's from ichset */
dstlen = UCNV_GET_MAX_BYTES_FOR_STRING(src_charlen, ucnv_getMaxCharSize(to));
dstlen = (dstlen > MAX_STRLEN) ? MAX_STRLEN : dstlen;
ENSURE_STP_FREE_SPACE(dstlen);
dstbase = (char *)stringpool.free;
} else
{
dstbase = dstbuff;
dstlen = *bufflen;
}
srcptr = src->addr;
srclen = (int)src->len;
dstptr = dstbase;
status = U_ZERO_ERROR; /* initialization to "success" is required by ICU */
ucnv_convertEx(to, from, &dstptr, dstptr + dstlen, (const char**)&srcptr, srcptr + srclen,
NULL, NULL, NULL, NULL, TRUE, TRUE, &status);
if (U_FAILURE(status))
{
if (U_BUFFER_OVERFLOW_ERROR == status)
{ /* translation requires more space than the maximum allowed GT.M string size */
if (NULL == dstbuff)
rts_error_csa(NULL, VARLSTCNT(1) ERR_MAXSTRLEN);
else
{
/* Insufficient buffer passed. Return the required buffer length */
src_charlen = (srclen / ucnv_getMinCharSize(from)) + 1;
*bufflen = UCNV_GET_MAX_BYTES_FOR_STRING(src_charlen, ucnv_getMaxCharSize(to));
return -1;
}
}
status1 = U_ZERO_ERROR;
ichset = ucnv_getName(from, &status1);
assert(U_SUCCESS(status1));
UTF8_BADCHAR(1,(unsigned char *) (srcptr - 1), NULL,STRLEN(ichset), ichset);
}
return (int) (dstptr - dstbase);
}
void fgn_glopref(mval *v)
{
unsigned char *p;
ENSURE_STP_FREE_SPACE(v->str.len + 1);
p = stringpool.free;
*stringpool.free++ = '^';
memcpy(stringpool.free,v->str.addr,v->str.len);
stringpool.free += v->str.len ;
v->str.addr = (char *)p;
v->str.len++;
}
oprtype put_str(char *pt, mstr_len_t n)
{
mval p;
ENSURE_STP_FREE_SPACE(n);
memcpy(stringpool.free, pt, n);
memset(&p, 0, SIZEOF(mval));
p.mvtype = MV_STR;
p.str.len = n;
p.str.addr = (char *) stringpool.free;
stringpool.free += n;
/* The line below should be removed as part of GTM-8540; but I can't find a negative test case */
s2n(&p);
return put_lit(&p);
}
void op_fnzbitxor(mval *dst, mval *bitstr1, mval *bitstr2)
{
int n, str_len1, str_len2, new_str_len;
unsigned char *byte_1, *byte_n;
unsigned char *byte1_1, *byte1_n, byte1_len;
unsigned char *byte2_1, *byte2_n, byte2_len;
error_def(ERR_INVBITSTR);
MV_FORCE_STR(bitstr1);
MV_FORCE_STR(bitstr2);
if (!bitstr1->str.len || !bitstr2->str.len)
rts_error(VARLSTCNT(1) ERR_INVBITSTR);
byte1_len = *(unsigned char *)bitstr1->str.addr;
str_len1 = (bitstr1->str.len - 1) * 8;
if (7 < byte1_len)
rts_error(VARLSTCNT(1) ERR_INVBITSTR);
byte2_len = *(unsigned char *)bitstr2->str.addr;
str_len2 = (bitstr2->str.len -1) * 8;
if (7 < byte2_len)
rts_error(VARLSTCNT(1) ERR_INVBITSTR);
if (str_len1 - byte1_len > str_len2 - byte2_len)
new_str_len = str_len2 - byte2_len;
else
new_str_len = str_len1 - byte1_len;
n = (new_str_len + 7)/8 ;
ENSURE_STP_FREE_SPACE(n + 1);
byte_1 = (unsigned char *)stringpool.free;
*byte_1 = n * 8 - new_str_len;
byte1_1 = (unsigned char *)bitstr1->str.addr;
byte2_1 = (unsigned char *)bitstr2->str.addr;
for(byte_n = byte_1 + 1, byte1_n = byte1_1 + 1, byte2_n = byte2_1 + 1 ;
byte_n <= (byte_1 + n); byte_n++, byte1_n++, byte2_n++)
{
*byte_n = *byte1_n ^ *byte2_n;
}
*--byte_n &= mask[*byte_1];
dst->mvtype = MV_STR;
dst->str.addr = (char *)stringpool.free;
dst->str.len = n + 1;
stringpool.free += n + 1;
}
void
s2pool(mstr *a)
{
GBLREF spdesc stringpool;
int al;
if ((al = a->len) == 0)
return;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
ENSURE_STP_FREE_SPACE(al);
memcpy(stringpool.free,a->addr,al);
a->addr = (char *)stringpool.free;
stringpool.free += al;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
}
/* WARNING!!! - the it is left to the caller of this routine to protect the stringpool if appropriate */
void mval_lex(mval *v, mstr *output)
{
int space_needed, des_len;
MV_FORCE_STR(v);
if (MV_IS_CANONICAL(v))
*output = v->str;
else
{
space_needed = ZWR_EXP_RATIO(v->str.len);
ENSURE_STP_FREE_SPACE(space_needed);
output->addr = (char *)stringpool.free;
format2zwr((sm_uc_ptr_t)v->str.addr, v->str.len, (unsigned char *)output->addr, &des_len);
output->len = des_len; /* need a temporary des_len since output->len is short on the VAX
* and format2zwr expects an (int *) as the last parameter */
assert(space_needed >= output->len);
}
}
oprtype make_gvsubsc(mval *v)
{
mval w;
gv_key *gp;
ENSURE_STP_FREE_SPACE(MAX_SRCLINE + SIZEOF(gv_key));
if ((INTPTR_T)stringpool.free & 1)
stringpool.free++; /* word align key for structure refs */
gp = (gv_key *) stringpool.free;
gp->top = MAX_SRCLINE;
gp->end = gp->prev = 0;
mval2subsc(v,gp);
w.mvtype = MV_STR | MV_SUBLIT;
w.str.addr = (char *) gp->base;
w.str.len = gp->end + 1;
stringpool.free = &gp->base[gp->end + 1];
assert(stringpool.free <= stringpool.top);
return put_lit(&w);
}
void op_write(mval *v)
{
GBLREF spdesc stringpool;
size_t insize, outsize;
int cnt;
unsigned char *temp_ch;
char *start_ptr, *save_ptr;
MV_FORCE_STR(v);
active_device = io_curr_device.out;
#if defined(KEEP_zOS_EBCDIC) || defined(VMS)
if (DEFAULT_CODE_SET != active_device->out_code_set)
{
cnt = insize = outsize = v->str.len;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
ENSURE_STP_FREE_SPACE(cnt);
temp_ch = stringpool.free;
save_ptr = v->str.addr;
start_ptr = (char *)temp_ch;
stringpool.free += cnt;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
ICONVERT(active_device->output_conv_cd, (unsigned char **)&v->str.addr, &insize, &temp_ch, &outsize);
v->str.addr = start_ptr;
}
#endif
(io_curr_device.out->disp_ptr->write)(&v->str);
#if defined(KEEP_zOS_EBCDIC) || defined(VMS)
if (DEFAULT_CODE_SET != active_device->out_code_set)
v->str.addr = save_ptr;
#endif
active_device = 0;
return;
}
void get_reference(mval *var)
{
char *end, *start;
char extnamdelim[] = "^|\"\"|";
char *extnamsrc, *extnamtop;
int maxlen;
/* you need to return a double-quote for every single-quote. assume worst case. */
maxlen = MAX_ZWR_KEY_SZ + (!extnam_str.len ? 0 : ((extnam_str.len * 2) + SIZEOF(extnamdelim)));
ENSURE_STP_FREE_SPACE(maxlen);
var->mvtype = MV_STR;
start = var->str.addr = (char *)stringpool.free;
var->str.len = 0;
if (gv_currkey && gv_currkey->end)
{
if (extnam_str.len)
{
*start++ = extnamdelim[0];
*start++ = extnamdelim[1];
*start++ = extnamdelim[2];
extnamsrc = &extnam_str.addr[0];
extnamtop = extnamsrc + extnam_str.len;
for ( ; extnamsrc < extnamtop; )
{
*start++ = *extnamsrc;
if ('"' == *extnamsrc++) /* caution : pointer increment side-effect */
*start++ = '"';
}
*start++ = extnamdelim[3];
}
end = (char *)format_targ_key((unsigned char *)start, MAX_ZWR_KEY_SZ, gv_currkey, TRUE);
if (extnam_str.len)
/* Note: the next vertical bar overwrites the caret that
* was part of he original name of the global variable
*/
*start = extnamdelim[4];
var->str.len = INTCAST(end - var->str.addr);
stringpool.free += var->str.len;
}
}
int op_read(mval *v, int4 timeout)
{
int stat;
mval val;
size_t cnt, insize, outsize;
unsigned char *temp_ch;
char *start_ptr, *save_ptr;
error_def(ERR_TEXT);
if (timeout < 0)
timeout = 0;
active_device = io_curr_device.in;
v->mvtype = MV_STR;
v->str.len = 0;
stat = (io_curr_device.in->disp_ptr->read)(v, timeout);
if (stringpool.free == (unsigned char *)v->str.addr)
stringpool.free += v->str.len; /* see UNIX iott_readfl */
assert(stringpool.free <= stringpool.top);
#ifdef KEEP_zOS_EBCDIC
if (DEFAULT_CODE_SET != io_curr_device.in->in_code_set)
{
cnt = insize = outsize = v->str.len;
assert(stringpool.free >= stringpool.base);
ENSURE_STP_FREE_SPACE(cnt);
temp_ch = stringpool.free;
save_ptr = v->str.addr;
start_ptr = (char *)temp_ch;
stringpool.free += cnt;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
ICONVERT(io_curr_device.in->input_conv_cd, (unsigned char **)&v->str.addr, &insize, &temp_ch, &outsize);
v->str.addr = start_ptr;
}
#endif
active_device = 0;
if (NO_M_TIMEOUT != timeout)
return(stat);
return FALSE;
}
/* This function is the equivalent of invoking gvcst_data & gvcst_get at the same time.
* One crucial difference is that this function does NOT handle restarts by automatically invoking t_retry.
* Instead, it returns the restart code to the caller so that it can handle the restart accordingly.
* This is important in the case of triggers because we do NOT want to call t_retry in case of a implicit tstart
* wrapped gvcst_put or gvcst_kill trigger-invoking update transaction. Additionally, this function assumes
* that it is called always inside of TP (i.e. dollar_tlevel is non-zero).
*/
enum cdb_sc gvcst_dataget(mint *dollar_data, mval *val)
{
blk_hdr_ptr_t bp;
boolean_t do_rtsib;
enum cdb_sc status;
mint dlr_data;
rec_hdr_ptr_t rp;
unsigned short match, rsiz;
srch_blk_status *bh;
srch_hist *rt_history;
sm_uc_ptr_t b_top;
int key_size, data_len;
uint4 save_t_err;
error_def(ERR_GVDATAGETFAIL);
error_def(ERR_GVKILLFAIL);
/* The following code is lifted from gvcst_data. Any changes here might need to be reflected there as well */
assert(dollar_tlevel);
assert((CDB_STAGNATE > t_tries) || cs_addrs->now_crit); /* we better hold crit in the final retry (TP & non-TP) */
save_t_err = t_err;
assert(ERR_GVKILLFAIL == save_t_err); /* this function should currently be called only from gvcst_kill */
t_err = ERR_GVDATAGETFAIL; /* switch t_err to reflect dataget sub-operation (under the KILL operation) */
/* In case of a failure return, it is ok to return with t_err set to ERR_GVDATAGETFAIL as that gives a better
* picture of exactly where in the transaction the failure occurred.
*/
rt_history = gv_target->alt_hist;
rt_history->h[0].blk_num = 0;
if (cdb_sc_normal != (status = gvcst_search(gv_currkey, NULL)))
return status;
bh = gv_target->hist.h;
bp = (blk_hdr_ptr_t)bh->buffaddr;
rp = (rec_hdr_ptr_t)(bh->buffaddr + bh->curr_rec.offset);
b_top = bh->buffaddr + bp->bsiz;
match = bh->curr_rec.match;
key_size = gv_currkey->end + 1;
do_rtsib = FALSE;
/* Even if key does not exist, return null string in "val". Caller can use dollar_data to distinguish
* whether the key is undefined or defined and set to the null string.
*/
val->mvtype = MV_STR;
val->str.len = 0;
if (key_size == match)
{
dlr_data = 1;
/* the following code is lifted from gvcst_get. any changes here might need to be reflected there as well */
GET_USHORT(rsiz, &rp->rsiz);
data_len = rsiz + rp->cmpc - SIZEOF(rec_hdr) - key_size;
if ((0 > data_len) || ((sm_uc_ptr_t)rp + rsiz > b_top))
{
assert(CDB_STAGNATE > t_tries);
status = cdb_sc_rmisalign1;
return status;
} else
{
ENSURE_STP_FREE_SPACE(data_len);
memcpy(stringpool.free, (sm_uc_ptr_t)rp + rsiz - data_len, data_len);
val->str.addr = (char *)stringpool.free;
val->str.len = data_len;
stringpool.free += data_len;
}
/* --------------------- end code lifted from gvcst_get ---------------------------- */
rp = (rec_hdr_ptr_t)((sm_uc_ptr_t)rp + rsiz);
if ((sm_uc_ptr_t)rp > b_top)
{
status = cdb_sc_rmisalign;
return status;
} else if ((sm_uc_ptr_t)rp == b_top)
do_rtsib = TRUE;
else if (rp->cmpc >= gv_currkey->end)
dlr_data += 10;
} else if (match >= gv_currkey->end)
dlr_data = 10;
else
{
dlr_data = 0;
if (rp == (rec_hdr_ptr_t)b_top)
do_rtsib = TRUE;
}
if (do_rtsib && (cdb_sc_endtree != (status = gvcst_rtsib(rt_history, 0))))
{
if ((cdb_sc_normal != status) || (cdb_sc_normal != (status = gvcst_search_blk(gv_currkey, rt_history->h))))
return status;
if (rt_history->h[0].curr_rec.match >= gv_currkey->end)
{
assert(1 >= dlr_data);
dlr_data += 10;
}
}
status = tp_hist(0 == rt_history->h[0].blk_num ? NULL : rt_history);
if (cdb_sc_normal != status)
return status;
*dollar_data = dlr_data;
t_err = save_t_err; /* restore t_err to what it was at function entry */
return status;
}
unsigned char *n2s(mval *mv_ptr)
{
unsigned char *start, *cp, *cp1;
int4 exp, n0, m1, m0, tmp;
unsigned char lcl_buf[MAX_DIGITS_IN_INT];
if (!MV_DEFINED(mv_ptr))
GTMASSERT;
ENSURE_STP_FREE_SPACE(MAX_NUM_SIZE);
start = stringpool.free;
cp = start;
m1 = mv_ptr->m[1];
if (m1 == 0) /* SHOULD THIS BE UNDER THE MV_INT TEST? */
*cp++ = '0';
else if (mv_ptr->mvtype & MV_INT)
{
if (m1 < 0)
{
*cp++ = '-';
m1 = -m1;
}
cp1 = ARRAYTOP(lcl_buf);
/* m0 is the integer part */
m0 = m1 / MV_BIAS;
/* m1 will become the fractional part */
m1 = m1 - (m0 * MV_BIAS);
if (m1 > 0)
{
for (n0 = 0; n0 < MV_BIAS_PWR; n0++)
{
tmp = m1;
m1 /= 10;
tmp -= (m1 * 10);
if (tmp)
break;
}
*--cp1 = tmp + '0';
for (n0++; n0 < MV_BIAS_PWR; n0++)
{
tmp = m1;
m1 /= 10;
*--cp1 = tmp - (m1 * 10) + '0';
}
*--cp1 = '.';
}
while (m0 > 0)
{
tmp = m0;
m0 /= 10;
*--cp1 = tmp - (m0 * 10) + '0';
}
n0 = (int4)(ARRAYTOP(lcl_buf) - cp1);
memcpy(cp, cp1, n0);
cp += n0;
} else
{
exp = (int4)mv_ptr->e - MV_XBIAS;
if (mv_ptr->sgn)
*cp++ = '-';
m0 = mv_ptr->m[0];
if (exp < 0)
{
*cp++ = '.';
for (n0 = exp; n0 < 0; n0++)
*cp++ = '0';
}
for (; m1; m1 = m0, m0 = 0)
{
for (n0 = 0; n0 < PACKED_DIGITS; n0++)
{
if (exp-- == 0)
{
if (m0 == 0 && m1 == 0)
break;
*cp++ = '.';
} else if (exp < 0 && m0 == 0 && m1 == 0)
break;
tmp = m1 / MANT_LO;
m1 = (m1 - tmp * MANT_LO) * 10;
*cp++ = tmp + '0';
}
}
while (exp-- > 0)
*cp++ = '0';
}
mv_ptr->mvtype |= MV_STR;
mv_ptr->mvtype &= ~MV_NUM_APPROX;
mv_ptr->str.addr = (char *)start;
NON_UNICODE_ONLY(mv_ptr->str.len = cp - start);
#ifdef UNICODE_SUPPORTED
/* Numerics are not unicode so cheaply set "unicode" length same as ascii length */
mv_ptr->str.len = mv_ptr->str.char_len = INTCAST(cp - start);
mv_ptr->mvtype |= MV_UTF_LEN;
#endif
stringpool.free = cp;
assert(mv_ptr->str.len);
return cp;
}
int f_char(oprtype *a, opctype op)
{
boolean_t all_lits;
unsigned char *base, *outptr, *tmpptr;
int argc, ch, char_len, size;
mval v;
oprtype *argp, argv[CHARMAXARGS];
triple *curr, *last, *root;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
/* If we are not in UTF8 mode, we need to reroute to the $ZCHAR function to handle things correctly */
if (!gtm_utf8_mode)
return f_zchar(a, op);
all_lits = TRUE;
argp = &argv[0];
argc = 0;
for (;;)
{
if (EXPR_FAIL == expr(argp, MUMPS_INT))
return FALSE;
assert(TRIP_REF == argp->oprclass);
if (OC_ILIT != argp->oprval.tref->opcode)
all_lits = FALSE;
argc++;
argp++;
if (TK_COMMA != TREF(window_token))
break;
advancewindow();
if (CHARMAXARGS <= argc)
{
stx_error(ERR_FCHARMAXARGS);
return FALSE;
}
}
if (all_lits)
{ /* All literals, build the function inline */
size = argc * GTM_MB_LEN_MAX;
ENSURE_STP_FREE_SPACE(size);
base = stringpool.free;
argp = &argv[0];
for (outptr = base, char_len = 0; argc > 0; --argc, argp++)
{ /* For each wide char value, convert to unicode chars in stringpool buffer */
ch = argp->oprval.tref->operand[0].oprval.ilit;
if (0 <= ch)
{ /* As per the M standard, negative code points should map to no characters */
tmpptr = UTF8_WCTOMB(ch, outptr);
assert(tmpptr - outptr <= 4);
if (tmpptr != outptr)
++char_len; /* yet another valid character. update the character length */
else if (!badchar_inhibit)
stx_error(ERR_INVDLRCVAL, 1, ch);
outptr = tmpptr;
}
}
stringpool.free = outptr;
MV_INIT_STRING(&v, outptr - base, base);
v.str.char_len = char_len;
v.mvtype |= MV_UTF_LEN;
CLEAR_MVAL_BITS(&v);
s2n(&v);
*a = put_lit(&v);
return TRUE;
}
root = maketriple(op);
root->operand[0] = put_ilit(argc + 1);
last = root;
argp = &argv[0];
for (; argc > 0 ;argc--, argp++)
{
curr = newtriple(OC_PARAMETER);
curr->operand[0] = *argp;
last->operand[1] = put_tref(curr);
last = curr;
}
ins_triple(root);
*a = put_tref(root);
return TRUE;
}
void op_fnj3(mval *src,int width,int fract,mval *dst)
{
int4 n, n1, m;
int w, digs, digs_used;
int sign;
static readonly int4 fives_table[9] =
{ 500000000, 50000000, 5000000, 500000, 50000, 5000, 500, 50, 5};
unsigned char *cp;
error_def(ERR_JUSTFRACT);
error_def(ERR_MAXSTRLEN);
if (width < 0)
width = 0;
else if (width > MAX_STRLEN)
rts_error(VARLSTCNT(1) ERR_MAXSTRLEN);
if (fract < 0)
rts_error(VARLSTCNT(1) ERR_JUSTFRACT);
w = width + MAX_NUM_SIZE + 2 + fract;
/* the literal two above accounts for the possibility
of inserting a zero and/or a minus with a width of zero */
if (w > MAX_STRLEN)
rts_error(VARLSTCNT(1) ERR_MAXSTRLEN);
MV_FORCE_NUM(src);
/* need to guarantee that the n2s call will not cause string pool overflow */
ENSURE_STP_FREE_SPACE(w);
sign = 0;
cp = stringpool.free;
if (src->mvtype & MV_INT)
{
n = src->m[1];
if (n < 0)
{
sign = 1;
n = -n;
}
/* Round if necessary */
if (fract < 3)
n += fives_table[fract + 6];
/* Compute digs, the number of non-zero leading digits */
if (n < 1000)
{
digs = 0;
/* if we have something like $j(-.01,0,1), the answer should be 0.0, not -0.0
so lets check for that here */
if (sign && fract < 4 && n / ten_pwr[3 - fract] == 0)
{
sign = 0;
n = 0;
} else
n *= 1000000;
} else if (n >= 1000000000)
{
digs = 7;
} else
{
for (digs = 6; n < 100000000 ; n *= 10 , digs--)
;
}
/* Do we need leading spaces? */
w = width - sign - (fract != 0) - fract - digs;
if (digs == 0)
w--;
if (w > 0)
{
memset(cp, ' ', w);
cp += w;
}
if (sign)
*cp++ = '-';
if (digs == 0)
*cp++ = '0';
else
{
/* It is possible that when rounding, that
we overflowed by one digit. In this case,
the left-most digit must be a "1".
Take care of this case first.
*/
if (digs == 7)
{
*cp++ = '1';
n -= 1000000000;
digs = 6;
}
for ( ; digs > 0 ; digs--)
{
n1 = n / 100000000;
*cp++ = n1 + '0';
n = (n - n1 * 100000000) * 10;
}
}
if (fract)
{
*cp++ = '.';
for (digs = fract ; digs > 0 && n != 0; digs--)
{
n1 = n / 100000000;
*cp++ = n1 + '0';
n = (n - n1 * 100000000) * 10;
}
if (digs)
{
memset(cp, '0', digs);
cp += digs;
}
}
} else
{
digs = src->e - MV_XBIAS;
m = src->m[0];
n = src->m[1];
sign = src->sgn;
w = digs + fract;
if (w < 18 && w >= 0)
{
if (w < 9)
{
n += fives_table[w];
if (n >= MANT_HI)
{
n1 = n / 10;
m = m / 10 + ((n - n1 * 10) * MANT_LO);
n = n1;
digs++;
}
}
else
{
m += fives_table[w - 9];
if (m >= MANT_HI)
{
m -= MANT_HI;
n++;
if (n >= MANT_HI)
{
n1 = n / 10;
m = m / 10 + ((n - n1 * 10) * MANT_LO);
n = n1;
digs++;
}
}
}
}
/* if we have something like $j(-.0001,0,1), the answer should be 0.0, not -0.0 */
if (digs <= - fract)
{
sign = 0;
n = m = 0;
}
w = width - fract - (fract != 0) - sign - (digs < 1 ? 1 : digs);
if (w > 0)
{
memset(cp, ' ', w);
cp += w;
}
if (sign)
*cp++ = '-';
digs_used = 0;
if (digs < 1)
*cp++ = '0';
else
{
for ( ; digs > 0 && (n != 0 || m != 0); digs--)
{
n1 = n / 100000000;
*cp++ = n1 + '0';
digs_used++;
if (digs_used == 9)
{
n = m;
m = 0;
} else
n = (n - n1 * 100000000) * 10;
}
if (digs > 0)
{
memset(cp, '0', digs);
cp += digs;
}
}
if (fract)
{
*cp++ = '.';
if (digs < 0)
{
digs = - digs;
if (digs > fract)
digs = fract;
memset(cp, '0', digs);
cp += digs;
fract -= digs;
}
for (digs = fract ; digs > 0 && (n != 0 || m != 0); digs--)
{
n1 = n / 100000000;
*cp++ = n1 + '0';
digs_used++;
if (digs_used == 9)
{
n = m;
m = 0;
} else
n = (n - n1 * 100000000) * 10;
}
if (digs)
{
memset(cp, '0', digs);
cp += digs;
}
}
}
dst->mvtype = MV_STR;
dst->str.addr = (char *)stringpool.free;
dst->str.len = INTCAST((char *)cp - dst->str.addr);
stringpool.free = cp;
return;
}
void op_fnztrnlnm(mval *name,mval *table,int4 ind,mval *mode,mval *case_blind,mval *item,mval *ret)
{
struct dsc$descriptor lname, ltable;
uint4 attribute, status, retlen, mask, full_mask;
char acmode;
short int *item_code, pass, index;
bool full;
char buff[256], result[MAX_RESULT_SIZE];
char i, slot, last_slot;
char def_table[] = "LNM$DCL_LOGICAL";
struct
{
item_list_3 item[3];
int4 terminator;
} item_list;
error_def(ERR_BADTRNPARAM);
if(!name->str.len || MAX_LOGNAM_LENGTH < name->str.len || MAX_LOGNAM_LENGTH < table->str.len)
rts_error(VARLSTCNT(1) SS$_IVLOGNAM);
memset(&item_list,0,SIZEOF(item_list));
item_list.item[0].item_code = 0;
item_list.item[0].buffer_address = result;
item_list.item[0].buffer_length = MAX_RESULT_SIZE;
item_list.item[0].return_length_address = &retlen;
item_code = &item_list.item[0].item_code;
lname.dsc$w_length = name->str.len;
lname.dsc$a_pointer = name->str.addr;
lname.dsc$b_dtype = DSC$K_DTYPE_T;
lname.dsc$b_class = DSC$K_CLASS_S;
if (table->str.len)
{ ltable.dsc$w_length = table->str.len;
ltable.dsc$a_pointer = table->str.addr;
}else
{ ltable.dsc$a_pointer = def_table;
ltable.dsc$w_length = strlen(def_table);
}
ltable.dsc$b_dtype = DSC$K_DTYPE_T;
ltable.dsc$b_class = DSC$K_CLASS_S;
if(ind)
{ item_list.item[0].item_code = LNM$_INDEX;
item_list.item[0].buffer_address = &ind;
item_list.item[1].item_code = 0;
item_list.item[1].buffer_address = result;
item_list.item[1].buffer_length = MAX_RESULT_SIZE;
item_list.item[1].return_length_address = &retlen;
item_code = &item_list.item[1].item_code;
}
attribute = LNM$M_CASE_BLIND;
if (case_blind->str.len)
{
if (case_blind->str.len > 14)
rts_error(VARLSTCNT(4) ERR_BADTRNPARAM, 2,
MIN(SHRT_MAX, case_blind->str.len), case_blind->str.addr);
lower_to_upper(buff,case_blind->str.addr,case_blind->str.len);
if (case_blind->str.len == 14 && !memcmp(buff,"CASE_SENSITIVE",14))
attribute = 0;
else if (case_blind->str.len != 10 || memcmp(buff,"CASE_BLIND",10))
rts_error(VARLSTCNT(4) ERR_BADTRNPARAM,2,case_blind->str.len,case_blind->str.addr);
}
acmode = NOVALUE;
if (mode->str.len)
{
if (mode->str.len > 14)
rts_error(VARLSTCNT(4) ERR_BADTRNPARAM, 2,
MIN(SHRT_MAX, mode->str.len), mode->str.addr);
lower_to_upper(buff,mode->str.addr,mode->str.len);
switch (buff[0])
{
case 'U':
if ( mode->str.len = 4 && !memcmp(buff, "USER", 4))
acmode = PSL$C_USER;
case 'S':
if ( mode->str.len = 10 && !memcmp(buff, "SUPERVISOR", 10))
acmode = PSL$C_SUPER;
case 'K':
if ( mode->str.len = 6 && !memcmp(buff, "KERNEL", 6))
acmode = PSL$C_KERNEL;
case 'E':
if ( mode->str.len = 9 && !memcmp(buff, "EXECUTIVE", 9))
acmode = PSL$C_EXEC;
}
if (acmode == NOVALUE)
rts_error(VARLSTCNT(4) ERR_BADTRNPARAM,2,mode->str.len,mode->str.addr);
}
full = FALSE;
*item_code = NOVALUE;
if (item->str.len)
{ if (item->str.len > 12)
rts_error(VARLSTCNT(4) ERR_BADTRNPARAM, 2,
MIN(SHRT_MAX, item->str.len), item->str.addr);
lower_to_upper(buff,item->str.addr,item->str.len);
if ((i = buff[0] - 'A') < MIN_INDEX || i > MAX_INDEX)
{ rts_error(VARLSTCNT(4) ERR_BADTRNPARAM, 2, item->str.len, item->str.addr);
}
if ( trnlnm_index[i].len)
{ slot = trnlnm_index[i].index;
last_slot = trnlnm_index[i].len;
for (; slot < last_slot; slot++)
{ if (item->str.len == trnlnm_table[slot].len &&
!memcmp(trnlnm_table[slot].name, buff, item->str.len))
{ if (trnlnm_table[slot].item_code == FULL_VALUE)
{ if (ind)
index = 2;
else
index = 1;
*item_code = LNM$_STRING;
item_list.item[index].buffer_address = &full_mask;
item_list.item[index].buffer_length = SIZEOF(full_mask);
item_list.item[index].item_code = LNM$_ATTRIBUTES;
item_code = &item_list.item[index].item_code;
full = TRUE;
}else
{ *item_code = trnlnm_table[slot].item_code;
}
break;
}
}
}
if (*item_code == NOVALUE)
{ rts_error(VARLSTCNT(4) ERR_BADTRNPARAM,2,item->str.len,item->str.addr);
}
}else
{ *item_code = LNM$_STRING;
}
for ( pass = 0 ; ; pass++ )
{ retlen = 0;
status = sys$trnlnm(&attribute, <able, &lname, acmode == NOVALUE ? 0 : &acmode, &item_list);
if (status & 1)
{ if (*item_code == LNM$_STRING || *item_code == LNM$_TABLE)
{ ret->mvtype = MV_STR;
ENSURE_STP_FREE_SPACE(retlen);
ret->str.addr = stringpool.free;
ret->str.len = retlen;
memcpy(ret->str.addr, result, retlen);
stringpool.free += retlen;
return;
}else if (*item_code == LNM$_LENGTH || *item_code == LNM$_MAX_INDEX)
{
MV_FORCE_MVAL(ret,*(int4 *)result) ;
n2s(ret);
return;
}else if (*item_code == LNM$_ACMODE)
{ ret->mvtype = MV_STR;
switch(*result)
{ case PSL$C_USER:
ENSURE_STP_FREE_SPACE(4);
ret->str.addr = stringpool.free;
ret->str.len = 4;
memcpy(ret->str.addr, "USER", 4);
stringpool.free += 4;
return;
case PSL$C_SUPER:
ENSURE_STP_FREE_SPACE(5);
ret->str.addr = stringpool.free;
ret->str.len = 5;
memcpy(ret->str.addr, "SUPER", 5);
stringpool.free += 5;
return;
case PSL$C_EXEC:
ENSURE_STP_FREE_SPACE(9);
ret->str.addr = stringpool.free;
ret->str.len = 9;
memcpy(ret->str.addr, "EXECUTIVE", 9);
stringpool.free += 9;
return;
case PSL$C_KERNEL:
ENSURE_STP_FREE_SPACE(6);
ret->str.addr = stringpool.free;
ret->str.len = 6;
memcpy(ret->str.addr, "KERNEL", 6);
stringpool.free += 6;
return;
default:
GTMASSERT;
}
}else
{ assert(*item_code == LNM$_ATTRIBUTES);
if (full)
{ if (!retlen) /* If the logical name exists, but has no entry for the specified index, */
{ /* then the return status will be normal as the TERMINAL attribute will */
/* be filled in, but there will be no equivalence name, thus retlen == 0 */
ret->mvtype = MV_STR;
if (!pass)
{ ret->str.len = 0;
return;
}
ENSURE_STP_FREE_SPACE(lname.dsc$w_length);
ret->str.addr = stringpool.free;
ret->str.len = lname.dsc$w_length;
memcpy(ret->str.addr, lname.dsc$a_pointer, lname.dsc$w_length);
stringpool.free += lname.dsc$w_length;
return;
}
if(full_mask & LNM$M_TERMINAL)
{ ret->mvtype = MV_STR;
ENSURE_STP_FREE_SPACE(retlen);
ret->str.addr = stringpool.free;
ret->str.len = retlen;
memcpy(ret->str.addr, result, retlen);
stringpool.free += retlen;
return;
}
memcpy(buff,result,retlen);
lname.dsc$w_length = retlen;
lname.dsc$a_pointer = buff;
}else
{ mask = attr_tab[slot];
if (mask == NOVALUE)
GTMASSERT;
MV_FORCE_MVAL(ret,( *((int4*)result) & mask ? 1 : 0 )) ;
n2s(ret);
return;
}
}
}else if (status == SS$_NOLOGNAM)
{ ret->mvtype = MV_STR;
if (full && pass > 0)
{
ENSURE_STP_FREE_SPACE(lname.dsc$w_length);
ret->str.addr = stringpool.free;
ret->str.len = lname.dsc$w_length;
memcpy(ret->str.addr, lname.dsc$a_pointer, lname.dsc$w_length);
stringpool.free += lname.dsc$w_length;
}else
{ ret->str.len = 0;
}
return;
}else
{ rts_error(VARLSTCNT(1) status);
}
}
MV_FORCE_MVAL(ret, 0) ;
return;
}
void op_indtext(mval *lab, mint offset, mval *rtn, mval *dst)
{
bool rval;
mstr *obj, object;
mval mv_off;
oprtype opt;
triple *ref;
icode_str indir_src;
error_def(ERR_INDMAXNEST);
error_def(ERR_STACKOFLOW);
error_def(ERR_STACKCRIT);
MV_FORCE_STR(lab);
indir_src.str.len = lab->str.len;
indir_src.str.len += SIZEOF("+^") - 1;
indir_src.str.len += MAX_NUM_SIZE;
indir_src.str.len += rtn->str.len;
ENSURE_STP_FREE_SPACE(indir_src.str.len);
DBG_MARK_STRINGPOOL_UNEXPANDABLE; /* Now that we have ensured enough space in the stringpool, we dont expect any more
* garbage collections or expansions until we are done with the below initialization.
*/
/* Push an mval pointing to the complete entry ref on to the stack so the string is valid even
* if garbage collection occurs before cache_put() */
PUSH_MV_STENT(MVST_MVAL);
mv_chain->mv_st_cont.mvs_mval.mvtype = 0; /* so stp_gcol (if invoked below) does not get confused by this otherwise
* incompletely initialized mval in the M-stack */
mv_chain->mv_st_cont.mvs_mval.str.addr = (char *)stringpool.free;
memcpy(stringpool.free, lab->str.addr, lab->str.len);
stringpool.free += lab->str.len;
*stringpool.free++ = '+';
MV_FORCE_MVAL(&mv_off, offset);
MV_FORCE_STRD(&mv_off); /* goes at stringpool.free. we already made enough space in the stp_gcol() call */
*stringpool.free++ = '^';
memcpy(stringpool.free, rtn->str.addr, rtn->str.len);
stringpool.free += rtn->str.len;
mv_chain->mv_st_cont.mvs_mval.str.len = INTCAST(stringpool.free - (unsigned char*)mv_chain->mv_st_cont.mvs_mval.str.addr);
mv_chain->mv_st_cont.mvs_mval.mvtype = MV_STR; /* initialize mvtype now that mval has been otherwise completely set up */
DBG_MARK_STRINGPOOL_EXPANDABLE; /* Now that we are done with stringpool.free initializations, mark as free for expansion */
indir_src.str = mv_chain->mv_st_cont.mvs_mval.str;
indir_src.code = indir_text;
if (NULL == (obj = cache_get(&indir_src)))
{
comp_init(&indir_src.str);
rval = f_text(&opt, OC_FNTEXT);
if (!comp_fini(rval, &object, OC_IRETMVAL, &opt, indir_src.str.len))
{
assert(mv_chain->mv_st_type == MVST_MVAL);
POP_MV_STENT();
return;
}
indir_src.str.addr = mv_chain->mv_st_cont.mvs_mval.str.addr;
cache_put(&indir_src, &object);
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
assert(mv_chain->mv_st_type == MVST_MVAL);
POP_MV_STENT(); /* unwind the mval entry before the new frame gets added by comp_indir below */
comp_indr(&object);
return;
}
*ind_result_sp++ = dst;
if (ind_result_sp >= ind_result_top)
rts_error(VARLSTCNT(1) ERR_INDMAXNEST);
assert(mv_chain->mv_st_type == MVST_MVAL);
POP_MV_STENT(); /* unwind the mval entry before the new frame gets added by comp_indir below */
comp_indr(obj);
return;
}
/*
* ----------------------------------------------------------
* Set $zpiece procedure.
* Set pieces first through last to expr.
*
* Arguments:
* src - source mval
* del - delimiter string mval
* expr - expression string mval
* first - starting index in source mval to be set
* last - last index
* dst - destination mval where the result is saved.
*
* Return:
* none
* ----------------------------------------------------------
*/
void op_setzpiece(mval *src, mval *del, mval *expr, int4 first, int4 last, mval *dst)
{
size_t str_len, delim_cnt;
int match_res, len, src_len, first_src_ind, second_src_ind, numpcs;
unsigned char *match_ptr, *src_str, *str_addr, *tmp_str;
delimfmt unichar;
if (0 > --first)
first = 0;
assert(last >= first);
second_src_ind = last - first;
MV_FORCE_STR(del);
/* Null delimiter */
if (0 == del->str.len)
{
if (first && src->mvtype)
{
/* concat src & expr to dst */
op_cat(VARLSTCNT(3) dst, src, expr);
return;
}
MV_FORCE_STR(expr);
*dst = *expr;
return;
}
MV_FORCE_STR(expr);
if (!MV_DEFINED(src))
{
first_src_ind = 0;
second_src_ind = -1;
} else
{
/* Valid delimiter - See if we can take a short cut to op_fnzp1. If so, delimiter value needs to be reformated */
if ((1 == second_src_ind) && (1 == del->str.len))
{ /* Count of pieces to retrieve is 1 so see what we can do quickly */
unichar.unichar_val = 0;
unichar.unibytes_val[0] = *del->str.addr;
op_setzp1(src, unichar.unichar_val, expr, last, dst); /* Use "last" since it has not been modified */
return;
}
/* We have a valid src with something in it */
MV_FORCE_STR(src);
src_str = (unsigned char *)src->str.addr;
src_len = src->str.len;
/* skip all pieces until start one */
if (first)
{
numpcs = first; /* copy int4 type "first" into "int" type numpcs for passing to matchc */
match_ptr = matchb(del->str.len, (uchar_ptr_t)del->str.addr, src_len, src_str, &match_res, &numpcs);
/* Note: "numpcs" is modified above by the function "matchb" to reflect the # of unmatched pieces */
first = numpcs; /* copy updated "numpcs" value back into "first" */
} else
{
match_ptr = src_str;
match_res = 1;
}
first_src_ind = INTCAST(match_ptr - (unsigned char *)src->str.addr);
if (0 == match_res) /* if match not found */
second_src_ind = -1;
else
{
src_len -= INTCAST(match_ptr - src_str);
src_str = match_ptr;
/* skip # delimiters this piece will replace, e.g. if we are setting
* pieces 2 - 4, then the pieces 2-4 will be replaced by one piece - expr.
*/
match_ptr = matchb(del->str.len, (uchar_ptr_t)del->str.addr, src_len, src_str, &match_res, &second_src_ind);
second_src_ind = (0 == match_res) ? -1 : INTCAST(match_ptr - (unsigned char *)src->str.addr - del->str.len);
}
}
delim_cnt = (size_t)first;
/* Calculate total string len. */
str_len = (size_t)expr->str.len + ((size_t)first_src_ind + ((size_t)del->str.len * delim_cnt));
/* add len. of trailing chars past insertion point */
if (0 <= second_src_ind)
str_len += (size_t)(src->str.len - second_src_ind);
if (MAX_STRLEN < str_len)
{
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MAXSTRLEN);
return;
}
ENSURE_STP_FREE_SPACE((int)str_len);
str_addr = stringpool.free;
/* copy prefix */
if (first_src_ind)
{
memcpy(str_addr, src->str.addr, first_src_ind);
str_addr += first_src_ind;
}
/* copy delimiters */
while (0 < delim_cnt--)
{
memcpy(str_addr, del->str.addr, del->str.len);
str_addr += del->str.len;
}
/* copy expression */
memcpy(str_addr, expr->str.addr, expr->str.len);
str_addr += expr->str.len;
/* copy trailing pieces */
if (0 <= second_src_ind)
{
len = src->str.len - second_src_ind;
tmp_str = (unsigned char *)src->str.addr + second_src_ind;
memcpy(str_addr, tmp_str, len);
str_addr += len;
}
assert(IS_AT_END_OF_STRINGPOOL(str_addr, -str_len));
dst->mvtype = MV_STR;
dst->str.len = INTCAST(str_addr - stringpool.free);
dst->str.addr = (char *)stringpool.free;
stringpool.free = str_addr;
return;
}
void gvcmx_susremlk(unsigned char rmv_locks)
{
uint4 status,count,buffer;
unsigned char *ptr;
struct CLB *p;
error_def(ERR_BADSRVRNETMSG);
if (!ntd_root)
return;
buffer = lksusp_sent = lksusp_rec = 0;
for (p = (struct CLB *)RELQUE2PTR(ntd_root->cqh.fl); p != (struct CLB *)ntd_root; p = (struct CLB *)RELQUE2PTR(p->cqe.fl))
{
if (((link_info*)(p->usr))->lck_info & REQUEST_PENDING)
buffer += p->mbl;
}
ENSURE_STP_FREE_SPACE(buffer);
ptr = stringpool.free;
for (p = (struct CLB *)RELQUE2PTR(ntd_root->cqh.fl); p != (struct CLB *)ntd_root; p = (struct CLB *)RELQUE2PTR(p->cqe.fl))
{
if (((link_info *)(p->usr))->lck_info & REQUEST_PENDING)
{
p->mbf = ptr;
*ptr++ = CMMS_L_LKSUSPEND;
*ptr++ = rmv_locks;
p->cbl = 2;
p->ast = 0;
status = cmi_write(p);
if (CMI_ERROR(status))
{
((link_info *)(p->usr))->neterr = TRUE;
gvcmz_error(CMMS_M_LKSUSPENDED, status);
return;
}
p->ast = gvcmz_lksuspend_ast;
status = cmi_read(p);
if (CMI_ERROR(status))
{
((link_info *)(p->usr))->neterr = TRUE;
gvcmz_error(CMMS_M_LKSUSPENDED, status);
return;
}
lksusp_sent++;
ptr = p->mbf + p->mbl;
}
}
while (lksusp_sent != lksusp_rec && !lkerror)
CMI_IDLE(CM_LKSUSPEND_TIME);
if (lkerror)
{
if (CMI_CLB_ERROR(lkerrlnk))
gvcmz_error(lkerror, CMI_CLB_IOSTATUS(lkerrlnk));
else
{
if (*(lkerrlnk->mbf) != CMMS_E_ERROR)
rts_error(VARLSTCNT(1) ERR_BADSRVRNETMSG);
else
gvcmz_errmsg(lkerrlnk, FALSE);
}
}
}
void dm_read(mval *v)
{
boolean_t done;
unsigned short iosb[4];
int cl, index;
uint4 max_width, save_modifiers, save_term_msk, status;
read_iosb stat_blk;
io_desc *io_ptr;
t_cap s_mode;
d_tt_struct *tt_ptr;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if (tt == io_curr_device.out->type)
iott_flush(io_curr_device.out);
if (!comline_base)
{
comline_base = malloc(MAX_RECALL * SIZEOF(mstr));
memset(comline_base, 0, (MAX_RECALL * SIZEOF(mstr)));
}
io_ptr = io_curr_device.in;
assert(tt == io_ptr->type);
assert(dev_open == io_ptr->state);
if (io_ptr->dollar.zeof)
op_halt();
if (outofband)
{
outofband_action(FALSE);
assert(FALSE);
}
tt_ptr = (d_tt_struct *)io_ptr->dev_sp;
max_width = (io_ptr->width > tt_ptr->in_buf_sz) ? io_ptr->width : tt_ptr->in_buf_sz;
assert(stringpool.free >= stringpool.base);
assert(stringpool.free <= stringpool.top);
ENSURE_STP_FREE_SPACE(max_width);
active_device = io_ptr;
index = 0;
/* the following section of code puts the terminal in "easy of use" mode */
status = sys$qiow(EFN$C_ENF, tt_ptr->channel, IO$_SENSEMODE,
&stat_blk, 0, 0, &s_mode, 12, 0, 0, 0, 0);
if (SS$_NORMAL == status)
status = stat_blk.status;
if (SS$_NORMAL != status)
rts_error(VARLSTCNT(1) status);
if ((s_mode.ext_cap & TT2$M_PASTHRU) ||
!(s_mode.ext_cap & TT2$M_EDITING) ||
!(s_mode.term_char & TT$M_ESCAPE) ||
!(s_mode.term_char & TT$M_TTSYNC))
{
s_mode.ext_cap &= (~TT2$M_PASTHRU);
s_mode.ext_cap |= TT2$M_EDITING;
s_mode.term_char |= (TT$M_ESCAPE | TT$M_TTSYNC);
status = sys$qiow(EFN$C_ENF, tt_ptr->channel,
IO$_SETMODE, &stat_blk, 0, 0, &s_mode, 12, 0, 0, 0, 0);
if (SS$_NORMAL == status)
status = stat_blk.status;
if (SS$_NORMAL != status)
/* The following error is probably going to cause the terminal state to get mucked up */
rts_error(VARLSTCNT(1) status);
/* the following flag is normally used by iott_rdone, iott_readfl and iott_use but dm_read resets it when done */
tt_ptr->term_chars_twisted = TRUE;
}
save_modifiers = (unsigned)tt_ptr->item_list[0].addr;
tt_ptr->item_list[0].addr = (unsigned)tt_ptr->item_list[0].addr | TRM$M_TM_NORECALL & (~TRM$M_TM_NOECHO);
tt_ptr->item_list[1].addr = NO_M_TIMEOUT; /* reset key click timeout */
save_term_msk = ((io_termmask *)tt_ptr->item_list[2].addr)->mask[0];
((io_termmask *)tt_ptr->item_list[2].addr)->mask[0] = TERM_MSK | (SHFT_MSK << CTRL_B) | (SHFT_MSK << CTRL_Z);
tt_ptr->item_list[4].buf_len = (TREF(gtmprompt)).len;
do
{
done = TRUE;
assert(0 <= index && index <= MAX_RECALL + 1);
cl = clmod(comline_index - index);
if ((0 == index) || (MAX_RECALL + 1 == index))
tt_ptr->item_list[5].buf_len = 0;
else
{
tt_ptr->item_list[5].buf_len = comline_base[cl].len;
tt_ptr->item_list[5].addr = comline_base[cl].addr;
}
status = sys$qiow(EFN$C_ENF, tt_ptr->channel, tt_ptr->read_mask, &stat_blk, 0, 0,
stringpool.free, tt_ptr->in_buf_sz, 0, 0, tt_ptr->item_list, 6 * SIZEOF(item_list_struct));
if (outofband)
break;
if (SS$_NORMAL != status)
{
if (io_curr_device.in == io_std_device.in && io_curr_device.out == io_std_device.out)
{
if (prin_in_dev_failure)
sys$exit(status);
else
prin_in_dev_failure = TRUE;
}
break;
}
if (stat_blk.term_length > ESC_LEN - 1)
{
stat_blk.term_length = ESC_LEN - 1;
if (SS$_NORMAL == stat_blk.status)
stat_blk.status = SS$_PARTESCAPE;
}
if (SS$_NORMAL != stat_blk.status)
{
if (ctrlu_occurred)
{
index = 0;
done = FALSE;
ctrlu_occurred = FALSE;
iott_wtctrlu(stat_blk.char_ct + (TREF(gtmprompt)).len, io_ptr);
} else
{
status = stat_blk.status;
break;
}
} else
{
if ((CTRL_B == stat_blk.term_char) ||
(stat_blk.term_length == tt_ptr->key_up_arrow.len &&
!memcmp(tt_ptr->key_up_arrow.addr, stringpool.free + stat_blk.char_ct,
tt_ptr->key_up_arrow.len)))
{
done = FALSE;
if ((MAX_RECALL + 1 != index) && (comline_base[cl].len || !index))
index++;
} else
{
if (stat_blk.term_length == tt_ptr->key_down_arrow.len &&
!memcmp(tt_ptr->key_down_arrow.addr, stringpool.free + stat_blk.char_ct,
tt_ptr->key_down_arrow.len))
{
done = FALSE;
if (index)
--index;
}
}
if (!done)
{
status = sys$qiow(EFN$C_ENF, tt_ptr->channel,
IO$_WRITEVBLK, &iosb, NULL, 0,
tt_ptr->erase_to_end_line.addr, tt_ptr->erase_to_end_line.len,
0, CCRECALL, 0, 0);
} else
{
if (stat_blk.char_ct > 0
&& (('R' == *stringpool.free) || ('r' == *stringpool.free)) &&
(TRUE == m_recall(stat_blk.char_ct, stringpool.free, &index, tt_ptr->channel)))
{
assert(-1 <= index && index <= MAX_RECALL);
done = FALSE;
flush_pio();
status = sys$qiow(EFN$C_ENF, tt_ptr->channel,
IO$_WRITEVBLK, &iosb, NULL, 0,
0, 0, 0, CCPROMPT, 0, 0);
if ((-1 == index) || (CTRL_Z == stat_blk.term_char))
index = 0;
}
}
if (!done)
{
if (SS$_NORMAL == status)
status = iosb[0];
if (SS$_NORMAL != status)
break;
} else
{
if (CTRL_Z == stat_blk.term_char)
io_curr_device.in->dollar.zeof = TRUE;
}
}
} while (!done);
/* put the terminal back the way the user had it set up */
tt_ptr->item_list[0].addr = save_modifiers;
((io_termmask *)tt_ptr->item_list[2].addr)->mask[0] = save_term_msk;
if (tt_ptr->term_chars_twisted)
{
s_mode.ext_cap &= (~TT2$M_PASTHRU & ~TT2$M_EDITING);
s_mode.ext_cap |= (tt_ptr->ext_cap & (TT2$M_PASTHRU | TT2$M_EDITING));
s_mode.term_char &= (~TT$M_ESCAPE);
s_mode.term_char |= (tt_ptr->term_char & TT$M_ESCAPE);
status = sys$qiow(EFN$C_ENF, tt_ptr->channel,
IO$_SETMODE, iosb, 0, 0, &s_mode, 12, 0, 0, 0, 0);
if (SS$_NORMAL == status)
status = iosb[0];
tt_ptr->term_chars_twisted = FALSE;
}
if (SS$_NORMAL != status)
rts_error(VARLSTCNT(1) status);
if (outofband)
{
/* outofband not going to help more than a error so it's checked 2nd */
outofband_action(FALSE);
assert(FALSE);
}
v->mvtype = MV_STR;
v->str.len = stat_blk.char_ct;
v->str.addr = stringpool.free;
if (stat_blk.char_ct)
{
cl = clmod(comline_index - 1);
if (stat_blk.char_ct != comline_base[cl].len || memcmp(comline_base[cl].addr, stringpool.free, stat_blk.char_ct))
{
comline_base[comline_index] = v->str;
comline_index = clmod(comline_index + 1);
}
stringpool.free += stat_blk.char_ct;
}
assert(stringpool.free <= stringpool.top);
if ((io_ptr->dollar.x += stat_blk.char_ct) > io_ptr->width && io_ptr->wrap)
{
/* dm_read doesn't maintain the other io status isv's,
but it does $x and $y so the user can find out where they wound up */
io_ptr->dollar.y += io_ptr->dollar.x / io_ptr->width;
if (io_ptr->length)
io_ptr->dollar.y %= io_ptr->length;
io_ptr->dollar.x %= io_ptr->width;
}
active_device = 0;
}
/*
* ----------------------------------------------------------
* Fast path setpiece when delimiter is one (lit) char replacing
* a single piece (last is same as first). Unicode flavor.
*
* Arguments:
* src - source mval
* delim - delimiter char
* expr - expression string mval
* ind - index in source mval to be set
* dst - destination mval where the result is saved.
*
* Return:
* none
* ----------------------------------------------------------
*/
void op_setp1(mval *src, int delim, mval *expr, int ind, mval *dst)
{
size_t str_len, delim_cnt;
int len, pfx_str_len, sfx_start_offset, sfx_str_len, rep_str_len, pfx_scan_offset;
int dlmlen, cpy_cache_lines, mblen;
unsigned char *start_sfx, *str_addr, *end_pfx, *end_src, *start_pfx;
boolean_t do_scan, delim_last_scan, valid_char;
mval dummymval; /* It's value is not used but is part of the call to op_fnp1() */
fnpc *cfnpc, *pfnpc;
delimfmt ldelim;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(gtm_utf8_mode);
do_scan = FALSE;
cpy_cache_lines = -1;
ldelim.unichar_val = delim;
if (!UTF8_VALID(ldelim.unibytes_val, (ldelim.unibytes_val + SIZEOF(ldelim.unibytes_val)), dlmlen)
&& !badchar_inhibit)
{ /* The delimiter is a bad character so error out if badchar not inhibited */
UTF8_BADCHAR(0, ldelim.unibytes_val, ldelim.unibytes_val + SIZEOF(ldelim.unibytes_val), 0, NULL);
}
MV_FORCE_STR(expr); /* Expression to put into piece place */
if (MV_DEFINED(src))
{
/* We have 3 possible scenarios:
* 1) The source string is null. Nothing to do but proceed to building output.
* 2) If the requested piece is larger than can be cached by op_fnp1, call fnp1
* for the maximum piece possible, use the cache info to "prime the pump" and
* then process the rest of the string ourselves.
* 3) If the requested piece can be obtained from the cache, call op_fnp1 to validate
* and rebuild the cache if necessary and then retrieve the necessary info from
* the fnpc cache.
*/
MV_FORCE_STR(src); /* Make sure is string prior to length check */
if (0 == src->str.len)
{ /* We have a null source string */
pfx_str_len = sfx_str_len = sfx_start_offset = 0;
delim_cnt = (0 < ind) ? (size_t)ind - 1 : 0;
} else if (FNPC_ELEM_MAX >= ind)
{ /* 3) Best of all possible cases. The op_fnp1 can do most of our work for us
* and we can preload the cache on the new string to help its subsequent
* uses along as well.
*/
SETWON;
op_fnp1(src, delim, ind, &dummymval);
SETWOFF;
cfnpc = &(TREF(fnpca)).fnpcs[src->fnpc_indx - 1];
assert(cfnpc->last_str.addr == src->str.addr);
assert(cfnpc->last_str.len == src->str.len);
assert(cfnpc->delim == delim);
assert(0 < cfnpc->npcs);
/* Three more scenarios: #1 piece all in cache, #2 piece would be in cache but ran
* out of text or #3 piece is beyond what can be cached
*/
if (cfnpc->npcs >= ind)
{ /* #1 The piece we want is totally within the cache which is good news */
pfx_str_len = cfnpc->pstart[ind - 1];
delim_cnt = 0;
sfx_start_offset = cfnpc->pstart[ind] - dlmlen; /* Include delimiter */
rep_str_len = cfnpc->pstart[ind] - cfnpc->pstart[ind - 1] - dlmlen; /* Replace string length */
sfx_str_len = src->str.len - pfx_str_len - rep_str_len;
cpy_cache_lines = ind - 1;
} else
{ /* #2 The string was too short so the cache does not contain our string. This means
* that the prefix becomes any text that IS in the cache and we set the delim_cnt
* to be the number of missing pieces so the delimiters can be put in as part of the
* prefix when we build the new string.
*/
pfx_str_len = cfnpc->pstart[cfnpc->npcs] - dlmlen;
delim_cnt = (size_t)(ind - cfnpc->npcs);
sfx_start_offset = 0;
sfx_str_len = 0;
cpy_cache_lines = cfnpc->npcs;
}
} else
{ /* 2) We have a element that would not be able to be in the fnpc cache. Go ahead
* and call op_fnp1 to get cache info up to the maximum and then we will continue
* the scan on our own.
*/
SETWON;
op_fnp1(src, delim, FNPC_ELEM_MAX, &dummymval);
SETWOFF;
cfnpc = &(TREF(fnpca)).fnpcs[src->fnpc_indx - 1];
assert(cfnpc->last_str.addr == src->str.addr);
assert(cfnpc->last_str.len == src->str.len);
assert(cfnpc->delim == delim);
assert(0 < cfnpc->npcs);
if (FNPC_ELEM_MAX > cfnpc->npcs)
{ /* We ran out of text so the scan is complete. This is basically the same
* as case #2 above.
*/
pfx_str_len = cfnpc->pstart[cfnpc->npcs] - dlmlen;
delim_cnt = (size_t)(ind - cfnpc->npcs);
sfx_start_offset = 0;
sfx_str_len = 0;
cpy_cache_lines = cfnpc->npcs;
} else
{ /* We have a case where the piece we want cannot be kept in cache. In the special
* case where there is no more text to handle, we don't need to scan further. Otherwise
* we prime the pump and continue the scan where the cache left off.
*/
if ((pfx_scan_offset = cfnpc->pstart[FNPC_ELEM_MAX]) < src->str.len) /* Note assignment */
/* Normal case where we prime the pump */
do_scan = TRUE;
else
{ /* Special case -- no more text to scan */
pfx_str_len = cfnpc->pstart[FNPC_ELEM_MAX] - dlmlen;
sfx_start_offset = 0;
sfx_str_len = 0;
}
delim_cnt = (size_t)ind - FNPC_ELEM_MAX;
cpy_cache_lines = FNPC_ELEM_MAX;
}
}
} else
{ /* Source is not defined -- treat as a null string */
pfx_str_len = sfx_str_len = sfx_start_offset = 0;
delim_cnt = (size_t)ind - 1;
}
/* If we have been forced to do our own scan, do that here. Note the variable pfx_scan_offset has been
* set to where the scan should begin in the src string and delim_cnt has been set to how many delimiters
* still need to be processed.
*/
if (do_scan)
{ /* Scan the line isolating prefix piece, and end of the
* piece being replaced
*/
COUNT_EVENT(small);
end_pfx = start_sfx = (unsigned char *)src->str.addr + pfx_scan_offset;
end_src = (unsigned char *)src->str.addr + src->str.len;
/* The compiler would unroll this loop this way anyway but we want to
* adjust the start_sfx pointer after the loop but only if we have gone
* into it at least once.
*/
if ((0 < delim_cnt) && (start_sfx < end_src))
{
do
{
end_pfx = start_sfx;
delim_last_scan = FALSE; /* Whether delimiter is last character scanned */
while (start_sfx < end_src)
{
valid_char = UTF8_VALID(start_sfx, end_src, mblen); /* Length of next char */
if (!valid_char)
{ /* Next character is not valid unicode. If badchar error is not inhibited,
* signal it now. If it is inhibited, just treat the character as a single
* character and continue.
*/
if (!badchar_inhibit)
utf8_badchar(0, start_sfx, end_src, 0, NULL);
assert(1 == mblen);
}
/* Getting mblen first allows us to do quick length compare before the
* heavier weight memcmp call.
*/
assert(0 < mblen);
if (mblen == dlmlen && 0 == memcmp(start_sfx, ldelim.unibytes_val, dlmlen))
{
delim_last_scan = TRUE;
break;
}
/* Increment ptrs by size of found char */
start_sfx += mblen;
}
start_sfx += dlmlen;
delim_cnt--;
} while ((0 < delim_cnt) && (start_sfx < end_src));
/* We have to backup up the suffix start pointer except under the condition
* that the last character in the buffer is the last delimiter we were looking
* for.
*/
if ((0 == delim_cnt) || (start_sfx < end_src) || !delim_last_scan)
start_sfx -= dlmlen; /* Back up suffix to include delimiter char */
/* If we scanned to the end (no text left) and still have delimiters to
* find, the entire src text should be part of the prefix
*/
if ((start_sfx >= end_src) && (0 < delim_cnt))
{
end_pfx = start_sfx;
if (delim_last_scan) /* if last char was delim, reduce delim cnt */
--delim_cnt;
}
} else
{
/* If not doing any token finding, then this count becomes the number
* of tokens to output. Adjust accordingly.
*/
if (0 < delim_cnt)
--delim_cnt;
}
INCR_COUNT(small_pcs, (int)((size_t)ind - delim_cnt));
/* Now having the following situation:
* end_pfx -> end of the prefix piece including delimiter
* start_sfx -> start of suffix piece (with delimiter) or = end_pfx/src->str.addr if none
*/
pfx_str_len = (int)(end_pfx - (unsigned char *)src->str.addr);
if (0 > pfx_str_len)
pfx_str_len = 0;
sfx_start_offset = (int)(start_sfx - (unsigned char *)src->str.addr);
sfx_str_len = src->str.len - sfx_start_offset;
if (0 > sfx_str_len)
sfx_str_len = 0;
}
/* Calculate total string len. delim_cnt has needed padding delimiters for null fields */
str_len = (size_t)expr->str.len + (size_t)pfx_str_len + (delim_cnt * (size_t)dlmlen) + (size_t)sfx_str_len;
if (MAX_STRLEN < str_len)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_MAXSTRLEN);
ENSURE_STP_FREE_SPACE((int)str_len);
str_addr = stringpool.free;
start_pfx = (unsigned char *)src->str.addr;
/* copy prefix */
if (0 < pfx_str_len)
{
memcpy(str_addr, src->str.addr, pfx_str_len);
str_addr += pfx_str_len;
}
/* copy delimiters */
while (0 < delim_cnt--)
{
memcpy(str_addr, ldelim.unibytes_val, dlmlen);
str_addr += dlmlen;
}
/* copy expression */
if (0 < expr->str.len)
{
memcpy(str_addr, expr->str.addr, expr->str.len);
str_addr += expr->str.len;
}
/* copy suffix */
if (0 < sfx_str_len)
{
memcpy(str_addr, start_pfx + sfx_start_offset, sfx_str_len);
str_addr += sfx_str_len;
}
assert(IS_AT_END_OF_STRINGPOOL(str_addr, -str_len));
dst->mvtype = MV_STR;
dst->str.len = INTCAST(str_addr - stringpool.free);
dst->str.addr = (char *)stringpool.free;
stringpool.free = str_addr;
/* If available, update the cache information for this newly created mval to hopefully
* give it a head start on its next usage. Note that we can only copy over the cache info
* for the prefix. We cannot include information for the 'expression' except where it starts
* because the expression could itself contain delimiters that would be found on a rescan.
*/
if (0 < cpy_cache_lines)
{
pfnpc = cfnpc; /* pointer for src mval's cache */
do
{
cfnpc = (TREF(fnpca)).fnpcsteal; /* Next cache element to steal */
if ((TREF(fnpca)).fnpcmax < cfnpc)
cfnpc = &(TREF(fnpca)).fnpcs[0];
(TREF(fnpca)).fnpcsteal = cfnpc + 1; /* -> next element to steal */
} while (cfnpc == pfnpc); /* Make sure we don't step on ourselves */
cfnpc->last_str = dst->str; /* Save validation info */
cfnpc->delim = delim;
cfnpc->npcs = cpy_cache_lines;
dst->fnpc_indx = cfnpc->indx + 1; /* Save where we are putting this element
* (1 based index in mval so 0 isn't so common)
*/
memcpy(&cfnpc->pstart[0], &pfnpc->pstart[0], (cfnpc->npcs + 1) * SIZEOF(unsigned int));
} else
boolean_t gvcst_queryget2(mval *val, unsigned char *sn_ptr)
{
blk_hdr_ptr_t bp;
boolean_t found, two_histories;
enum cdb_sc status;
int rsiz, key_size, data_len;
rec_hdr_ptr_t rp;
srch_blk_status *bh;
srch_hist *rt_history;
unsigned short temp_ushort;
int tmp_cmpc;
DEBUG_ONLY(unsigned char *save_strp = NULL);
T_BEGIN_READ_NONTP_OR_TP(ERR_GVQUERYGETFAIL);
assert((CDB_STAGNATE > t_tries) || cs_addrs->now_crit); /* we better hold crit in the final retry (TP & non-TP) */
for (;;)
{
two_histories = FALSE;
#if defined(DEBUG) && defined(UNIX)
if (gtm_white_box_test_case_enabled && (WBTEST_ANTIFREEZE_GVQUERYGETFAIL == gtm_white_box_test_case_number))
{
status = cdb_sc_blknumerr;
t_retry(status);
continue;
}
#endif
if (cdb_sc_normal == (status = gvcst_search(gv_currkey, 0)))
{
found = TRUE;
bh = &gv_target->hist.h[0];
rp = (rec_hdr_ptr_t)(bh->buffaddr + bh->curr_rec.offset);
bp = (blk_hdr_ptr_t)bh->buffaddr;
if (rp >= (rec_hdr_ptr_t)CST_TOB(bp))
{
two_histories = TRUE;
rt_history = gv_target->alt_hist;
status = gvcst_rtsib(rt_history, 0);
if (cdb_sc_endtree == status) /* end of tree */
{
found = FALSE;
two_histories = FALSE; /* second history not valid */
} else if (cdb_sc_normal != status)
{
t_retry(status);
continue;
} else
{
bh = &rt_history->h[0];
if (cdb_sc_normal != (status = gvcst_search_blk(gv_currkey, bh)))
{
t_retry(status);
continue;
}
rp = (rec_hdr_ptr_t)(bh->buffaddr + bh->curr_rec.offset);
bp = (blk_hdr_ptr_t)bh->buffaddr;
}
}
/* !found indicates that the end of tree has been reached (see call to
* gvcst_rtsib). If there is no more tree, don't bother doing expansion.
*/
if (found)
{
status = gvcst_expand_key((blk_hdr_ptr_t)bh->buffaddr, (int4)((sm_uc_ptr_t)rp - bh->buffaddr),
gv_altkey);
if (cdb_sc_normal != status)
{
t_retry(status);
continue;
}
key_size = gv_altkey->end + 1;
GET_RSIZ(rsiz, rp);
data_len = rsiz + EVAL_CMPC(rp) - SIZEOF(rec_hdr) - key_size;
if (data_len < 0 || (sm_uc_ptr_t)rp + rsiz > (sm_uc_ptr_t)bp + ((blk_hdr_ptr_t)bp)->bsiz)
{
assert(CDB_STAGNATE > t_tries);
t_retry(cdb_sc_rmisalign1);
continue;
}
ENSURE_STP_FREE_SPACE(data_len);
DEBUG_ONLY (
if (!save_strp)
save_strp = stringpool.free);
assert(stringpool.top - stringpool.free >= data_len);
memcpy(stringpool.free, (sm_uc_ptr_t)rp + rsiz - data_len, data_len);
/* Assumption: t_end/tp_hist will never cause stp_gcol() call BYPASSOK */
}
if (!dollar_tlevel)
{
if ((trans_num)0 == t_end(&gv_target->hist, !two_histories ? NULL : rt_history, TN_NOT_SPECIFIED))
continue;
} else
{
status = tp_hist(!two_histories ? NULL : rt_history);
if (cdb_sc_normal != status)
{
t_retry(status);
continue;
}
}
if (found)
{
DEBUG_ONLY(assert(save_strp == stringpool.free));
/* Process val first. Already copied to string pool. */
val->mvtype = MV_STR;
val->str.addr = (char *)stringpool.free;
val->str.len = data_len;
stringpool.free += data_len;
INCR_GVSTATS_COUNTER(cs_addrs, cs_addrs->nl, n_get, 1);
}
return found;
}
t_retry(status);
}
void op_fnzdate(mval *src, mval *fmt, mval *mo_str, mval *day_str, mval *dst)
{
unsigned char ch, *fmtptr, *fmttop, *i, *outptr, *outtop, *outpt1;
int cent, day, dow, month, nlen, outlen, time, year;
unsigned int n;
mval temp_mval;
static readonly unsigned char montab[] = {31,28,31,30,31,30,31,31,30,31,30,31};
static readonly unsigned char default1[] = DEFAULT1;
static readonly unsigned char default2[] = DEFAULT2;
static readonly unsigned char default3[] = DEFAULT3;
static readonly unsigned char defmonlst[] = "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC";
static readonly unsigned char defdaylst[] = "SUNMONTUEWEDTHUFRISAT";
#if defined(BIGENDIAN)
static readonly int comma = (((int)',') << 24);
#else
static readonly int comma = ',';
#endif
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
MV_FORCE_NUM(src);
MV_FORCE_STR(fmt);
MV_FORCE_STR(mo_str);
MV_FORCE_STR(day_str);
ENSURE_STP_FREE_SPACE(ZDATE_MAX_LEN);
time = 0;
outlen = src->str.len;
if ((src->mvtype & MV_STR) && (src->mvtype & MV_NUM_APPROX))
{
for (outptr = (unsigned char *)src->str.addr, outtop = outptr + outlen; outptr < outtop; )
{
if (',' == *outptr++)
{
outlen = outptr - (unsigned char *)src->str.addr - 1;
temp_mval.mvtype = MV_STR;
temp_mval.str.addr = (char *)outptr;
temp_mval.str.len = INTCAST(outtop - outptr);
s2n(&temp_mval);
time = MV_FORCE_INTD(&temp_mval);
if ((0 > time) || (MAX_TIME < time))
rts_error(VARLSTCNT(4) ERR_ZDATEBADTIME, 2, temp_mval.str.len, temp_mval.str.addr);
break;
}
}
}
day = (int)MV_FORCE_INTD(src);
if ((MAX_DATE < day) || (MIN_DATE > day))
{
MV_FORCE_STR(src);
rts_error(VARLSTCNT(4) ERR_ZDATEBADDATE, 2, outlen, src->str.addr);
}
day += DAYS_MOST_YEARS;
dow = ((day + ADJUST_TO_1900) % DAYS_IN_WEEK) + 1;
for (cent = DAYS_BASE_TO_1900, n = ADJUST_TO_1900; cent < day; cent += DAYS_IN_CENTURY, n++)
day += (0 < (n % COMMON_LEAP_CYCLE));
year = day / DAYS_IN_FOUR_YEARS;
day = day - (year * DAYS_IN_FOUR_YEARS);
year = (year * COMMON_LEAP_CYCLE) + BASE_YEAR;
if (DAYS_BEFORE_LEAP == day)
{
day = MIN_DAYS_IN_MONTH + 1;
month = 2;
} else
{
if (DAYS_BEFORE_LEAP < day)
day--;
month = day / DAYS_MOST_YEARS;
year += month;
day -= (month * DAYS_MOST_YEARS);
for (i = montab; day >= *i; day -= *i++)
;
month = (int)((i - montab)) + 1;
day++;
assert((0 < month) && (MONTHS_IN_YEAR >= month));
}
if ((0 == fmt->str.len) || ((1 == fmt->str.len) && ('1' == *fmt->str.addr)))
{
if (!TREF(zdate_form) || ((1 == TREF(zdate_form)) && (PIVOT_MILLENIUM > year)))
{
fmtptr = default1;
fmttop = fmtptr + STR_LIT_LEN(DEFAULT1);
} else
{
fmtptr = default3;
fmttop = fmtptr + STR_LIT_LEN(DEFAULT3);
}
} else if ((1 == fmt->str.len) && ('2' == *fmt->str.addr))
{
fmtptr = default2;
fmttop = fmtptr + STR_LIT_LEN(DEFAULT2);
} else
{
fmtptr = (unsigned char *)fmt->str.addr;
fmttop = fmtptr + fmt->str.len;
}
outlen = (int)(fmttop - fmtptr);
if (outlen >= ZDATE_MAX_LEN)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
outptr = stringpool.free;
outtop = outptr + ZDATE_MAX_LEN;
temp_mval.mvtype = MV_STR;
assert(0 <= time);
nlen = 0;
while (fmtptr < fmttop)
{
switch (ch = *fmtptr++) /* NOTE assignment */
{
case '/':
case ':':
case '.':
case ',':
case '-':
case ' ':
case '*':
case '+':
case ';':
*outptr++ = ch;
continue;
case 'M':
ch = *fmtptr++;
if ('M' == ch)
{
n = month;
nlen = 2;
break;
}
if (('O' != ch) || ('N' != *fmtptr++))
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
if (0 == mo_str->str.len)
{
temp_mval.str.addr = (char *)&defmonlst[(month - 1) * LEN_OF_3_CHAR_ABBREV];
temp_mval.str.len = LEN_OF_3_CHAR_ABBREV;
nlen = -LEN_OF_3_CHAR_ABBREV;
} else
{
UNICODE_ONLY(gtm_utf8_mode ? op_fnp1(mo_str, comma, month, &temp_mval) :
op_fnzp1(mo_str, comma, month, &temp_mval));
VMS_ONLY(op_fnzp1(mo_str, comma, month, &temp_mval, TRUE));
nlen = -temp_mval.str.len;
outlen += - LEN_OF_3_CHAR_ABBREV - nlen;
if (outlen >= ZDATE_MAX_LEN)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
}
break;
case 'D':
ch = *fmtptr++;
if ('D' == ch)
{
n = day;
nlen = 2;
break;
}
if (('A' != ch) || ('Y' != *fmtptr++))
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
if (0 == day_str->str.len)
{
temp_mval.str.addr = (char *)&defdaylst[(dow - 1) * LEN_OF_3_CHAR_ABBREV];
temp_mval.str.len = LEN_OF_3_CHAR_ABBREV;
nlen = -LEN_OF_3_CHAR_ABBREV;
} else
{
UNICODE_ONLY(gtm_utf8_mode ? op_fnp1(day_str, comma, dow, &temp_mval)
: op_fnzp1(day_str, comma, dow, &temp_mval));
VMS_ONLY(op_fnzp1(day_str, comma, dow, &temp_mval, TRUE));
nlen = -temp_mval.str.len;
outlen += - LEN_OF_3_CHAR_ABBREV - nlen;
if (outlen >= ZDATE_MAX_LEN)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
}
break;
case 'Y':
ch = *fmtptr++;
n = year;
if ('Y' == ch)
{
for (nlen = 2; (MAX_YEAR_DIGITS >=nlen) && fmtptr < fmttop; ++nlen, fmtptr++)
if ('Y' != *fmtptr)
break;
} else
{
if (('E' != ch) || ('A' != *fmtptr++) || ('R' != *fmtptr++))
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 4;
}
break;
case '1':
if ('2' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time / SECONDS_PER_HOUR;
n = ((n + HOURS_PER_AM_OR_PM - 1) % HOURS_PER_AM_OR_PM) + 1;
break;
case '2':
if ('4' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time / SECONDS_PER_HOUR;
break;
case '6':
if ('0' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time;
n /= MINUTES_PER_HOUR;
n %= MINUTES_PER_HOUR;
break;
case 'S':
if ('S' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
nlen = 2;
n = time % SECONDS_PER_MINUTE;
break;
case 'A':
if ('M' != *fmtptr++)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
*outptr++ = (time < (HOURS_PER_AM_OR_PM * SECONDS_PER_HOUR)) ? 'A' : 'P';
*outptr++ = 'M';
continue;
default:
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
}
if (nlen > 0)
{
outptr += nlen;
outpt1 = outptr;
while (nlen-- > 0)
{
*--outpt1 = '0' + (n % 10);
n /= 10;
}
} else
{
outpt1 = (unsigned char *)temp_mval.str.addr;
while (nlen++ < 0)
*outptr++ = *outpt1++;
}
}
if (fmtptr > fmttop)
rts_error(VARLSTCNT(1) ERR_ZDATEFMT);
dst->mvtype = MV_STR;
dst->str.addr = (char *)stringpool.free;
dst->str.len = INTCAST((char *)outptr - dst->str.addr);
stringpool.free = outptr;
return;
}
void op_fnfnumber(mval *src, mval *fmt, mval *dst)
{
mval temp, *temp_p;
unsigned char fncode, sign, *ch, *cp, *ff, *ff_top, *t;
int ct, x, y, z, xx;
boolean_t comma, paren;
error_def(ERR_FNARGINC);
error_def(ERR_FNUMARG);
assert (stringpool.free >= stringpool.base);
assert (stringpool.free <= stringpool.top);
/* assure that there is adequate space for two string forms of a number
as a local version of the src must be operated upon in order to get
a canonical number
*/
ENSURE_STP_FREE_SPACE(MAX_NUM_SIZE * 2);
/* operate on the src operand in a temp, so that
conversions are possible without destroying the source
*/
temp_p = &temp;
*temp_p = *src;
/* if the source operand is not a canonical number, force conversion
*/
MV_FORCE_STR(temp_p);
MV_FORCE_STR(fmt);
if (fmt->str.len == 0)
{
*dst = *temp_p;
return;
}
temp_p->mvtype = MV_STR;
ch = (unsigned char *)temp_p->str.addr;
ct = temp_p->str.len;
cp = stringpool.free;
fncode = 0;
for (ff = (unsigned char *)fmt->str.addr , ff_top = ff + fmt->str.len ; ff < ff_top ; )
{
switch(*ff++)
{
case '+':
fncode |= PLUS;
break;
case '-':
fncode |= MINUS;
break;
case ',':
fncode |= COMMA;
break;
case 'T':
case 't':
fncode |= TRAIL;
break;
case 'P':
case 'p':
fncode |= PAREN;
break;
default:
rts_error(VARLSTCNT(6) ERR_FNUMARG, 4, fmt->str.len, fmt->str.addr, 1, --ff);
break;
}
}
if (0 != (fncode & PAREN) && 0 != (fncode & FNERROR))
rts_error(VARLSTCNT(4) ERR_FNARGINC, 2, fmt->str.len, fmt->str.addr);
else
{
sign = 0;
paren = FALSE;
if ('-' == *ch)
{
sign = '-';
ch++;
ct--;
}
if (0 != (fncode & PAREN))
{
if ('-' == sign)
{
*cp++ = '(';
sign = 0;
paren = TRUE;
}
else *cp++ = ' ';
}
/* Only add '+' if > 0 */
if (0 != (fncode & PLUS) && 0 == sign)
{ /* Need to make into num and check for int 0 in case was preprocessed by op_fnj3() */
MV_FORCE_NUM(temp_p);
if (0 == (temp_p->mvtype & MV_INT) || 0 != temp_p->m[1])
sign = '+';
}
if (0 != (fncode & MINUS) && '-' == sign)
sign = 0;
if (0 == (fncode & TRAIL) && 0 != sign)
*cp++ = sign;
if (0 != (fncode & COMMA))
{
comma = FALSE;
for (x = 0, t = ch; '.' != *t && ++x < ct; t++) ;
z = x;
if ((y = x % 3) > 0)
{
while (y-- > 0)
*cp++ = *ch++;
comma = TRUE;
}
for ( ; x / 3 != 0 ; x -= 3, cp += 3, ch +=3)
{
if (comma)
*cp++ = ',';
else
comma = TRUE;
memcpy(cp, ch, 3);
}
if (z < ct)
{
xx = ct - z;
memcpy(cp, ch, xx);
cp += xx;
}
} else
{
memcpy(cp, ch, ct);
cp += ct;
}
if (0 != (fncode & TRAIL))
{
if (sign != 0) *cp++ = sign;
else *cp++ = ' ';
}
if (0 != (fncode & PAREN))
{
if (paren) *cp++ = ')';
else *cp++ = ' ';
}
dst->mvtype = MV_STR;
dst->str.addr = (char *)stringpool.free;
dst->str.len = INTCAST(cp - stringpool.free);
stringpool.free = cp;
return;
}
GTMASSERT;
}
void op_fngetjpi(mint jpid, mval *keyword, mval *ret)
{
out_struct out_quad;
int4 out_long, jpi_code, pid;
short index, length, slot, last_slot, out_len;
uint4 status;
char upcase[MAX_KEY_LEN];
$DESCRIPTOR(out_string, "");
error_def(ERR_BADJPIPARAM);
assert (stringpool.free >= stringpool.base);
assert (stringpool.top >= stringpool.free);
ENSURE_STP_FREE_SPACE(MAX_JPI_STRLEN);
MV_FORCE_STR(keyword);
if (keyword->str.len == 0)
rts_error(VARLSTCNT(4) ERR_BADJPIPARAM, 2, 4, "Null");
if (keyword->str.len > MAX_KEY_LEN)
rts_error(VARLSTCNT(4) ERR_BADJPIPARAM, 2, keyword->str.len, keyword->str.addr );
lower_to_upper((uchar_ptr_t)upcase, (uchar_ptr_t)keyword->str.addr, keyword->str.len);
if ((index = upcase[0] - 'A') < MIN_INDEX || index > MAX_INDEX)
rts_error(VARLSTCNT(4) ERR_BADJPIPARAM, 2, keyword->str.len, keyword->str.addr );
/* Before checking if it is a VMS JPI attribute, check if it is GT.M specific "ISPROCALIVE" attribute */
if ((keyword->str.len == STR_LIT_LEN("ISPROCALIVE")) && !memcmp(upcase, "ISPROCALIVE", keyword->str.len))
{
out_long = (0 != jpid) ? is_proc_alive(jpid, 0) : 1;
i2mval(ret, out_long);
return;
}
/* Check if it is a VMS JPI attribute */
slot = jpi_index_table[ index ].index;
last_slot = jpi_index_table[ index ].len;
jpi_code = 0;
/* future enhancement:
* (i) since keywords are sorted, we can exit the for loop if 0 < memcmp.
* (ii) also, the current comparison relies on kwd->str.len which means a C would imply CPUTIM instead of CSTIME
* or CUTIME this ambiguity should probably be removed by asking for an exact match of the full keyword
*/
for ( ; slot < last_slot ; slot++ )
{
if (jpi_param_table[ slot ].len == keyword->str.len
&& !(memcmp(jpi_param_table[ slot ].name, upcase, keyword->str.len)))
{
jpi_code = jpi_param_table[ slot ].item_code;
break;
}
}
if (!jpi_code)
rts_error(VARLSTCNT(4) ERR_BADJPIPARAM, 2, keyword->str.len, keyword->str.addr);
assert (jpid >= 0);
switch( jpi_code )
{
/* **** This is a fall through for all codes that require a string returned **** */
case JPI$_ACCOUNT:
case JPI$_AUTHPRIV:
case JPI$_CLINAME:
case JPI$_CURPRIV:
case JPI$_IMAGNAME:
case JPI$_IMAGPRIV:
case JPI$_PRCNAM:
case JPI$_PROCPRIV:
case JPI$_TABLENAME:
case JPI$_TERMINAL:
case JPI$_USERNAME:
out_string.dsc$a_pointer = stringpool.free;
out_string.dsc$w_length = MAX_JPI_STRLEN;
if ((status = lib$getjpi( &jpi_code
,&jpid
,0
,0
,&out_string
,&out_len )) != SS$_NORMAL)
{ rts_error(VARLSTCNT(1) status ); /* need a more specific GTM error message here and below */
}
ret->str.addr = stringpool.free;
ret->str.len = out_len;
ret->mvtype = MV_STR;
stringpool.free += out_len;
assert (stringpool.top >= stringpool.free);
assert (stringpool.free >= stringpool.base);
return;
case JPI$_LOGINTIM:
{ int4 days;
int4 seconds;
if ((status = lib$getjpi( &jpi_code
,&jpid
,0
,&out_quad
,0
,0 )) != SS$_NORMAL)
{ rts_error(VARLSTCNT(1) status );
}
if ((status = lib$day( &days
,&out_quad
,&seconds)) != SS$_NORMAL)
{ rts_error(VARLSTCNT(1) status );
}
days += DAYS;
seconds /= CENTISECONDS;
ret->str.addr = stringpool.free;
stringpool.free = i2s(&days);
*stringpool.free++ = ',';
stringpool.free = i2s(&seconds);
ret->str.len = (char *) stringpool.free - ret->str.addr;
ret->mvtype = MV_STR;
return;
}
default:
if ((status = lib$getjpi( &jpi_code
,&jpid
,0
,&out_long
,0
,0 )) != SS$_NORMAL)
{ rts_error(VARLSTCNT(1) status );
}
i2mval(ret, out_long) ;
return;
}
}
void op_zlink(mval *v, mval *quals)
{
struct FAB srcfab;
struct NAM srcnam, objnam;
struct XABDAT srcxab, objxab;
boolean_t compile, expdir, libr, obj_found, src_found;
short flen;
unsigned short type;
unsigned char srccom[MAX_FN_LEN], srcnamebuf[MAX_FN_LEN], objnamebuf[MAX_FN_LEN], objnamelen, srcnamelen,ver[6];
unsigned char objcom[MAX_FN_LEN], list_file[MAX_FN_LEN], ceprep_file[MAX_FN_LEN], *fname;
zro_ent *srcdir, *objdir;
mstr srcstr, objstr, version;
mval qualifier;
unsigned status, srcfnb;
uint4 lcnt, librindx, qlf;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
MV_FORCE_STR(v);
if (MAX_FN_LEN < v->str.len)
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, MIN(UCHAR_MAX, v->str.len), v->str.addr, ERR_FILENAMETOOLONG);
version.len = 0;
srcdir = objdir = 0;
version.addr = ver;
libr = FALSE;
obj_fab = cc$rms_fab;
if (quals)
{
MV_FORCE_STR(quals);
srcfab = cc$rms_fab;
srcfab.fab$l_fna = v->str.addr;
srcfab.fab$b_fns = v->str.len;
srcfab.fab$l_nam = &srcnam;
srcnam = cc$rms_nam;
srcnam.nam$l_esa = srcnamebuf;
srcnam.nam$b_ess = SIZEOF(srcnamebuf);
srcnam.nam$b_nop = NAM$M_SYNCHK;
status = sys$parse(&srcfab);
if (!(status & 1))
rts_error(VARLSTCNT(9) ERR_ZLINKFILE, 2, v->str.len, v->str.addr,
ERR_FILEPARSE, 2, v->str.len, v->str.addr, status);
if (srcnam.nam$l_fnb & NAM$M_WILDCARD)
rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, v->str.len, v->str.addr,
ERR_WILDCARD, 2, v->str.len, v->str.addr);
srcfnb = srcnam.nam$l_fnb;
expdir = (srcfnb & (NAM$M_NODE | NAM$M_EXP_DEV | NAM$M_EXP_DIR));
if (srcfnb & NAM$M_EXP_VER)
{
memcpy(version.addr, srcnam.nam$l_ver, srcnam.nam$b_ver);
version.len = srcnam.nam$b_ver;
}
if (expdir)
{
if (version.len)
flen = srcnam.nam$b_esl - srcnam.nam$b_type - version.len;
else
flen = srcnam.nam$b_esl - srcnam.nam$b_type - 1; /* semicolon is put in by default */
fname = srcnam.nam$l_esa;
} else
{
flen = srcnam.nam$b_name;
fname = srcnam.nam$l_name;
}
ENSURE_STP_FREE_SPACE(flen);
memcpy(stringpool.free, fname, flen);
dollar_zsource.str.addr = stringpool.free;
dollar_zsource.str.len = flen;
stringpool.free += flen;
if (srcfnb & NAM$M_EXP_TYPE)
{
if ((SIZEOF(DOTOBJ) - 1 == srcnam.nam$b_type) &&
!MEMCMP_LIT(srcnam.nam$l_type, DOTOBJ))
{
type = OBJ;
objstr.addr = srcnam.nam$l_esa;
objstr.len = srcnam.nam$b_esl;
} else
{
type = SRC;
memcpy(srcnamebuf, dollar_zsource.str.addr, flen);
memcpy(&srcnamebuf[flen], srcnam.nam$l_type, srcnam.nam$b_type);
memcpy(&srcnamebuf[flen + srcnam.nam$b_type],
version.addr, version.len);
srcnamelen = flen + srcnam.nam$b_type + version.len;
srcnamebuf[srcnamelen] = 0;
srcstr.addr = srcnamebuf;
srcstr.len = srcnamelen;
memcpy(objnamebuf, dollar_zsource.str.addr, flen);
memcpy(&objnamebuf[flen], DOTOBJ, SIZEOF(DOTOBJ));
objnamelen = flen + SIZEOF(DOTOBJ) - 1;
objstr.addr = objnamebuf;
objstr.len = objnamelen;
}
} else
{
type = NOTYPE;
memcpy(srcnamebuf, dollar_zsource.str.addr, flen);
memcpy(&srcnamebuf[flen], DOTM, SIZEOF(DOTM));
srcnamelen = flen + SIZEOF(DOTM) - 1;
memcpy(objnamebuf, dollar_zsource.str.addr, flen);
MEMCPY_LIT(&objnamebuf[flen], DOTOBJ);
memcpy(&objnamebuf[flen + SIZEOF(DOTOBJ) - 1], version.addr, version.len);
objnamelen = flen + SIZEOF(DOTOBJ) + version.len - 1;
objnamebuf[objnamelen] = 0;
srcstr.addr = srcnamebuf;
srcstr.len = srcnamelen;
objstr.addr = objnamebuf;
objstr.len = objnamelen;
}
if (!expdir)
{
if (OBJ == type)
{
zro_search(&objstr, &objdir, 0, 0);
if (!objdir)
rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, dollar_zsource.str.len, dollar_zsource.str.addr,
ERR_FILENOTFND, 2, dollar_zsource.str.len, dollar_zsource.str.addr);
} else if (SRC == type)
{
zro_search(&objstr, &objdir, &srcstr, &srcdir);
if (!srcdir)
rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf,
ERR_FILENOTFND, 2, srcnamelen, srcnamebuf);
} else
{
zro_search(&objstr, &objdir, &srcstr, &srcdir);
if (!objdir && !srcdir)
rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, dollar_zsource.str.len, dollar_zsource.str.addr,
ERR_FILENOTFND, 2, dollar_zsource.str.len, dollar_zsource.str.addr);
}
}
} else
{
expdir = FALSE;
type = NOTYPE;
flen = v->str.len;
memcpy(srcnamebuf, v->str.addr, flen);
MEMCPY_LIT(&srcnamebuf[flen], DOTM);
srcnamelen = flen + SIZEOF(DOTM) - 1;
if ('%' == srcnamebuf[0])
srcnamebuf[0] = '_';
memcpy(objnamebuf, srcnamebuf, flen);
MEMCPY_LIT(&objnamebuf[flen], DOTOBJ);
objnamelen = flen + SIZEOF(DOTOBJ) - 1;
srcstr.addr = srcnamebuf;
srcstr.len = srcnamelen;
objstr.addr = objnamebuf;
objstr.len = objnamelen;
zro_search(&objstr, &objdir, &srcstr, &srcdir);
if (!objdir && !srcdir)
rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, v->str.len, v->str.addr,
ERR_FILENOTFND, 2, v->str.len, v->str.addr);
qualifier.mvtype = MV_STR;
qualifier.str = TREF(dollar_zcompile);
quals = &qualifier;
}
if (OBJ == type)
{
obj_fab.fab$b_fac = FAB$M_GET;
obj_fab.fab$b_shr = FAB$M_SHRGET;
if (NULL != objdir)
{
if (ZRO_TYPE_OBJLIB == objdir->type)
libr = TRUE;
else
{
srcfab.fab$l_dna = objdir->str.addr;
srcfab.fab$b_dns = objdir->str.len;
}
}
for (lcnt = 0; lcnt < MAX_FILE_OPEN_TRIES; lcnt++)
{
status = (FALSE == libr) ? sys$open(&srcfab): zl_olb(&objdir->str, &objstr, &librindx);
if (RMS$_FLK != status)
break;
hiber_start(WAIT_FOR_FILE_TIME);
}
if (FALSE == (status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, dollar_zsource.str.len, dollar_zsource.str.addr, status);
if (FALSE == ((FALSE == libr) ? incr_link(&srcfab, libr) : incr_link(&librindx, libr)))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, dollar_zsource.str.len, dollar_zsource.str.addr, ERR_VERSION);
status = (FALSE == libr) ? sys$close(&srcfab) : lbr$close(&librindx);
if (FALSE == (status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, dollar_zsource.str.len, dollar_zsource.str.addr, status);
} else /* either NO type or SOURCE type */
{
src_found = obj_found = compile = FALSE;
srcfab = obj_fab = cc$rms_fab;
obj_fab.fab$l_xab = &objxab;
srcxab = objxab = cc$rms_xabdat;
obj_fab.fab$l_nam = &objnam;
srcnam = objnam = cc$rms_nam;
obj_fab.fab$l_fna = objnamebuf;
obj_fab.fab$b_fns = objnamelen;
obj_fab.fab$b_fac = FAB$M_GET;
obj_fab.fab$b_shr = FAB$M_SHRGET;
objnam.nam$l_esa = objcom;
objnam.nam$b_ess = SIZEOF(objcom);
srcfab.fab$l_nam = &srcnam;
srcfab.fab$l_xab = &srcxab;
srcfab.fab$l_fna = srcnamebuf;
srcfab.fab$b_fns = srcnamelen;
srcfab.fab$b_fac = FAB$M_GET;
srcfab.fab$b_shr = FAB$M_SHRGET;
srcnam.nam$l_esa = srccom;
srcnam.nam$b_ess = SIZEOF(srccom);
cmd_qlf.object_file.str.addr = objcom;
cmd_qlf.object_file.str.len = 255;
cmd_qlf.list_file.str.addr = list_file;
cmd_qlf.list_file.str.len = 255;
cmd_qlf.ceprep_file.str.addr = ceprep_file;
cmd_qlf.ceprep_file.str.len = 255;
if (srcdir && srcdir->str.len)
{
srcfab.fab$l_dna = srcdir->str.addr;
srcfab.fab$b_dns = srcdir->str.len;
}
if (objdir && objdir->str.len)
{
if (ZRO_TYPE_OBJLIB == objdir->type)
libr = TRUE;
else
{
obj_fab.fab$l_dna = objdir->str.addr;
obj_fab.fab$b_dns = objdir->str.len;
}
}
if (SRC != type)
{
if (!expdir && !objdir)
obj_found = FALSE;
else if (!libr)
{
for (lcnt = 0; lcnt < MAX_FILE_OPEN_TRIES; lcnt++)
{
status = sys$open(&obj_fab);
if (RMS$_FLK != status)
break;
hiber_start(WAIT_FOR_FILE_TIME);
}
if (!(status & 1))
{
if (RMS$_FNF == status)
obj_found = FALSE;
else
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, objnamelen, objnamebuf, status);
} else
obj_found = TRUE;
} else
{
status = zl_olb(&objdir->str, &objstr, &librindx);
if (status)
obj_found = TRUE;
}
} else
compile = TRUE;
if (!expdir && !srcdir)
src_found = FALSE;
else
{
for (lcnt = 0; lcnt < MAX_FILE_OPEN_TRIES; lcnt++)
{
status = sys$open(&srcfab);
if (RMS$_FLK != status)
break;
hiber_start(WAIT_FOR_FILE_TIME);
}
if (!(status & 1))
{
if ((RMS$_FNF == status) && (SRC != type))
src_found = FALSE;
else
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf, status);
} else
{
src_found = TRUE;
if (SRC == type)
{
status = sys$close(&srcfab);
if (!(status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf, status);
}
}
}
if (SRC != type)
{
if (src_found)
{
if (obj_found)
{
if (QUADCMP(&srcxab.xab$q_rdt, &objxab.xab$q_rdt))
{
status = sys$close(&obj_fab);
obj_fab = cc$rms_fab;
if (!(status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, objnamelen, objnamebuf, status);
compile = TRUE;
}
} else
compile = TRUE;
status = sys$close(&srcfab);
if (!(status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf, status);
} else if (!obj_found)
rts_error(VARLSTCNT(8) ERR_ZLINKFILE, 2, objnamelen, objnamebuf,
ERR_FILENOTFND, 2, objnamelen, objnamebuf);
}
if (compile)
{
zl_cmd_qlf(&quals->str, &cmd_qlf);
if (!MV_DEFINED(&cmd_qlf.object_file))
{
objnam.nam$b_nop = NAM$M_SYNCHK;
status = sys$parse(&obj_fab);
if (!(status & 1))
rts_error(VARLSTCNT(4) ERR_FILEPARSE, 2, obj_fab.fab$b_fns, obj_fab.fab$l_fna);
cmd_qlf.object_file.mvtype = MV_STR;
cmd_qlf.object_file.str.len = objnam.nam$b_esl - objnam.nam$b_ver;
}
qlf = cmd_qlf.qlf;
if (!(cmd_qlf.qlf & CQ_OBJECT) && (SRC != type))
{
cmd_qlf.qlf = glb_cmd_qlf.qlf;
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf, ERR_ZLNOOBJECT);
}
zlcompile(srcnam.nam$b_esl, srcnam.nam$l_esa);
if ((SRC == type) && !(qlf & CQ_OBJECT))
return;
}
status = libr ? incr_link(&librindx, libr) : incr_link(&obj_fab, libr);
if (!status) /* due only to version mismatch, so recompile */
{
if (!libr)
{
status = sys$close(&obj_fab);
obj_fab = cc$rms_fab;
} else
status = lbr$close(&librindx);
if (!(status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, objstr.len, objstr.addr, status);
if (compile)
GTMASSERT;
if (!src_found)
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf, ERR_VERSION);
zl_cmd_qlf(&quals->str, &cmd_qlf);
if (!MV_DEFINED(&cmd_qlf.object_file))
{
objnam.nam$b_nop = NAM$M_SYNCHK;
status = sys$parse(&obj_fab);
if (!(status & 1))
rts_error(VARLSTCNT(4) ERR_FILEPARSE, 2, obj_fab.fab$b_fns, obj_fab.fab$l_fna);
cmd_qlf.object_file.mvtype = MV_STR;
cmd_qlf.object_file.str.len = objnam.nam$b_esl - objnam.nam$b_ver;
}
if (!(cmd_qlf.qlf & CQ_OBJECT) && (SRC != type))
{
cmd_qlf.qlf = glb_cmd_qlf.qlf;
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, srcnamelen, srcnamebuf, ERR_ZLNOOBJECT);
}
zlcompile(srcnam.nam$b_esl, srcnam.nam$l_esa);
if (!incr_link(&obj_fab, libr))
GTMASSERT;
}
if (!libr)
{
status = sys$close(&obj_fab);
obj_fab = cc$rms_fab;
} else
status = lbr$close(&librindx);
if (!(status & 1))
rts_error(VARLSTCNT(5) ERR_ZLINKFILE, 2, objstr.len, objstr.addr, status);
}
return;
}
void op_zprevious(mval *v)
{
int4 n;
int min_reg_index, reg_index, res;
mname_entry gvname;
mval tmpmval, *datamval;
enum db_acc_method acc_meth;
boolean_t found, ok_to_change_currkey;
gd_binding *gd_map_start, *map, *prev_map;
gd_addr *gd_targ;
gvnh_reg_t *gvnh_reg;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(gv_currkey->prev || !TREF(gv_last_subsc_null));
if (gv_currkey->prev)
{ /* If last subscript is a NULL subscript, modify gv_currkey such that a gvcst_search of the resulting gv_currkey
* will find the last available subscript. But in case of dba_usr, (the custom implementation of $ZPREVIOUS which
* is overloaded for DDP now but could be more in the future) it is better to hand over gv_currkey as it is so
* the custom implementation can decide what to do with it.
*/
acc_meth = REG_ACC_METH(gv_cur_region);
ok_to_change_currkey = (dba_usr != acc_meth);
if (TREF(gv_last_subsc_null) && ok_to_change_currkey)
{ /* Replace the last subscript with the highest possible subscript value i.e. the byte sequence
* 0xFF (STR_SUB_MAXVAL), 0xFF, 0xFF ... as much as possible i.e. until gv_currkey->top permits.
* This subscript is guaranteed to be NOT present in the database since a user who tried to set this
* exact subscripted global would have gotten a GVSUBOFLOW error (because GT.M sets aside a few bytes
* of padding space). And yet this is guaranteed to collate AFTER any existing subscript. Therefore we
* can safely do a gvcst_zprevious on this key to get at the last existing key in the database.
*
* With standard null collation, the last subscript will be 0x01
* Without standard null collation, the last subscript will be 0xFF
* Assert that is indeed the case as this will be used to restore the replaced subscript at the end.
*/
assert(gv_cur_region->std_null_coll || (STR_SUB_PREFIX == gv_currkey->base[gv_currkey->prev]));
assert(!gv_cur_region->std_null_coll || (SUBSCRIPT_STDCOL_NULL == gv_currkey->base[gv_currkey->prev]));
assert(KEY_DELIMITER == gv_currkey->base[gv_currkey->prev + 1]);
assert(gv_currkey->end == gv_currkey->prev + 2);
assert(gv_currkey->end < gv_currkey->top); /* need "<" (not "<=") to account for terminating 0x00 */
GVZPREVIOUS_APPEND_MAX_SUBS_KEY(gv_currkey, gv_target);
}
if ((dba_bg == acc_meth) || (dba_mm == acc_meth))
{
gvnh_reg = TREF(gd_targ_gvnh_reg);
if (NULL == gvnh_reg)
found = (gv_target->root ? gvcst_zprevious() : FALSE);
else
INVOKE_GVCST_SPR_XXX(gvnh_reg, found = gvcst_spr_zprevious());
} else if (dba_cm == acc_meth)
found = gvcmx_zprevious();
else
found = gvusr_zprevious();
v->mvtype = 0; /* so stp_gcol (if invoked below) can free up space currently occupied (BYPASSOK)
* by this to-be-overwritten mval */
if (found)
{
gv_altkey->prev = gv_currkey->prev;
if (!IS_STP_SPACE_AVAILABLE(MAX_KEY_SZ))
{
if ((0xFF != gv_altkey->base[gv_altkey->prev])
&& (SUBSCRIPT_STDCOL_NULL != gv_altkey->base[gv_altkey->prev]))
n = MAX_FORM_NUM_SUBLEN;
else
{
n = gv_altkey->end - gv_altkey->prev;
assert(n > 0);
}
v->str.len = 0; /* so stp_gcol (if invoked) can free up space currently occupied by this (BYPASSOK)
* to-be-overwritten mval */
ENSURE_STP_FREE_SPACE(n);
}
v->str.addr = (char *)stringpool.free;
v->str.len = MAX_KEY_SZ;
stringpool.free = gvsub2str(&gv_altkey->base[gv_altkey->prev], &(v->str), FALSE);
v->str.len = INTCAST((char *)stringpool.free - v->str.addr);
assert(v->str.addr < (char *)stringpool.top && v->str.addr >= (char *)stringpool.base);
assert(v->str.addr + v->str.len <= (char *)stringpool.top &&
v->str.addr + v->str.len >= (char *)stringpool.base);
} else
v->str.len = 0;
v->mvtype = MV_STR; /* initialize mvtype now that mval has been otherwise completely set up */
if (TREF(gv_last_subsc_null) && ok_to_change_currkey)
{ /* Restore gv_currkey to what it was at function entry time */
gv_currkey->base[gv_currkey->prev + 1] = KEY_DELIMITER;
if (gv_cur_region->std_null_coll)
gv_currkey->base[gv_currkey->prev] = SUBSCRIPT_STDCOL_NULL;
assert(gv_cur_region->std_null_coll || (STR_SUB_PREFIX == gv_currkey->base[gv_currkey->prev]));
gv_currkey->end = gv_currkey->prev + 2;
gv_currkey->base[gv_currkey->end] = KEY_DELIMITER;
}
assert(KEY_DELIMITER == gv_currkey->base[gv_currkey->end]);
} else
{ /* the following section is for $ZPREVIOUS(^gname) */
assert(2 <= gv_currkey->end);
assert(gv_currkey->end < (MAX_MIDENT_LEN + 2)); /* until names are not in midents */
assert(KEY_DELIMITER == gv_currkey->base[gv_currkey->end]);
assert(KEY_DELIMITER == gv_currkey->base[gv_currkey->end - 1]);
gd_targ = TREF(gd_targ_addr);
gd_map_start = gd_targ->maps;
map = gv_srch_map(gd_targ, (char *)&gv_currkey->base[0], gv_currkey->end - 1);
assert(map > (gd_map_start + 1));
/* If ^gname starts at "map" start search from map-1 since $ZPREVIOUS(^gname) is sought */
BACK_OFF_ONE_MAP_ENTRY_IF_EDGECASE(gv_currkey->base, gv_currkey->end - 1, map);
found = FALSE;
/* The first map entry corresponds to local locks. The second map entry does not contain any globals.
* Therefore, any search for globals needs to only look after these maps. Hence the "gd_map_start + 1" below.
*/
for ( ; map > gd_map_start + 1; map = prev_map)
{
prev_map = map - 1;
gv_cur_region = map->reg.addr;
if (!gv_cur_region->open)
gv_init_reg(gv_cur_region);
change_reg();
acc_meth = REG_ACC_METH(gv_cur_region);
/* search region, entries in directory tree could have empty GVT in which case move on to previous entry */
for ( ; ; )
{
assert(0 == gv_currkey->prev); /* or else gvcst_zprevious could get confused */
if ((dba_bg == acc_meth) || (dba_mm == acc_meth))
{
gv_target = cs_addrs->dir_tree;
found = gvcst_zprevious();
} else if (dba_cm == acc_meth)
found = gvcmx_zprevious();
else
found = gvusr_zprevious();
if ('#' == gv_altkey->base[0]) /* don't want to give any hidden ^#* global, e.g "^#t" */
found = FALSE;
if (!found)
break;
assert(1 < gv_altkey->end);
assert(gv_altkey->end < (MAX_MIDENT_LEN + 2)); /* until names are not in midents */
res = memcmp(gv_altkey->base, prev_map->gvkey.addr, gv_altkey->end);
assert((0 != res) || (gv_altkey->end <= prev_map->gvkey_len));
if (0 > res)
{ /* The global name we found is less than the maximum value in the previous map
* so this name is not part of the current map for sure. Move on to previous map.
*/
found = FALSE;
break;
}
gvname.var_name.addr = (char *)gv_altkey->base;
gvname.var_name.len = gv_altkey->end - 1;
if (dba_cm == acc_meth)
break;
COMPUTE_HASH_MNAME(&gvname);
GV_BIND_NAME_AND_ROOT_SEARCH(gd_targ, &gvname, gvnh_reg); /* updates "gv_currkey" */
assert((NULL != gvnh_reg->gvspan) || (gv_cur_region == map->reg.addr));
if (NULL != gvnh_reg->gvspan)
{ /* gv_target would NOT have been initialized by GV_BIND_NAME in this case.
* So finish that initialization.
*/
datamval = &tmpmval;
/* The below macro finishes the task of GV_BIND_NAME_AND_ROOT_SEARCH
* (e.g. setting gv_cur_region for spanning globals)
*/
GV_BIND_SUBSNAME_IF_GVSPAN(gvnh_reg, gd_targ, gv_currkey, gvnh_reg->gd_reg);
op_gvdata(datamval);
if (MV_FORCE_INT(datamval))
break;
} else
{ /* else gv_target->root would have been initialized by GV_BIND_NAME_AND_ROOT_SEARCH */
if ((0 != gv_target->root) && (0 != gvcst_data()))
break;
}
}
if (found)
break;
/* If previous map corresponding to a spanning global, then do not update gv_currkey as that would
* effectively cause the spanning global to be skipped. If gvkey_len == gvname_len + 1 it is NOT
* a spanning global map entry.
*/
assert(prev_map->gvkey_len >= (prev_map->gvname_len + 1));
if ((prev_map > (gd_map_start + 1)) && (prev_map->gvkey_len == (prev_map->gvname_len + 1)))
{
assert(strlen(prev_map->gvkey.addr) == prev_map->gvname_len);
gv_currkey->end = prev_map->gvname_len + 1;
assert(gv_currkey->end <= (MAX_MIDENT_LEN + 1));
memcpy(gv_currkey->base, prev_map->gvkey.addr, gv_currkey->end);
assert(KEY_DELIMITER == gv_currkey->base[gv_currkey->end - 1]);
gv_currkey->base[gv_currkey->end] = KEY_DELIMITER;
assert(gv_currkey->top > gv_currkey->end); /* ensure we are within allocated bounds */
}
}
/* Reset gv_currkey as we have potentially skipped one or more regions so we no
* longer can expect gv_currkey/gv_cur_region/gv_target to match each other.
*/
gv_currkey->end = 0;
gv_currkey->base[0] = KEY_DELIMITER;
v->mvtype = 0; /* so stp_gcol (if invoked below) can free up space currently occupied (BYPASSOK)
* by this to-be-overwritten mval */
if (found)
{
if (!IS_STP_SPACE_AVAILABLE(gvname.var_name.len + 1))
{
v->str.len = 0; /* so stp_gcol ignores otherwise incompletely setup mval (BYPASSOK) */
INVOKE_STP_GCOL(gvname.var_name.len + 1);
}
v->str.addr = (char *)stringpool.free;
*stringpool.free++ = '^';
memcpy(stringpool.free, gvname.var_name.addr, gvname.var_name.len);
stringpool.free += gvname.var_name.len;
v->str.len = gvname.var_name.len + 1;
assert(v->str.addr < (char *)stringpool.top && v->str.addr >= (char *)stringpool.base);
assert(v->str.addr + v->str.len <= (char *)stringpool.top &&
v->str.addr + v->str.len >= (char *)stringpool.base);
} else
v->str.len = 0;
v->mvtype = MV_STR; /* initialize mvtype now that mval has been otherwise completely set up */
/* No need to restore gv_currkey (to what it was at function entry) as it is already set to NULL */
}
return;
}
int m_write(void)
{
char *cp;
int lnx;
mval lit;
mstr *msp;
oprtype *oprptr, x;
triple *litlst[128], **llptr, **ltop, **ptx, *ref, *t1;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
llptr = litlst;
ltop = 0;
*llptr = 0;
for (;;)
{
devctlexp = FALSE;
switch (TREF(window_token))
{
case TK_ASTERISK:
advancewindow();
if (EXPR_FAIL == expr(&x, MUMPS_INT))
return FALSE;
assert(TRIP_REF == x.oprclass);
ref = newtriple(OC_WTONE);
ref->operand[0] = x;
STO_LLPTR((OC_ILIT == x.oprval.tref->opcode) ? ref : 0);
break;
case TK_QUESTION:
case TK_EXCLAIMATION:
case TK_HASH:
case TK_SLASH:
if (!rwformat())
return FALSE;
STO_LLPTR(0);
break;
default:
switch (expr(&x, MUMPS_STR))
{
case EXPR_FAIL:
return FALSE;
case EXPR_GOOD:
assert(TRIP_REF == x.oprclass);
if (devctlexp)
{
ref = newtriple(OC_WRITE);
ref->operand[0] = x;
STO_LLPTR(0);
} else if (x.oprval.tref->opcode == OC_CAT)
wrtcatopt(x.oprval.tref, &llptr, LITLST_TOP);
else
{
ref = newtriple(OC_WRITE);
ref->operand[0] = x;
STO_LLPTR((OC_LIT == x.oprval.tref->opcode) ? ref : 0);
}
break;
case EXPR_INDR:
make_commarg(&x, indir_write);
STO_LLPTR(0);
break;
default:
assert(FALSE);
}
break;
}
if (TK_COMMA != TREF(window_token))
break;
advancewindow();
if (LITLST_TOP <= llptr)
{
*++llptr = 0;
ltop = llptr;
llptr = 0;
}
}
STO_LLPTR(0);
if (ltop)
llptr = ltop;
for (ptx = litlst ; ptx < llptr ; ptx++)
{
if (*ptx && *(ptx + 1))
{
lit.mvtype = MV_STR;
lit.str.addr = cp = (char *)stringpool.free;
CLEAR_MVAL_BITS(&lit);
for (t1 = ref = *ptx++ ; ref ; ref = *ptx++)
{
if (OC_WRITE == ref->opcode)
{
msp = &(ref->operand[0].oprval.tref->operand[0].oprval.mlit->v.str);
lnx = msp->len;
ENSURE_STP_FREE_SPACE(lnx);
memcpy(cp, msp->addr, lnx);
cp += lnx;
} else
{
assert(OC_WTONE == ref->opcode);
ENSURE_STP_FREE_SPACE(1);
*cp++ = ref->operand[0].oprval.tref->operand[0].oprval.ilit;
}
ref->operand[0].oprval.tref->opcode = OC_NOOP;
ref->opcode = OC_NOOP;
ref->operand[0].oprval.tref->operand[0].oprclass = NO_REF;
ref->operand[0].oprclass = NO_REF;
}
ptx--;
stringpool.free = (unsigned char *) cp;
lit.str.len = INTCAST(cp - lit.str.addr);
t1->opcode = OC_WRITE;
t1->operand[0] = put_lit(&lit);
}
}
return TRUE;
}
