//
// Make_Where_For_Frame: C
//
// Each call frame maintains the array it is executing in, the current index
// in that array, and the index of where the current expression started.
// This can be deduced into a segment of code to display in the debug views
// to indicate roughly "what's running" at that stack level.
//
// Unfortunately, Rebol doesn't formalize this very well. There is no lock
// on segments of blocks during their evaluation, and it's possible for
// self-modifying code to scramble the blocks being executed. The DO
// evaluator is robust in terms of not *crashing*, but the semantics may well
// suprise users.
//
// !!! Should blocks on the stack be locked from modification, at least by
// default unless a special setting for self-modifying code unlocks it?
//
// So long as WHERE information is unreliable, this has to check that
// `expr_index` (where the evaluation started) and `index` (where the
// evaluation thinks it currently is) aren't out of bounds here. We could
// be giving back positions now unrelated to the call...but it won't crash!
//
REBARR *Make_Where_For_Frame(struct Reb_Frame *frame)
{
REBCNT start;
REBCNT end;
REBARR *where;
REBOOL pending;
if (FRM_IS_VALIST(frame)) {
const REBOOL truncated = TRUE;
Reify_Va_To_Array_In_Frame(frame, truncated);
}
// WARNING: MIN is a C macro and repeats its arguments.
//
start = MIN(ARR_LEN(FRM_ARRAY(frame)), cast(REBCNT, frame->expr_index));
end = MIN(ARR_LEN(FRM_ARRAY(frame)), FRM_INDEX(frame));
assert(end >= start);
assert(frame->mode != CALL_MODE_GUARD_ARRAY_ONLY);
pending = NOT(frame->mode == CALL_MODE_FUNCTION);
// Do a shallow copy so that the WHERE information only includes
// the range of the array being executed up to the point of
// currently relevant evaluation, not all the way to the tail
// of the block (where future potential evaluation would be)
{
REBCNT n = 0;
REBCNT len =
1 // fake function word (compensates for prefetch)
+ (end - start) // data from expr_index to the current index
+ (pending ? 1 : 0); // if it's pending we put "..." to show that
where = Make_Array(len);
// !!! Due to "prefetch" the expr_index will be *past* the invocation
// of the function. So this is a lie, as a placeholder for what a
// real debug mode would need to actually save the data to show.
// If the execution were a path or anything other than a word, this
// will lose it.
//
Val_Init_Word(ARR_AT(where, n), REB_WORD, FRM_LABEL(frame));
++n;
for (n = 1; n < len; ++n)
*ARR_AT(where, n) = *ARR_AT(FRM_ARRAY(frame), start + n - 1);
SET_ARRAY_LEN(where, len);
TERM_ARRAY(where);
}
// Making a shallow copy offers another advantage, that it's
// possible to get rid of the newline marker on the first element,
// that would visually disrupt the backtrace for no reason.
//
if (end - start > 0)
CLEAR_VAL_FLAG(ARR_HEAD(where), VALUE_FLAG_LINE);
// We add an ellipsis to a pending frame to make it a little bit
// clearer what is going on. If someone sees a where that looks
// like just `* [print]` the asterisk alone doesn't quite send
// home the message that print is not running and it is
// argument fulfillment that is why it's not "on the stack"
// yet, so `* [print ...]` is an attempt to say that better.
//
// !!! This is in-band, which can be mixed up with literal usage
// of ellipsis. Could there be a better "out-of-band" conveyance?
// Might the system use colorization in a value option bit.
//
if (pending)
Val_Init_Word(Alloc_Tail_Array(where), REB_WORD, SYM_ELLIPSIS);
return where;
}
*/ REBCNT Modify_Array(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, const REBVAL *src_val, REBCNT flags, REBINT dst_len, REBINT dups)
/*
** action: INSERT, APPEND, CHANGE
**
** dst_ser: target
** dst_idx: position
** src_val: source
** flags: AN_ONLY, AN_PART
** dst_len: length to remove
** dups: dup count
**
** return: new dst_idx
**
***********************************************************************/
{
REBCNT tail = SERIES_TAIL(dst_ser);
REBINT ilen = 1; // length to be inserted
REBINT size; // total to insert
#if !defined(NDEBUG)
REBINT index;
#endif
if (IS_UNSET(src_val) || dups < 0) {
// If they are effectively asking for "no action" then all we have
// to do is return the natural index result for the operation.
// (APPEND will return 0, insert the tail of the insertion...so index)
return (action == A_APPEND) ? 0 : dst_idx;
}
if (action == A_APPEND || dst_idx > tail) dst_idx = tail;
// Check /PART, compute LEN:
if (!GET_FLAG(flags, AN_ONLY) && ANY_ARRAY(src_val)) {
// Adjust length of insertion if changing /PART:
if (action != A_CHANGE && GET_FLAG(flags, AN_PART))
ilen = dst_len;
else
ilen = VAL_LEN(src_val);
// Are we modifying ourselves? If so, copy src_val block first:
if (dst_ser == VAL_SERIES(src_val)) {
REBSER *series = Copy_Array_At_Shallow(
VAL_SERIES(src_val), VAL_INDEX(src_val)
);
src_val = BLK_HEAD(series);
}
else
src_val = VAL_BLK_DATA(src_val); // skips by VAL_INDEX values
}
// Total to insert:
size = dups * ilen;
if (action != A_CHANGE) {
// Always expand dst_ser for INSERT and APPEND actions:
Expand_Series(dst_ser, dst_idx, size);
} else {
if (size > dst_len)
Expand_Series(dst_ser, dst_idx, size-dst_len);
else if (size < dst_len && GET_FLAG(flags, AN_PART))
Remove_Series(dst_ser, dst_idx, dst_len-size);
else if (size + dst_idx > tail) {
EXPAND_SERIES_TAIL(dst_ser, size - (tail - dst_idx));
}
}
tail = (action == A_APPEND) ? 0 : size + dst_idx;
#if !defined(NDEBUG)
for (index = 0; index < ilen; index++) {
if (SERIES_GET_FLAG(dst_ser, SER_MANAGED))
ASSERT_VALUE_MANAGED(&src_val[index]);
}
#endif
dst_idx *= SERIES_WIDE(dst_ser); // loop invariant
ilen *= SERIES_WIDE(dst_ser); // loop invariant
for (; dups > 0; dups--) {
memcpy(dst_ser->data + dst_idx, src_val, ilen);
dst_idx += ilen;
}
TERM_ARRAY(dst_ser);
return tail;
}
