*/ 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;
}
*/ REBINT PD_Frame(REBPVS *pvs)
/*
** pvs->value points to the first value in frame (SELF).
**
***********************************************************************/
{
REBCNT sym;
REBCNT s;
REBVAL *word;
REBVAL *val;
if (IS_WORD(pvs->select)) {
sym = VAL_WORD_SYM(pvs->select);
s = SYMBOL_TO_CANON(sym);
word = BLK_SKIP(VAL_FRM_WORDS(pvs->value), 1);
for (val = pvs->value + 1; NOT_END(val); val++, word++) {
if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) {
if (VAL_GET_OPT(word, OPTS_HIDE)) break;
if (VAL_PROTECTED(word)) Trap1(RE_LOCKED_WORD, word);
pvs->value = val;
return PE_SET;
}
}
}
return PE_BAD_SELECT;
}
RL_API u32 *RL_Words_Of_Object(REBSER *obj)
/*
** Returns information about the object.
**
** Returns:
** Returns an array of words used as fields of the object.
** Arguments:
** obj - object pointer (e.g. from RXA_OBJECT)
** Notes:
** Returns a word array similar to MAP_WORDS().
** The array is allocated with OS_MAKE. You can OS_FREE it any time.
*/
{
REBCNT index;
u32 *words;
REBVAL *syms;
syms = FRM_WORD(obj, 1);
words = OS_MAKE(obj->tail * sizeof(u32)); // One less, because SELF not included.
for (index = 0; index < (obj->tail-1); syms++, index++) {
words[index] = VAL_BIND_CANON(syms);
}
words[index] = 0;
return words;
}
*/ 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 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;
}
*/ REBCNT Find_Word_Index(REBSER *frame, REBCNT sym, REBFLG always)
/*
** Search a frame looking for the given word symbol.
** Return the frame index for a word. Locate it by matching
** the canon word identifiers. Return 0 if not found.
**
***********************************************************************/
{
REBCNT len = SERIES_TAIL(FRM_WORD_SERIES(frame));
REBVAL *word = FRM_WORDS(frame) + 1;
REBCNT n;
REBCNT s;
s = SYMBOL_TO_CANON(sym); // always compare to CANON sym
for (n = 1; n < len; n++, word++)
if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word))
return (!always && VAL_GET_OPT(word, OPTS_HIDE)) ? 0 : n;
return 0;
}
*/ REBCNT Find_Arg_Index(REBSER *args, REBCNT sym)
/*
** Find function arg word in function arg "frame".
**
***********************************************************************/
{
REBCNT n;
REBCNT s;
REBVAL *word;
REBCNT len;
s = SYMBOL_TO_CANON(sym); // always compare to CANON sym
word = BLK_SKIP(args, 1);
len = SERIES_TAIL(args);
for (n = 1; n < len; n++, word++)
if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) return n;
return 0;
}
xx*/ void Dump_Frame(REBSER *frame, REBINT limit)
/*
***********************************************************************/
{
REBINT n;
REBVAL *values = FRM_VALUES(frame);
REBVAL *words = FRM_WORDS(frame);
if (limit == -1 || limit > (REBINT)SERIES_TAIL(frame))
limit = SERIES_TAIL(frame);
Debug_Fmt("Frame: %x len = %d", frame, SERIES_TAIL(frame));
for (n = 0; n < limit; n++, values++, words++) {
Debug_Fmt(" %02d: %s (%s) [%s]",
n,
Get_Sym_Name(VAL_BIND_SYM(words)),
Get_Sym_Name(VAL_BIND_CANON(words)),
Get_Type_Name(values)
);
}
if (limit >= (REBINT)SERIES_TAIL(frame) && NOT_END(words))
Debug_Fmt("** Word list not terminated! Type: %d, Tail: %d", VAL_TYPE(words), SERIES_TAIL(frame));
}
*/ 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
}
*/ REBINT Find_Key(REBSER *series, REBSER *hser, REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
/*
** Returns hash index (either the match or the new one).
** A return of zero is valid (as a hash index);
**
** Wide: width of record (normally 2, a key and a value).
**
** Modes:
** 0 - search, return hash if found or not
** 1 - search, return hash, else return -1 if not
** 2 - search, return hash, else append value and return -1
**
***********************************************************************/
{
REBCNT *hashes;
REBCNT skip;
REBCNT hash;
REBCNT len;
REBCNT n;
REBVAL *val;
// Compute hash for value:
len = hser->tail;
hash = Hash_Value(key, len);
if (!hash) Trap_Type_DEAD_END(key);
// Determine skip and first index:
skip = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
if (skip == 0) skip = 1;
hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;
// Scan hash table for match:
hashes = (REBCNT*)hser->data;
if (ANY_WORD(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
ANY_WORD(val) &&
(VAL_WORD_SYM(key) == VAL_BIND_SYM(val) ||
(!cased && VAL_WORD_CANON(key) == VAL_BIND_CANON(val)))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
else if (ANY_BINSTR(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
VAL_TYPE(val) == VAL_TYPE(key)
&& 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
} else {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
// Append new value the target series:
if (mode > 1) {
hashes[hash] = SERIES_TAIL(series)+1;
//Debug_Num("hash:", hashes[hash]);
Append_Series(series, (REBYTE*)key, wide);
//Dump_Series(series, "hash");
}
return (mode > 0) ? NOT_FOUND : hash;
}