xx*/ REBSER *Make_Func_Words(REBSER *spec)
/*
** Make a word list part of a context block for a function spec.
** This series is stored in the ARGS field of the function value.
**
***********************************************************************/
{
REBVAL *word = BLK_HEAD(spec);
REBSER *words;
REBCNT n;
REBCNT len = 0;
// Count the number of words within the spec:
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) len++;
}
// Make the words table:
words = Make_Words(len+1);
// Skip 0th entry (because 0 is not valid for bind index).
len = 1;
WORDS_HEAD(words)[0] = 0;
// Initialize the words in the new table.
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) WORDS_HEAD(words)[len++] = n;
}
SERIES_TAIL(words) = len;
return words;
}
*/ REBSER *Collect_Frame(REBSER *prior, REBVAL value[], REBCNT modes)
/*
** Scans a block for words to use in the frame. The list of
** words can then be used to create a frame. The Bind_Table is
** used to quickly determine duplicate entries.
**
** Returns:
** A block of words that can be used for a frame word list.
** If no new words, the prior list is returned.
**
** Modes:
** BIND_ALL - scan all words, or just set words
** BIND_DEEP - scan sub-blocks too
** BIND_GET - substitute :word with actual word
** BIND_NO_SELF - do not add implicit SELF to the frame
**
***********************************************************************/
{
Collect_Start(modes);
// Setup binding table with existing words:
if (prior) Collect_Object(prior);
// Scan for words, adding them to BUF_WORDS and bind table:
Collect_Frame_Inner_Loop(WORDS_HEAD(Bind_Table), &value[0], modes);
return Collect_End(prior);
}
*/ REBSER *Collect_Words(REBVAL value[], REBVAL prior_value[], REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use
if (prior_value)
Collect_Words_Inner_Loop(binds, &prior_value[0], BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Words_Inner_Loop(binds, &value[0], modes);
// Reset word markers:
for (value = BLK_HEAD(BUF_WORDS); NOT_END(value); value++)
binds[VAL_WORD_CANON(value)] = 0;
series = Copy_Array_At_Max_Shallow(
BUF_WORDS, start, SERIES_TAIL(BUF_WORDS) - start
);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
*/ REBSER *Collect_End(REBSER *prior)
/*
** Finish collecting words, and free the Bind_Table for reuse.
**
***********************************************************************/
{
REBVAL *words;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
// Reset binding table (note BUF_WORDS may have expanded):
for (words = BLK_HEAD(BUF_WORDS); NOT_END(words); words++)
binds[VAL_WORD_CANON(words)] = 0;
// If no new words, prior frame:
if (prior && SERIES_TAIL(BUF_WORDS) == SERIES_TAIL(prior)) {
RESET_TAIL(BUF_WORDS); // allow reuse
return FRM_WORD_SERIES(prior);
}
prior = Copy_Series(BUF_WORDS);
RESET_TAIL(BUF_WORDS); // allow reuse
BARE_SERIES(prior); // No GC ever needed for word list
CHECK_BIND_TABLE;
return prior;
}
*/ void Bind_Relative(REBSER *words, REBSER *frame, REBSER *block)
/*
** Bind the words of a function block to a stack frame.
** To indicate the relative nature of the index, it is set to
** a negative offset.
**
** words: VAL_FUNC_ARGS(func)
** frame: VAL_FUNC_ARGS(func)
** block: block to bind
**
***********************************************************************/
{
REBVAL *args;
REBINT index;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
args = BLK_SKIP(words, 1);
CHECK_BIND_TABLE;
//Dump_Block(words);
// Setup binding table from the argument word list:
for (index = 1; NOT_END(args); args++, index++)
binds[VAL_BIND_CANON(args)] = -index;
Bind_Relative_Words(frame, block);
// Reset binding table:
for (args = BLK_SKIP(words, 1); NOT_END(args); args++)
binds[VAL_BIND_CANON(args)] = 0;
}
*/ REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use
if (prior)
Collect_Simple_Words(prior, BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Simple_Words(block, modes);
// Reset word markers:
for (block = BLK_HEAD(BUF_WORDS); NOT_END(block); block++)
binds[VAL_WORD_CANON(block)] = 0;
series = Copy_Series_Part(BUF_WORDS, start, SERIES_TAIL(BUF_WORDS)-start);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
*/ static void Bind_Relative_Words(REBSER *frame, REBSER *block)
/*
** Recursive function for relative function word binding.
**
** Note: frame arg points to an identifying series of the function,
** not a normal frame. This will be used to verify the word fetch.
**
***********************************************************************/
{
REBVAL *value = BLK_HEAD(block);
REBINT n;
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
// Is the word (canon sym) found in this frame?
if (NZ(n = WORDS_HEAD(Bind_Table)[VAL_WORD_CANON(value)])) {
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame; // func body
}
}
else if (ANY_BLOCK(value))
Bind_Relative_Words(frame, VAL_SERIES(value));
}
}
*/ REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
** Create a child frame from two parent frames. Merge common fields.
** Values from the second parent take precedence.
**
** Deep copy and rebind the child.
**
***********************************************************************/
{
REBSER *wrds;
REBSER *child;
REBVAL *words;
REBVAL *value;
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
// Merge parent1 and parent2 words.
// Keep the binding table.
Collect_Start(BIND_ALL);
// Setup binding table and BUF_WORDS with parent1 words:
if (parent1) Collect_Object(parent1);
// Add parent2 words to binding table and BUF_WORDS:
Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);
// Allocate child (now that we know the correct size):
wrds = Copy_Series(BUF_WORDS);
child = Make_Block(SERIES_TAIL(wrds));
value = Append_Value(child);
VAL_SET(value, REB_FRAME);
VAL_FRM_WORDS(value) = wrds;
VAL_FRM_SPEC(value) = 0;
// Copy parent1 values:
COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);
// Copy parent2 values:
words = FRM_WORDS(parent2)+1;
value = FRM_VALUES(parent2)+1;
for (; NOT_END(words); words++, value++) {
// no need to search when the binding table is available
n = binds[VAL_WORD_CANON(words)];
BLK_HEAD(child)[n] = *value;
}
// Terminate the child frame:
SERIES_TAIL(child) = SERIES_TAIL(wrds);
BLK_TERM(child);
// Deep copy the child
Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);
// Rebind the child
Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);
// release the bind table
Collect_End(wrds);
return child;
}
void Dump_Func_Words(REBSER *words)
{
REBINT n;
for (n = 0; n < (REBINT)SERIES_TAIL(words); n++) {
Debug_Fmt("%d: %d", n, WORDS_HEAD(words)[n]);
}
}
xx*/ void Dump_Bind_Table()
/*
***********************************************************************/
{
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
Debug_Fmt("Bind Table (Size: %d)", SERIES_TAIL(Bind_Table));
for (n = 1; n < SERIES_TAIL(Bind_Table); n++) {
if (binds[n])
Debug_Fmt("Bind: %3d to %3d (%s)", n, binds[n], Get_Sym_Name(n));
}
}
*/ void Check_Bind_Table()
/*
***********************************************************************/
{
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
//Debug_Fmt("Bind Table (Size: %d)", SERIES_TAIL(Bind_Table));
for (n = 0; n < SERIES_TAIL(Bind_Table); n++) {
if (binds[n]) {
Debug_Fmt("Bind table fault: %3d to %3d (%s)", n, binds[n], Get_Sym_Name(n));
}
}
}
*/ static void Bind_Block_Words(REBSER *frame, REBVAL *value, REBCNT mode)
/*
** Inner loop of bind block. Modes are:
**
** BIND_ONLY Only bind the words found in the frame.
** BIND_SET Add set-words to the frame during the bind.
** BIND_ALL Add words to the frame during the bind.
** BIND_DEEP Recurse into sub-blocks.
**
** NOTE: BIND_SET must be used carefully, because it does not
** bind prior instances of the word before the set-word. That is
** forward references are not allowed.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBCNT n;
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
if (NZ(n = binds[VAL_WORD_CANON(value)])) {
if (n == NO_RESULT) n = 0; // SELF word
ASSERT1(n < SERIES_TAIL(frame), RP_BIND_BOUNDS);
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Block_Words(frame, VAL_BLK_DATA(value), mode);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Block_Words(frame, BLK_HEAD(VAL_FUNC_BODY(value)), mode);
}
}
*/ void Collect_Object(REBSER *prior)
/*
** Collect words from a prior object.
**
***********************************************************************/
{
REBVAL *words;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBINT n;
words = FRM_WORDS(prior);
COPY_VALUES(words, BLK_HEAD(BUF_WORDS), SERIES_TAIL(prior));
SERIES_TAIL(BUF_WORDS) = SERIES_TAIL(prior);
for (n = 1, words++; NOT_END(words); words++) // skips first = SELF
binds[VAL_WORD_CANON(words)] = n++;
}
*/ void Bind_Values_Core(REBVAL value[], REBSER *frame, REBCNT mode)
/*
** Bind words in an array of values terminated with REB_END
** to a specified frame. See warnings on the functions like
** Bind_Values_Deep() about not passing just a singular REBVAL.
**
** Different modes may be applied:
**
** BIND_ONLY - Only bind words found in the frame.
** BIND_ALL - Add words to the frame during the bind.
** BIND_SET - Add set-words to the frame during the bind.
** (note: word must not occur before the SET)
** BIND_DEEP - Recurse into sub-blocks.
**
** NOTE: BIND_SET must be used carefully, because it does not
** bind prior instances of the word before the set-word. That is
** to say that forward references are not allowed.
**
***********************************************************************/
{
REBVAL *words;
REBCNT index;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_MEMORY(4);
CHECK_BIND_TABLE;
// Note about optimization: it's not a big win to avoid the
// binding table for short blocks (size < 4), because testing
// every block for the rare case adds up.
// Setup binding table
for (index = 1; index < frame->tail; index++) {
words = FRM_WORD(frame, index);
if (!VAL_GET_OPT(words, EXT_WORD_HIDE))
binds[VAL_BIND_CANON(words)] = index;
}
Bind_Values_Inner_Loop(binds, &value[0], frame, mode);
// Reset binding table:
for (words = FRM_WORDS(frame) + 1; NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = 0;
CHECK_BIND_TABLE;
}
*/ void Collect_Words(REBVAL *block, REBFLG modes)
/*
** The inner recursive loop used for Collect_Words function below.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table);
REBVAL *word;
REBVAL *value;
for (; NOT_END(block); block++) {
value = block;
//if (modes & BIND_GET && IS_GET_WORD(block)) value = Get_Var(block);
if (ANY_WORD(value)) {
if (!binds[VAL_WORD_CANON(value)]) { // only once per word
if (IS_SET_WORD(value) || modes & BIND_ALL) {
binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
EXPAND_SERIES_TAIL(BUF_WORDS, 1);
word = BLK_LAST(BUF_WORDS);
VAL_SET(word, VAL_TYPE(value));
VAL_SET_OPT(word, OPTS_UNWORD);
VAL_BIND_SYM(word) = VAL_WORD_SYM(value);
// Allow all datatypes (to start):
VAL_BIND_TYPESET(word) = ~((TYPESET(REB_END) | TYPESET(REB_UNSET))); // not END or UNSET
}
} else {
// If word duplicated:
if (modes & BIND_NO_DUP) {
// Reset binding table (note BUF_WORDS may have expanded):
for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
binds[VAL_WORD_CANON(word)] = 0;
RESET_TAIL(BUF_WORDS); // allow reuse
Trap1(RE_DUP_VARS, value);
}
}
continue;
}
// Recurse into sub-blocks:
if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
Collect_Words(VAL_BLK_DATA(value), modes);
// In this mode (foreach native), do not allow non-words:
//else if (modes & BIND_GET) Trap_Arg(value);
}
BLK_TERM(BUF_WORDS);
}
*/ void Collect_Object(REBSER *prior)
/*
** Collect words from a prior object.
**
***********************************************************************/
{
REBVAL *words = FRM_WORDS(prior);
REBINT *binds = WORDS_HEAD(Bind_Table);
REBINT n;
// this is necessary for COPY_VALUES below
// to not overwrite memory BUF_WORDS does not own
RESIZE_SERIES(BUF_WORDS, SERIES_TAIL(prior));
COPY_VALUES(words, BLK_HEAD(BUF_WORDS), SERIES_TAIL(prior));
SERIES_TAIL(BUF_WORDS) = SERIES_TAIL(prior);
for (n = 1, words++; NOT_END(words); words++) // skips first = SELF
binds[VAL_WORD_CANON(words)] = n++;
}
*/ void Bind_Block(REBSER *frame, REBVAL *block, REBCNT mode)
/*
** Bind the words of a block to a specified frame.
** Different modes may be applied:
** BIND_ONLY - Only bind words found in the frame.
** BIND_ALL - Add words to the frame during the bind.
** BIND_SET - Add set-words to the frame during the bind.
** (note: word must not occur before the SET)
** BIND_DEEP - Recurse into sub-blocks.
**
***********************************************************************/
{
REBVAL *words;
REBCNT index;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_MEMORY(4);
CHECK_BIND_TABLE;
// for (index = 0; index < Bind_Table->tail; index++)
// if (binds[index] != 0) Crash(1333);
// Note about optimization: it's not a big win to avoid the
// binding table for short blocks (size < 4), because testing
// every block for the rare case adds up.
// Setup binding table:
index = 1;
for (index = 1; index < frame->tail; index++) {
words = FRM_WORD(frame, index);
if (!VAL_GET_OPT(words, OPTS_HIDE))
binds[VAL_BIND_CANON(words)] = index;
}
Bind_Block_Words(frame, block, mode);
// Reset binding table:
for (words = FRM_WORDS(frame)+1; NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = 0;
}
*/ void Collect_Object(REBSER *prior)
/*
** Collect words from a prior object.
**
***********************************************************************/
{
REBVAL *words = FRM_WORDS(prior);
REBINT *binds = WORDS_HEAD(Bind_Table);
REBINT n;
// this is necessary for memcpy below to not overwrite memory
// BUF_WORDS does not own
RESIZE_SERIES(BUF_WORDS, SERIES_TAIL(prior));
// Word values can be copied just as bits (these are EXT_WORD_TYPED)
memcpy(BLK_HEAD(BUF_WORDS), words, SERIES_TAIL(prior) * sizeof(REBVAL));
SERIES_TAIL(BUF_WORDS) = SERIES_TAIL(prior);
for (n = 1, words++; NOT_END(words); words++) // skips first = SELF
binds[VAL_WORD_CANON(words)] = n++;
}
*/ void Collect_Simple_Words(REBVAL *block, REBCNT modes)
/*
** Used for Collect_Block_Words().
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBVAL *val;
for (; NOT_END(block); block++) {
if (ANY_WORD(block)
&& !binds[VAL_WORD_CANON(block)]
&& (modes & BIND_ALL || IS_SET_WORD(block))
) {
binds[VAL_WORD_CANON(block)] = 1;
val = Append_Value(BUF_WORDS);
Init_Word(val, VAL_WORD_SYM(block));
}
else if (ANY_EVAL_BLOCK(block) && (modes & BIND_DEEP))
Collect_Simple_Words(VAL_BLK_DATA(block), modes);
}
}
*/ void Rebind_Block(REBSER *src_frame, REBSER *dst_frame, REBVAL *data, REBFLG modes)
/*
** Rebind all words that reference src frame to dst frame.
** Rebind is always deep.
**
** There are two types of frames: relative frames and normal frames.
** When frame_src type and frame_dst type differ,
** modes must have REBIND_TYPE.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table);
for (; NOT_END(data); data++) {
if (ANY_BLOCK(data))
Rebind_Block(src_frame, dst_frame, VAL_BLK_DATA(data), modes);
else if (ANY_WORD(data) && VAL_WORD_FRAME(data) == src_frame) {
VAL_WORD_FRAME(data) = dst_frame;
if (modes & REBIND_TABLE) VAL_WORD_INDEX(data) = binds[VAL_WORD_CANON(data)];
if (modes & REBIND_TYPE) VAL_WORD_INDEX(data) = - VAL_WORD_INDEX(data);
} else if ((modes & REBIND_FUNC) && (IS_FUNCTION(data) || IS_CLOSURE(data)))
Rebind_Block(src_frame, dst_frame, BLK_HEAD(VAL_FUNC_BODY(data)), modes);
}
}
*/ void Collect_Start(REBCNT modes)
/*
** Use the Bind_Table to start collecting new words for
** a frame. Use Collect_End() when done.
**
** WARNING: Do not call code that might call BIND or otherwise
** make use of the Bind_Table or the Word cache array (BUF_WORDS).
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
// Reuse a global word list block because length of block cannot
// be known until all words are scanned. Then copy this block.
if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use
// Add the SELF word to slot zero.
if ((modes = (modes & BIND_NO_SELF)?0:SYM_SELF))
binds[modes] = -1; // (cannot use zero here)
Init_Frame_Word(BLK_HEAD(BUF_WORDS), modes);
SERIES_TAIL(BUF_WORDS) = 1;
}
static void Append_Obj(REBSER *obj, REBVAL *arg)
{
REBCNT i, len;
REBVAL *word, *val;
REBINT *binds; // for binding table
// Can be a word:
if (ANY_WORD(arg)) {
if (!Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE)) {
// bug fix, 'self is protected only in selfish frames
if ((VAL_WORD_CANON(arg) == SYM_SELF) && !IS_SELFLESS(obj))
Trap0(RE_SELF_PROTECTED);
Expand_Frame(obj, 1, 1); // copy word table also
Append_Frame(obj, 0, VAL_WORD_SYM(arg));
// val is UNSET
}
return;
}
if (!IS_BLOCK(arg)) Trap_Arg(arg);
// Process word/value argument block:
arg = VAL_BLK_DATA(arg);
// Use binding table
binds = WORDS_HEAD(Bind_Table);
// Handle selfless
Collect_Start(IS_SELFLESS(obj) ? BIND_NO_SELF | BIND_ALL : BIND_ALL);
// Setup binding table with obj words:
Collect_Object(obj);
// Examine word/value argument block
for (word = arg; NOT_END(word); word += 2) {
if (!IS_WORD(word) && !IS_SET_WORD(word)) {
// release binding table
BLK_TERM(BUF_WORDS);
Collect_End(obj);
Trap_Arg(word);
}
if (NZ(i = binds[VAL_WORD_CANON(word)])) {
// bug fix, 'self is protected only in selfish frames:
if ((VAL_WORD_CANON(word) == SYM_SELF) && !IS_SELFLESS(obj)) {
// release binding table
BLK_TERM(BUF_WORDS);
Collect_End(obj);
Trap0(RE_SELF_PROTECTED);
}
} else {
// collect the word
binds[VAL_WORD_CANON(word)] = SERIES_TAIL(BUF_WORDS);
EXPAND_SERIES_TAIL(BUF_WORDS, 1);
val = BLK_LAST(BUF_WORDS);
*val = *word;
}
if (IS_END(word + 1)) break; // fix bug#708
}
BLK_TERM(BUF_WORDS);
// Append new words to obj
len = SERIES_TAIL(obj);
Expand_Frame(obj, SERIES_TAIL(BUF_WORDS) - len, 1);
for (word = BLK_SKIP(BUF_WORDS, len); NOT_END(word); word++)
Append_Frame(obj, 0, VAL_WORD_SYM(word));
// Set new values to obj words
for (word = arg; NOT_END(word); word += 2) {
i = binds[VAL_WORD_CANON(word)];
val = FRM_VALUE(obj, i);
if (GET_FLAGS(VAL_OPTS(FRM_WORD(obj, i)), OPTS_HIDE, OPTS_LOCK)) {
// release binding table
Collect_End(obj);
if (VAL_PROTECTED(FRM_WORD(obj, i)))
Trap1(RE_LOCKED_WORD, FRM_WORD(obj, i));
Trap0(RE_HIDDEN);
}
if (IS_END(word + 1)) SET_NONE(val);
else *val = word[1];
if (IS_END(word + 1)) break; // fix bug#708
}
// release binding table
Collect_End(obj);
}
*/ void Resolve_Context(REBSER *target, REBSER *source, REBVAL *only_words, REBFLG all, REBFLG expand)
/*
** Only_words can be a block of words or an index in the target
** (for new words).
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBVAL *words;
REBVAL *vals;
REBINT n;
REBINT m;
REBCNT i = 0;
CHECK_BIND_TABLE;
if (IS_PROTECT_SERIES(target)) Trap0(RE_PROTECTED);
if (IS_INTEGER(only_words)) { // Must be: 0 < i <= tail
i = VAL_INT32(only_words); // never <= 0
if (i == 0) i = 1;
if (i >= target->tail) return;
}
Collect_Start(BIND_NO_SELF); // DO NOT TRAP IN THIS SECTION
n = 0;
// If limited resolve, tag the word ids that need to be copied:
if (i) {
// Only the new words of the target:
for (words = FRM_WORD(target, i); NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = -1;
n = SERIES_TAIL(target) - 1;
}
else if (IS_BLOCK(only_words)) {
// Limit exports to only these words:
for (words = VAL_BLK_DATA(only_words); NOT_END(words); words++) {
if (IS_WORD(words) || IS_SET_WORD(words)) {
binds[VAL_WORD_CANON(words)] = -1;
n++;
}
}
}
// Expand target as needed:
if (expand && n > 0) {
// Determine how many new words to add:
for (words = FRM_WORD(target, 1); NOT_END(words); words++)
if (binds[VAL_BIND_CANON(words)]) n--;
// Expand frame by the amount required:
if (n > 0) Expand_Frame(target, n, 0);
else expand = 0;
}
// Maps a word to its value index in the source context.
// Done by marking all source words (in bind table):
words = FRM_WORDS(source)+1;
for (n = 1; NOT_END(words); n++, words++) {
if (IS_NONE(only_words) || binds[VAL_BIND_CANON(words)])
binds[VAL_WORD_CANON(words)] = n;
}
// Foreach word in target, copy the correct value from source:
n = i ? i : 1;
vals = FRM_VALUE(target, n);
for (words = FRM_WORD(target, n); NOT_END(words); words++, vals++) {
if ((m = binds[VAL_BIND_CANON(words)])) {
binds[VAL_BIND_CANON(words)] = 0; // mark it as set
if (!VAL_PROTECTED(words) && (all || IS_UNSET(vals))) {
if (m < 0) SET_UNSET(vals); // no value in source context
else *vals = *FRM_VALUE(source, m);
//Debug_Num("type:", VAL_TYPE(vals));
//Debug_Str(Get_Word_Name(words));
}
}
}
// Add any new words and values:
if (expand) {
REBVAL *val;
words = FRM_WORDS(source)+1;
for (n = 1; NOT_END(words); n++, words++) {
if (binds[VAL_BIND_CANON(words)]) {
// Note: no protect check is needed here
binds[VAL_BIND_CANON(words)] = 0;
val = Append_Frame(target, 0, VAL_BIND_SYM(words));
*val = *FRM_VALUE(source, n);
}
}
}
else {
// Reset bind table (do not use Collect_End):
if (i) {
for (words = FRM_WORD(target, i); NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = 0;
}
else if (IS_BLOCK(only_words)) {
for (words = VAL_BLK_DATA(only_words); NOT_END(words); words++) {
if (IS_WORD(words) || IS_SET_WORD(words)) binds[VAL_WORD_CANON(words)] = 0;
}
}
else {
for (words = FRM_WORDS(source)+1; NOT_END(words); words++)
binds[VAL_BIND_CANON(words)] = 0;
}
}
CHECK_BIND_TABLE;
RESET_TAIL(BUF_WORDS); // allow reuse, trapping ok now
}
