STOID Mold_File(REBVAL *value, REB_MOLD *mold)
{
REBUNI *dp;
REBCNT n;
REBUNI c;
REBCNT len = VAL_LEN(value);
REBSER *ser = VAL_SERIES(value);
// Compute extra space needed for hex encoded characters:
for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
c = GET_ANY_CHAR(ser, n);
if (IS_FILE_ESC(c)) len += 2;
}
len++; // room for % at start
dp = Prep_Uni_Series(mold, len);
*dp++ = '%';
for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
c = GET_ANY_CHAR(ser, n);
if (IS_FILE_ESC(c)) dp = Form_Hex_Esc_Uni(dp, c); // c => %xx
else *dp++ = c;
}
*dp = 0;
}
*/ static void Loop_Series(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
REBINT si = VAL_INDEX(start);
REBCNT type = VAL_TYPE(start);
*var = *start;
if (ei >= cast(REBINT, VAL_TAIL(start)))
ei = cast(REBINT, VAL_TAIL(start));
if (ei < 0) ei = 0;
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
VAL_INDEX(var) = si;
if (Do_Block_Throws(out, body, 0)) {
if (Loop_Throw_Should_Return(out)) break;
}
if (VAL_TYPE(var) != type) raise Error_1(RE_INVALID_TYPE, var);
si = VAL_INDEX(var);
}
}
*/ static void Loop_Series(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
REBINT si = VAL_INDEX(start);
REBCNT type = VAL_TYPE(start);
*var = *start;
if (ei >= cast(REBINT, VAL_TAIL(start)))
ei = cast(REBINT, VAL_TAIL(start));
if (ei < 0) ei = 0;
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
VAL_INDEX(var) = si;
if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;
if (VAL_TYPE(var) != type) Trap1(RE_INVALID_TYPE, var);
si = VAL_INDEX(var);
}
}
*/ REBINT Cmp_Block(REBVAL *sval, REBVAL *tval, REBFLG is_case)
/*
** Compare two blocks and return the difference of the first
** non-matching value.
**
***********************************************************************/
{
REBVAL *s = VAL_BLK_DATA(sval);
REBVAL *t = VAL_BLK_DATA(tval);
REBINT diff;
CHECK_STACK(&s);
if ((VAL_SERIES(sval)==VAL_SERIES(tval))&&
(VAL_INDEX(sval)==VAL_INDEX(tval)))
return 0;
while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
(IS_NUMBER(s) && IS_NUMBER(t)))) {
if ((diff = Cmp_Value(s, t, is_case)) != 0)
return diff;
s++, t++;
}
return VAL_TYPE(s) - VAL_TYPE(t);
}
//
// Compare_Vector: C
//
REBINT Compare_Vector(const RELVAL *v1, const RELVAL *v2)
{
REBCNT l1 = VAL_LEN_AT(v1);
REBCNT l2 = VAL_LEN_AT(v2);
REBCNT len = MIN(l1, l2);
REBCNT n;
REBU64 i1;
REBU64 i2;
REBYTE *d1 = SER_DATA_RAW(VAL_SERIES(v1));
REBYTE *d2 = SER_DATA_RAW(VAL_SERIES(v2));
REBCNT b1 = VECT_TYPE(VAL_SERIES(v1));
REBCNT b2 = VECT_TYPE(VAL_SERIES(v2));
if ((b1 >= VTSF08 && b2 < VTSF08) || (b2 >= VTSF08 && b1 < VTSF08))
fail (Error(RE_NOT_SAME_TYPE));
for (n = 0; n < len; n++) {
i1 = get_vect(b1, d1, n + VAL_INDEX(v1));
i2 = get_vect(b2, d2, n + VAL_INDEX(v2));
if (i1 != i2) break;
}
if (n != len) {
if (i1 > i2) return 1;
return -1;
}
return l1 - l2;
}
extern int
kvs_put(char *key, char *val)
{
kvs_bucket_t *bucket;
int i;
debug3("mpi/pmi2: in kvs_put");
bucket = &kvs_hash[HASH(key)];
if (! no_dup_keys) {
for (i = 0; i < bucket->count; i ++) {
if (! xstrcmp(key, bucket->pairs[KEY_INDEX(i)])) {
/* replace the k-v pair */
xfree(bucket->pairs[VAL_INDEX(i)]);
bucket->pairs[VAL_INDEX(i)] = xstrdup(val);
debug("mpi/pmi2: put kvs %s=%s", key, val);
return SLURM_SUCCESS;
}
}
}
if (bucket->count * 2 >= bucket->size) {
bucket->size += (TASKS_PER_BUCKET * 2);
xrealloc(bucket->pairs, bucket->size * sizeof(char *));
}
/* add the k-v pair */
i = bucket->count;
bucket->pairs[KEY_INDEX(i)] = xstrdup(key);
bucket->pairs[VAL_INDEX(i)] = xstrdup(val);
bucket->count ++;
debug3("mpi/pmi2: put kvs %s=%s", key, val);
return SLURM_SUCCESS;
}
*/ REBINT PD_Block(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
/* Issues!!!
a/1.3
a/not-found: 10 error or append?
a/not-followed: 10 error or append?
*/
if (IS_INTEGER(pvs->select)) {
n = Int32(pvs->select) + VAL_INDEX(pvs->value) - 1;
}
else if (IS_WORD(pvs->select)) {
n = Find_Word(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), VAL_WORD_CANON(pvs->select));
if (n != NOT_FOUND) n++;
}
else {
// other values:
n = Find_Block_Simple(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), pvs->select) + 1;
}
if (n < 0 || (REBCNT)n >= VAL_TAIL(pvs->value)) {
if (pvs->setval) return PE_BAD_SELECT;
return PE_NONE;
}
if (pvs->setval) TRAP_PROTECT(VAL_SERIES(pvs->value));
pvs->value = VAL_BLK_SKIP(pvs->value, n);
// if valset - check PROTECT on block
//if (NOT_END(pvs->path+1)) Next_Path(pvs); return PE_OK;
return PE_SET;
}
/*
* No escape of ';' supported for now, hence no ';' in value.
* TODO: concat command processing
*/
extern int
client_req_parse_body(client_req_t *req)
{
int i = 0, rc = SLURM_SUCCESS;
char *key, *val;
/* skip cmd */
i = req->parse_idx;
while (i < req->buf_len) {
/* search for key */
key = &req->buf[i];
while (req->buf[i] != '=' && i < req->buf_len) {
i ++;
}
if (i >= req->buf_len) {
error("mpi/pmi2: no value for key %s in req", key);
rc = SLURM_ERROR;
break;
}
req->buf[i] = '\0'; /* make it nul terminated */
i ++;
debug3("mpi/pmi2: client req key %s", key);
/* search for val */
val = &req->buf[i];
while (req->buf[i] != req->sep &&
req->buf[i] != req->term &&
i < req->buf_len) {
i ++;
}
if (i >= req->buf_len) {
error("mpi/pmi2: value not properly terminated in "
"client request");
rc = SLURM_ERROR;
break;
}
req->buf[i] = '\0'; /* make it nul terminated */
i ++;
debug3("mpi/pmi2: client req val %s", val);
/*
* append pair.
* there may be duplicate keys in the pairs, such as in the
* spawn cmd. Hence the order of the pairs is of significance.
*/
if (2 * (req->pairs_cnt + 2) > req->pairs_size) {
req->pairs_size += REQ_PAIR_SIZE_INC;
xrealloc(req->pairs, req->pairs_size * sizeof(char *));
}
req->pairs[KEY_INDEX(req->pairs_cnt)] = key;
req->pairs[VAL_INDEX(req->pairs_cnt)] = val;
req->pairs_cnt ++;
}
/* add a pair of NULL at the end, without increasing req->pairs_cnt */
req->pairs[KEY_INDEX(req->pairs_cnt)] = NULL;
req->pairs[VAL_INDEX(req->pairs_cnt)] = NULL;
return rc;
}
*/ REBCNT Val_Series_Len(REBVAL *value)
/*
** Get length of series, but avoid negative values.
**
***********************************************************************/
{
if (VAL_INDEX(value) >= VAL_TAIL(value)) return 0;
return VAL_TAIL(value) - VAL_INDEX(value);
}
*/ REBCNT Val_Byte_Len(REBVAL *value)
/*
** Get length of series in bytes.
**
***********************************************************************/
{
if (VAL_INDEX(value) >= VAL_TAIL(value)) return 0;
return (VAL_TAIL(value) - VAL_INDEX(value)) * SERIES_WIDE(VAL_SERIES(value));
}
*/ REBINT PD_String(REBPVS *pvs)
/*
***********************************************************************/
{
REBVAL *data = pvs->value;
REBVAL *val = pvs->setval;
REBINT n = 0;
REBCNT i;
REBINT c;
REBSER *ser = VAL_SERIES(data);
if (IS_INTEGER(pvs->select)) {
n = Int32(pvs->select) + VAL_INDEX(data) - 1;
}
else return PE_BAD_SELECT;
if (val == 0) {
if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_NONE;
if (IS_BINARY(data)) {
SET_INTEGER(pvs->store, *BIN_SKIP(ser, n));
} else {
SET_CHAR(pvs->store, GET_ANY_CHAR(ser, n));
}
return PE_USE;
}
if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_BAD_RANGE;
if (IS_CHAR(val)) {
c = VAL_CHAR(val);
if (c > MAX_CHAR) return PE_BAD_SET;
}
else if (IS_INTEGER(val)) {
c = Int32(val);
if (c > MAX_CHAR || c < 0) return PE_BAD_SET;
if (IS_BINARY(data)) { // special case for binary
if (c > 0xff) Trap_Range(val);
BIN_HEAD(ser)[n] = (REBYTE)c;
return PE_OK;
}
}
else if (ANY_BINSTR(val)) {
i = VAL_INDEX(val);
if (i >= VAL_TAIL(val)) return PE_BAD_SET;
c = GET_ANY_CHAR(VAL_SERIES(val), i);
}
else
return PE_BAD_SELECT;
TRAP_PROTECT(ser);
if (BYTE_SIZE(ser) && c > 0xff) Widen_String(ser);
SET_ANY_CHAR(ser, n, c);
return PE_OK;
}
*/ static REBCNT Set_Parse_Series(REBPARSE *parse, REBVAL *item)
/*
** Change the series and return the new index.
**
***********************************************************************/
{
parse->series = VAL_SERIES(item);
parse->type = VAL_TYPE(item);
if (IS_BINARY(item) || (parse->flags & PF_CASED)) parse->flags |= PF_CASE;
else parse->flags &= ~PF_CASE;
return (VAL_INDEX(item) > VAL_TAIL(item)) ? VAL_TAIL(item) : VAL_INDEX(item);
}
*/ void Post_Mold(REBVAL *value, REB_MOLD *mold)
/*
** For series that has an index, add the index for mold/all.
** Add closing block.
**
***********************************************************************/
{
if (VAL_INDEX(value)) {
Append_Byte(mold->series, ' ');
Append_Int(mold->series, VAL_INDEX(value)+1);
}
if (GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, ']');
}
*/ REBINT CT_Block(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
REBINT num;
if (mode == 3)
return VAL_SERIES(a) == VAL_SERIES(b) && VAL_INDEX(a) == VAL_INDEX(b);
num = Cmp_Block(a, b, mode > 1);
if (mode >= 0) return (num == 0);
if (mode == -1) return (num >= 0);
return (num > 0);
}
*/ REBINT CT_String(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
REBINT num;
if (mode == 3)
return VAL_SERIES(a) == VAL_SERIES(b) && VAL_INDEX(a) == VAL_INDEX(b);
num = Compare_String_Vals(a, b, (REBOOL) !(mode > 1));
if (mode >= 0) return (num == 0);
if (mode == -1) return (num >= 0);
return (num > 0);
}
//
// Pick_Vector: C
//
void Pick_Vector(REBVAL *out, const REBVAL *value, const REBVAL *picker) {
REBSER *vect = VAL_SERIES(value);
REBINT n;
if (IS_INTEGER(picker) || IS_DECIMAL(picker))
n = Int32(picker);
else
fail (Error_Invalid_Arg(picker));
n += VAL_INDEX(value);
if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect)) {
SET_VOID(out); // out of range of vector data
return;
}
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
if (bits < VTSF08)
SET_INTEGER(out, get_vect(bits, vp, n - 1)); // 64-bit
else {
VAL_RESET_HEADER(out, REB_DECIMAL);
INIT_DECIMAL_BITS(out, get_vect(bits, vp, n - 1)); // 64-bit
}
}
//
// Val_Init_Series_Index_Core: C
//
// Common function.
//
void Val_Init_Series_Index_Core(
REBVAL *value,
enum Reb_Kind type,
REBSER *series,
REBCNT index
) {
assert(series);
ENSURE_SERIES_MANAGED(series);
if (type != REB_IMAGE && type != REB_VECTOR) {
// Code in various places seemed to have different opinions of
// whether a BINARY needed to be zero terminated. It doesn't
// make a lot of sense to zero terminate a binary unless it
// simplifies the code assumptions somehow--it's in the class
// "ANY_BINSTR()" so that suggests perhaps it has a bit more
// obligation to conform. Also, the original Make_Binary comment
// from the open source release read:
//
// Make a binary string series. For byte, C, and UTF8 strings.
// Add 1 extra for terminator.
//
// Until that is consciously overturned, check the REB_BINARY too
ASSERT_SERIES_TERM(series); // doesn't apply to image/vector
}
VAL_RESET_HEADER(value, type);
INIT_VAL_SERIES(value, series);
VAL_INDEX(value) = index;
}
static void swap_chars(REBVAL *val1, REBVAL *val2)
{
REBUNI c1;
REBUNI c2;
REBSER *s1 = VAL_SERIES(val1);
REBSER *s2 = VAL_SERIES(val2);
c1 = GET_ANY_CHAR(s1, VAL_INDEX(val1));
c2 = GET_ANY_CHAR(s2, VAL_INDEX(val2));
if (BYTE_SIZE(s1) && c2 > 0xff) Widen_String(s1);
SET_ANY_CHAR(s1, VAL_INDEX(val1), c2);
if (BYTE_SIZE(s2) && c1 > 0xff) Widen_String(s2);
SET_ANY_CHAR(s2, VAL_INDEX(val2), c1);
}
*/ static REBFLG Get_Index_Var(REBVAL *item, REBSER *series, REBINT *index)
/*
** Get the series index from a word or path or integer.
**
** Returns: TRUE if value was a series. FALSE if integer.
**
***********************************************************************/
{
REBVAL *hold = item;
if (IS_END(item)) Trap1(RE_PARSE_END, item);
if (IS_WORD(item)) {
if (!VAL_CMD(item)) item = Get_Var(item);
}
else if (IS_PATH(item)) {
REBVAL *path = item;
Do_Path(&path, 0); //!!! function!
item = DS_TOP;
}
else if (!IS_INTEGER(item))
Trap1(RE_PARSE_VARIABLE, hold);
if (IS_INTEGER(item)) {
*index = Int32(item);
return FALSE;
}
if (!ANY_SERIES(item) || VAL_SERIES(item) != series)
Trap1(RE_PARSE_SERIES, hold);
*index = VAL_INDEX(item);
return TRUE;
}
static REBCNT find_string(REBSER *series, REBCNT index, REBCNT end, REBVAL *target, REBCNT len, REBCNT flags, REBINT skip)
{
REBCNT start = index;
if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) {
skip = -1;
start = 0;
if (flags & AM_FIND_LAST) index = end - len;
else index--;
}
if (ANY_BINSTR(target)) {
// Do the optimal search or the general search?
if (BYTE_SIZE(series) && VAL_BYTE_SIZE(target) && !(flags & ~(AM_FIND_CASE|AM_FIND_MATCH)))
return Find_Byte_Str(series, start, VAL_BIN_DATA(target), len, !GET_FLAG(flags, ARG_FIND_CASE-1), GET_FLAG(flags, ARG_FIND_MATCH-1));
else
return Find_Str_Str(series, start, index, end, skip, VAL_SERIES(target), VAL_INDEX(target), len, flags & (AM_FIND_MATCH|AM_FIND_CASE));
}
else if (IS_BINARY(target)) {
return Find_Byte_Str(series, start, VAL_BIN_DATA(target), len, 0, GET_FLAG(flags, ARG_FIND_MATCH-1));
}
else if (IS_CHAR(target)) {
return Find_Str_Char(series, start, index, end, skip, VAL_CHAR(target), flags);
}
else if (IS_INTEGER(target)) {
return Find_Str_Char(series, start, index, end, skip, (REBUNI)VAL_INT32(target), flags);
}
else if (IS_BITSET(target)) {
return Find_Str_Bitset(series, start, index, end, skip, VAL_SERIES(target), flags);
}
return NOT_FOUND;
}
*/ static REBVAL *Do_Parse_Path(REBVAL *item, REBPARSE *parse, REBCNT *index)
/*
** Handle a PATH, including get and set, that's found in a rule.
**
***********************************************************************/
{
REBVAL *path = item;
REBVAL tmp;
if (IS_PATH(item)) {
if (Do_Path(&path, 0)) return item; // found a function
item = DS_TOP;
}
else if (IS_SET_PATH(item)) {
Set_Series(parse->type, &tmp, parse->series);
VAL_INDEX(&tmp) = *index;
if (Do_Path(&path, &tmp)) return item; // found a function
return 0;
}
else if (IS_GET_PATH(item)) {
if (Do_Path(&path, 0)) return item; // found a function
item = DS_TOP;
// CureCode #1263 change
// if (parse->type != VAL_TYPE(item) || VAL_SERIES(item) != parse->series)
if (!ANY_SERIES(item)) Trap1(RE_PARSE_SERIES, path);
*index = Set_Parse_Series(parse, item);
return 0;
}
return item;
}
void Print_Parse_Index(REBCNT type, REBVAL *rules, REBSER *series, REBCNT index)
{
REBVAL val;
Set_Series(type, &val, series);
VAL_INDEX(&val) = index;
Debug_Fmt("%r: %r", rules, &val);
}
STOID Mold_Tag(REBVAL *value, REB_MOLD *mold)
{
Append_Byte(mold->series, '<');
Insert_String(mold->series, AT_TAIL, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0);
Append_Byte(mold->series, '>');
}
//
// Temp_Byte_Chars_May_Fail: C
//
// NOTE: This function returns a temporary result, and uses an internal
// buffer. Do not use it recursively. Also, it will Trap on errors.
//
// Prequalifies a string before using it with a function that
// expects it to be 8-bits. It would be used for instance to convert
// a string that is potentially REBUNI-wide into a form that can be used
// with a Scan_XXX routine, that is expecting ASCII or UTF-8 source.
// (Many TO-XXX conversions from STRING re-use that scanner logic.)
//
// Returns a temporary string and sets the length field.
//
// If `allow_utf8`, the constructed result is converted to UTF8.
//
// Checks or converts it:
//
// 1. it is byte string (not unicode)
// 2. if unicode, copy and return as temp byte string
// 3. it's actual content (less space, newlines) <= max len
// 4. it does not contain other values ("123 456")
// 5. it's not empty or only whitespace
//
REBYTE *Temp_Byte_Chars_May_Fail(
const REBVAL *val,
REBINT max_len,
REBCNT *length,
REBOOL allow_utf8
) {
REBCNT tail = VAL_LEN_HEAD(val);
REBCNT index = VAL_INDEX(val);
REBCNT len;
REBUNI c;
REBYTE *bp;
REBSER *src = VAL_SERIES(val);
if (index > tail) fail (Error(RE_PAST_END));
Resize_Series(BYTE_BUF, max_len+1);
bp = BIN_HEAD(BYTE_BUF);
// Skip leading whitespace:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (!IS_SPACE(c)) break;
}
// Copy chars that are valid:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (c >= 0x80) {
if (!allow_utf8) fail (Error(RE_INVALID_CHARS));
len = Encode_UTF8_Char(bp, c);
max_len -= len;
bp += len;
}
else if (!IS_SPACE(c)) {
*bp++ = (REBYTE)c;
max_len--;
}
else break;
if (max_len < 0)
fail (Error(RE_TOO_LONG));
}
// Rest better be just spaces:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (!IS_SPACE(c)) fail (Error(RE_INVALID_CHARS));
}
*bp = '\0';
len = bp - BIN_HEAD(BYTE_BUF);
if (len == 0) fail (Error(RE_TOO_SHORT));
if (length) *length = len;
return BIN_HEAD(BYTE_BUF);
}
//
// Find_Max_Bit: C
//
// Return integer number for the maximum bit number defined by
// the value. Used to determine how much space to allocate.
//
REBINT Find_Max_Bit(REBVAL *val)
{
REBINT maxi = 0;
REBINT n;
switch (VAL_TYPE(val)) {
case REB_CHAR:
maxi = VAL_CHAR(val)+1;
break;
case REB_INTEGER:
maxi = Int32s(val, 0);
break;
case REB_STRING:
case REB_FILE:
case REB_EMAIL:
case REB_URL:
case REB_TAG:
// case REB_ISSUE:
n = VAL_INDEX(val);
if (VAL_BYTE_SIZE(val)) {
REBYTE *bp = VAL_BIN(val);
for (; n < cast(REBINT, VAL_LEN_HEAD(val)); n++)
if (bp[n] > maxi) maxi = bp[n];
}
else {
REBUNI *up = VAL_UNI(val);
for (; n < cast(REBINT, VAL_LEN_HEAD(val)); n++)
if (up[n] > maxi) maxi = up[n];
}
maxi++;
break;
case REB_BINARY:
maxi = VAL_LEN_AT(val) * 8 - 1;
if (maxi < 0) maxi = 0;
break;
case REB_BLOCK:
for (val = VAL_ARRAY_AT(val); NOT_END(val); val++) {
n = Find_Max_Bit(val);
if (n > maxi) maxi = n;
}
//maxi++;
break;
case REB_NONE:
maxi = 0;
break;
default:
return -1;
}
return maxi;
}
//
// Partial1: C
//
// Process the /part (or /skip) and other length modifying
// arguments.
//
REBINT Partial1(REBVAL *sval, REBVAL *lval)
{
REBI64 len;
REBINT maxlen;
REBINT is_ser = ANY_SERIES(sval);
// If lval is not set or is BAR!, use the current len of the target value:
if (IS_UNSET(lval) || IS_BAR(lval)) {
if (!is_ser) return 1;
if (VAL_INDEX(sval) >= VAL_LEN_HEAD(sval)) return 0;
return (VAL_LEN_HEAD(sval) - VAL_INDEX(sval));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) len = Int32(lval);
else {
if (is_ser && VAL_TYPE(sval) == VAL_TYPE(lval) && VAL_SERIES(sval) == VAL_SERIES(lval))
len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(sval);
else
fail (Error(RE_INVALID_PART, lval));
}
if (is_ser) {
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN_AT(sval);
if (len > maxlen) len = maxlen;
} else {
len = -len;
if (len > (REBINT)VAL_INDEX(sval)) len = (REBINT)VAL_INDEX(sval);
VAL_INDEX(sval) -= (REBCNT)len;
}
}
return (REBINT)len;
}
//
// MAKE_String: C
//
void MAKE_String(REBVAL *out, enum Reb_Kind kind, const REBVAL *def) {
REBSER *ser; // goto would cross initialization
if (IS_INTEGER(def)) {
//
// !!! R3-Alpha tolerated decimal, e.g. `make string! 3.14`, which
// is semantically nebulous (round up, down?) and generally bad.
//
ser = Make_Binary(Int32s(def, 0));
Val_Init_Series(out, kind, ser);
return;
}
else if (IS_BLOCK(def)) {
//
// The construction syntax for making strings or binaries that are
// preloaded with an offset into the data is #[binary [#{0001} 2]].
// In R3-Alpha make definitions didn't have to be a single value
// (they are for compatibility between construction syntax and MAKE
// in Ren-C). So the positional syntax was #[binary! #{0001} 2]...
// while #[binary [#{0001} 2]] would join the pieces together in order
// to produce #{000102}. That behavior is not available in Ren-C.
if (VAL_ARRAY_LEN_AT(def) != 2)
goto bad_make;
RELVAL *any_binstr = VAL_ARRAY_AT(def);
if (!ANY_BINSTR(any_binstr))
goto bad_make;
if (IS_BINARY(any_binstr) != LOGICAL(kind == REB_BINARY))
goto bad_make;
RELVAL *index = VAL_ARRAY_AT(def) + 1;
if (!IS_INTEGER(index))
goto bad_make;
REBINT i = Int32(index) - 1 + VAL_INDEX(any_binstr);
if (i < 0 || i > cast(REBINT, VAL_LEN_AT(any_binstr)))
goto bad_make;
Val_Init_Series_Index(out, kind, VAL_SERIES(any_binstr), i);
return;
}
if (kind == REB_BINARY)
ser = make_binary(def, TRUE);
else
ser = MAKE_TO_String_Common(def);
if (!ser)
goto bad_make;
Val_Init_Series_Index(out, kind, ser, 0);
return;
bad_make:
fail (Error_Bad_Make(kind, def));
}
extern int
node_attr_put(char *key, char *val)
{
nag_req_t *req = NULL, **pprev = NULL;
client_resp_t *resp = NULL;
int rc = SLURM_SUCCESS;
debug3("mpi/pmi2: node_attr_put: %s=%s", key, val);
if (na_cnt * 2 >= na_size) {
na_size += NODE_ATTR_SIZE_INC;
xrealloc(node_attr, na_size * sizeof(char*));
}
node_attr[KEY_INDEX(na_cnt)] = xstrdup(key);
node_attr[VAL_INDEX(na_cnt)] = xstrdup(val);
na_cnt ++;
/* process pending requests */
pprev = &nag_req_list;
req = *pprev;
while (req != NULL) {
if (strncmp(key, req->key, PMI2_MAX_KEYLEN)) {
pprev = &req->next;
req = *pprev;
} else {
debug("mpi/pmi2: found pending request from rank %d",
req->rank);
/* send response msg */
if (! resp) {
resp = client_resp_new();
client_resp_append(resp,
CMD_KEY"="
GETNODEATTRRESP_CMD";"
RC_KEY"=0;"
FOUND_KEY"="TRUE_VAL";"
VALUE_KEY"=%s;", val);
}
rc = client_resp_send(resp, req->fd);
if (rc != SLURM_SUCCESS) {
error("mpi/pmi2: failed to send '"
GETNODEATTRRESP_CMD "' to task %d",
req->rank);
}
/* remove the request */
*pprev = req->next;
_free_nag_req(req);
req = *pprev;
}
}
if (resp) {
client_resp_free (resp);
}
debug3("mpi/pmi2: out node_attr_put");
return SLURM_SUCCESS;
}
*/ void Set_Binary(REBVAL *value, REBSER *series)
/*
** Common function.
**
***********************************************************************/
{
VAL_SET(value, REB_BINARY);
VAL_SERIES(value) = series;
VAL_INDEX(value) = 0;
VAL_SERIES_SIDE(value) = 0;
}
*/ REBSER *Copy_Sequence_At_Position(const REBVAL *position)
/*
** Copy a non-array series from its value structure, using the
** value's index as the location to start copying the data.
**
***********************************************************************/
{
return Copy_Sequence_At_Len(
VAL_SERIES(position), VAL_INDEX(position), VAL_LEN(position)
);
}