//
// Dump_Values: C
//
// Print values in raw hex; If memory is corrupted this still needs to work.
//
void Dump_Values(RELVAL *vp, REBCNT count)
{
REBYTE buf[2048];
REBYTE *cp;
REBCNT l, n;
REBCNT *bp = (REBCNT*)vp;
const REBYTE *type;
cp = buf;
for (l = 0; l < count; l++) {
REBVAL *val = cast(REBVAL*, bp);
cp = Form_Hex_Pad(cp, l, 8);
*cp++ = ':';
*cp++ = ' ';
type = Get_Type_Name((REBVAL*)bp);
for (n = 0; n < 11; n++) {
if (*type) *cp++ = *type++;
else *cp++ = ' ';
}
*cp++ = ' ';
for (n = 0; n < sizeof(REBVAL) / sizeof(REBCNT); n++) {
cp = Form_Hex_Pad(cp, *bp++, 8);
*cp++ = ' ';
}
n = 0;
if (IS_WORD(val) || IS_GET_WORD(val) || IS_SET_WORD(val)) {
const REBYTE *name = STR_HEAD(VAL_WORD_SPELLING(val));
n = snprintf(
s_cast(cp), sizeof(buf) - (cp - buf), " (%s)", cs_cast(name)
);
}
*(cp + n) = 0;
Debug_Str(s_cast(buf));
cp = buf;
}
}
//
// Emit: C
//
// This is a general "printf-style" utility function, which R3-Alpha used to
// make some formatting tasks easier. It was not applied consistently, and
// some callsites avoided using it because it would be ostensibly slower
// than calling the functions directly.
//
void Emit(REB_MOLD *mo, const char *fmt, ...)
{
va_list va;
va_start(va, fmt);
REBYTE ender = '\0';
for (; *fmt; fmt++) {
switch (*fmt) {
case 'W': { // Word symbol
const REBVAL *any_word = va_arg(va, const REBVAL*);
Append_Spelling(mo->series, VAL_WORD_SPELLING(any_word));
break; }
case 'V': // Value
Mold_Value(mo, va_arg(va, const REBVAL*));
break;
case 'S': // String of bytes
Append_Ascii(mo->series, va_arg(va, const char *));
break;
case 'C': // Char
Append_Codepoint(mo->series, va_arg(va, uint32_t));
break;
case 'I': // Integer
Append_Int(mo->series, va_arg(va, REBINT));
break;
case 'i':
Append_Int_Pad(mo->series, va_arg(va, REBINT), -9);
Trim_Tail(mo, '0');
break;
case '2': // 2 digit int (for time)
Append_Int_Pad(mo->series, va_arg(va, REBINT), 2);
break;
case 'T': { // Type name
REBSTR *type_name = Get_Type_Name(va_arg(va, REBVAL*));
Append_Spelling(mo->series, type_name);
break; }
case 'N': { // Symbol name
REBSTR *spelling = va_arg(va, REBSTR*);
Append_Spelling(mo->series, spelling);
break; }
case '+': // Add #[ if mold/all
if (GET_MOLD_FLAG(mo, MOLD_FLAG_ALL)) {
Append_Ascii(mo->series, "#[");
ender = ']';
}
break;
case 'D': // Datatype symbol: #[type
if (ender != '\0') {
REBSTR *canon = Canon(cast(REBSYM, va_arg(va, int)));
Append_Spelling(mo->series, canon);
Append_Codepoint(mo->series, ' ');
}
else
va_arg(va, REBCNT); // ignore it
break;
default:
Append_Codepoint(mo->series, *fmt);
}
//
// For_Each_Unspecialized_Param: C
//
// We have to take into account specialization of refinements in order to know
// the correct order. If someone has:
//
// foo: func [a [integer!] /b [integer!] /c [integer!]] [...]
//
// They can partially specialize this as :foo/c/b. This makes it seem to the
// caller a function originally written with spec:
//
// [a [integer!] c [integer!] b [integer!]]
//
// But the frame order doesn't change; the information for knowing the order
// is encoded with instructions occupying the non-fully-specialized slots.
// (See %c-specialize.c for a description of the mechanic.)
//
// The true order could be cached when the function is generated, but to keep
// things "simple" we capture the behavior in this routine.
//
// Unspecialized parameters are visited in two passes: unsorted, then sorted.
//
void For_Each_Unspecialized_Param(
REBACT *act,
PARAM_HOOK hook,
void *opaque
){
REBDSP dsp_orig = DSP;
// Do an initial scan to push the partial refinements in the reverse
// order that they apply. While walking the parameters in a potentially
// "unsorted" fashion, offer them to the passed-in hook in case it has a
// use for this first pass (e.g. just counting, to make an array big
// enough to hold what's going to be given to it in the second pass.
REBVAL *param = ACT_PARAMS_HEAD(act);
REBVAL *special = ACT_SPECIALTY_HEAD(act);
REBCNT index = 1;
for (; NOT_END(param); ++param, ++special, ++index) {
if (Is_Param_Hidden(param))
continue; // specialized out, not in interface
Reb_Param_Class pclass = VAL_PARAM_CLASS(param);
if (pclass == REB_P_RETURN or pclass == REB_P_LOCAL)
continue; // locals not in interface
if (not hook(param, false, opaque)) { // false => unsorted pass
DS_DROP_TO(dsp_orig);
return;
}
if (IS_SYM_WORD(special)) {
assert(TYPE_CHECK(param, REB_TS_REFINEMENT));
Move_Value(DS_PUSH(), special);
}
}
// Refinements are now on stack such that topmost is first in-use
// specialized refinement.
// Now second loop, where we print out just the normal args.
//
param = ACT_PARAMS_HEAD(act);
for (; NOT_END(param); ++param) {
if (Is_Param_Hidden(param))
continue;
if (TYPE_CHECK(param, REB_TS_REFINEMENT))
continue;
Reb_Param_Class pclass = VAL_PARAM_CLASS(param);
if (pclass == REB_P_LOCAL or pclass == REB_P_RETURN)
continue;
if (not hook(param, true, opaque)) { // true => sorted pass
DS_DROP_TO(dsp_orig);
return;
}
}
// Now jump around and take care of the partial refinements.
DECLARE_LOCAL (unrefined);
REBDSP dsp = DSP; // highest priority are at *top* of stack, go downward
while (dsp != dsp_orig) {
param = ACT_PARAM(act, VAL_WORD_INDEX(DS_AT(dsp)));
--dsp;
Move_Value(unrefined, param);
assert(TYPE_CHECK(unrefined, REB_TS_REFINEMENT));
TYPE_CLEAR(unrefined, REB_TS_REFINEMENT);
PUSH_GC_GUARD(unrefined);
bool cancel = not hook(unrefined, true, opaque); // true => sorted
DROP_GC_GUARD(unrefined);
if (cancel) {
DS_DROP_TO(dsp_orig);
return;
}
}
// Finally, output any fully unspecialized refinements
param = ACT_PARAMS_HEAD(act);
for (; NOT_END(param); ++param) {
if (Is_Param_Hidden(param))
continue;
if (not TYPE_CHECK(param, REB_TS_REFINEMENT))
continue;
dsp = dsp_orig;
while (dsp != DSP) {
++dsp;
if (SAME_STR(
VAL_WORD_SPELLING(DS_AT(dsp)),
VAL_PARAM_SPELLING(param)
)){
goto continue_unspecialized_loop;
}
}
if (not hook(param, true, opaque)) { // true => sorted pass
DS_DROP_TO(dsp_orig);
return; // stack should be balanced here
}
continue_unspecialized_loop:
NOOP;
}
DS_DROP_TO(dsp_orig);
}
//
// Do_Path_Throws_Core: C
//
// Evaluate an ANY_PATH! REBVAL, starting from the index position of that
// path value and continuing to the end.
//
// The evaluator may throw because GROUP! is evaluated, e.g. `foo/(throw 1020)`
//
// If label_sym is passed in as being non-null, then the caller is implying
// readiness to process a path which may be a function with refinements.
// These refinements will be left in order on the data stack in the case
// that `out` comes back as IS_FUNCTION().
//
// If `opt_setval` is given, the path operation will be done as a "SET-PATH!"
// if the path evaluation did not throw or error. HOWEVER the set value
// is NOT put into `out`. This provides more flexibility on performance in
// the evaluator, which may already have the `val` where it wants it, and
// so the extra assignment would just be overhead.
//
// !!! Path evaluation is one of the parts of R3-Alpha that has not been
// vetted very heavily by Ren-C, and needs a review and overhaul.
//
REBOOL Do_Path_Throws_Core(
REBVAL *out,
REBSTR **label_out,
const RELVAL *path,
REBCTX *specifier,
REBVAL *opt_setval
) {
REBPVS pvs;
REBDSP dsp_orig = DSP;
assert(ANY_PATH(path));
// !!! There is a bug in the dispatch such that if you are running a
// set path, it does not always assign the output, because it "thinks you
// aren't going to look at it". This presumably originated from before
// parens were allowed in paths, and neglects cases like:
//
// foo/(throw 1020): value
//
// We always have to check to see if a throw occurred. Until this is
// streamlined, we have to at minimum set it to something that is *not*
// thrown so that we aren't testing uninitialized memory. A safe trash
// will do, which is unset in release builds.
//
if (opt_setval)
SET_TRASH_SAFE(out);
// None of the values passed in can live on the data stack, because
// they might be relocated during the path evaluation process.
//
assert(!IN_DATA_STACK_DEBUG(out));
assert(!IN_DATA_STACK_DEBUG(path));
assert(!opt_setval || !IN_DATA_STACK_DEBUG(opt_setval));
// Not currently robust for reusing passed in path or value as the output
assert(out != path && out != opt_setval);
assert(!opt_setval || !THROWN(opt_setval));
// Initialize REBPVS -- see notes in %sys-do.h
//
pvs.opt_setval = opt_setval;
pvs.store = out;
pvs.orig = path;
pvs.item = VAL_ARRAY_AT(pvs.orig); // may not be starting at head of PATH!
// The path value that's coming in may be relative (in which case it
// needs to use the specifier passed in). Or it may be specific already,
// in which case we should use the specifier in the value to process
// its array contents.
//
if (IS_RELATIVE(path)) {
#if !defined(NDEBUG)
assert(specifier != SPECIFIED);
if (VAL_RELATIVE(path) != VAL_FUNC(CTX_FRAME_FUNC_VALUE(specifier))) {
Debug_Fmt("Specificity mismatch found in path dispatch");
PROBE_MSG(path, "the path being evaluated");
PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(path)), "expected func");
PROBE_MSG(CTX_FRAME_FUNC_VALUE(specifier), "actual func");
assert(FALSE);
}
#endif
pvs.item_specifier = specifier;
}
else pvs.item_specifier = VAL_SPECIFIER(const_KNOWN(path));
// Seed the path evaluation process by looking up the first item (to
// get a datatype to dispatch on for the later path items)
//
if (IS_WORD(pvs.item)) {
pvs.value = GET_MUTABLE_VAR_MAY_FAIL(pvs.item, pvs.item_specifier);
pvs.value_specifier = SPECIFIED;
if (IS_VOID(pvs.value))
fail (Error_No_Value_Core(pvs.item, pvs.item_specifier));
}
else {
// !!! Ideally there would be some way to deal with writes to
// temporary locations, like this pvs.value...if a set-path sets
// it, then it will be discarded.
COPY_VALUE(pvs.store, VAL_ARRAY_AT(pvs.orig), pvs.item_specifier);
pvs.value = pvs.store;
pvs.value_specifier = SPECIFIED;
}
// Start evaluation of path:
if (IS_END(pvs.item + 1)) {
// If it was a single element path, return the value rather than
// try to dispatch it (would cause a crash at time of writing)
//
// !!! Is this the desired behavior, or should it be an error?
}
else if (Path_Dispatch[VAL_TYPE(pvs.value)]) {
REBOOL threw = Next_Path_Throws(&pvs);
// !!! See comments about why the initialization of out is necessary.
// Without it this assertion can change on some things:
//
// t: now
// t/time: 10:20:03
//
// (It thinks pvs.value has its THROWN bit set when it completed
// successfully. It was a PE_USE_STORE case where pvs.value was reset to
// pvs.store, and pvs.store has its thrown bit set. Valgrind does not
// catch any uninitialized variables.)
//
// There are other cases that do trip valgrind when omitting the
// initialization, though not as clearly reproducible.
//
assert(threw == THROWN(pvs.value));
if (threw) return TRUE;
// Check for errors:
if (NOT_END(pvs.item + 1) && !IS_FUNCTION(pvs.value)) {
//
// Only function refinements should get by this line:
REBVAL specified_orig;
COPY_VALUE(&specified_orig, pvs.orig, specifier);
REBVAL specified_item;
COPY_VALUE(&specified_item, pvs.item, specifier);
fail (Error(RE_INVALID_PATH, &specified_orig, &specified_item));
}
}
else if (!IS_FUNCTION(pvs.value)) {
REBVAL specified;
COPY_VALUE(&specified, pvs.orig, specifier);
fail (Error(RE_BAD_PATH_TYPE, &specified, Type_Of(pvs.value)));
}
if (opt_setval) {
// If SET then we don't return anything
assert(IS_END(pvs.item) + 1);
return FALSE;
}
// If storage was not used, then copy final value back to it:
if (pvs.value != pvs.store)
COPY_VALUE(pvs.store, pvs.value, pvs.value_specifier);
assert(!THROWN(out));
// Return 0 if not function or is :path/word...
if (!IS_FUNCTION(pvs.value)) {
assert(IS_END(pvs.item) + 1);
return FALSE;
}
if (label_out) {
REBVAL refinement;
// When a function is hit, path processing stops as soon as the
// processed sub-path resolves to a function. The path is still sitting
// on the position of the last component of that sub-path. Usually,
// this last component in the sub-path is a word naming the function.
//
if (IS_WORD(pvs.item)) {
*label_out = VAL_WORD_SPELLING(pvs.item);
}
else {
// In rarer cases, the final component (completing the sub-path to
// the function to call) is not a word. Such as when you use a path
// to pick by index out of a block of functions:
//
// functions: reduce [:add :subtract]
// functions/1 10 20
//
// Or when you have an immediate function value in a path with a
// refinement. Tricky to make, but possible:
//
// do reduce [
// to-path reduce [:append 'only] [a] [b]
// ]
//
// !!! When a function was not invoked through looking up a word
// (or a word in a path) to use as a label, there were once three
// different alternate labels used. One was SYM__APPLY_, another
// was ROOT_NONAME, and another was to be the type of the function
// being executed. None are fantastic, we do the type for now.
*label_out = Canon(SYM_FROM_KIND(VAL_TYPE(pvs.value)));
}
// Move on to the refinements (if any)
++pvs.item;
// !!! Currently, the mainline path evaluation "punts" on refinements.
// When it finds a function, it stops the path evaluation and leaves
// the position pvs.path before the list of refinements.
//
// A more elegant solution would be able to process and notice (for
// instance) that `:APPEND/ONLY` should yield a function value that
// has been specialized with a refinement. Path chaining should thus
// be able to effectively do this and give the refined function object
// back to the evaluator or other client.
//
// If a label_sym is passed in, we recognize that a function dispatch
// is going to be happening. We do not want to pay to generate the
// new series that would be needed to make a temporary function that
// will be invoked and immediately GC'd So we gather the refinements
// on the data stack.
//
// This code simulates that path-processing-to-data-stack, but it
// should really be something in dispatch iself. In any case, we put
// refinements on the data stack...and caller knows refinements are
// from dsp_orig to DSP (thanks to accounting, all other operations
// should balance!)
for (; NOT_END(pvs.item); ++pvs.item) { // "the refinements"
if (IS_VOID(pvs.item)) continue;
if (IS_GROUP(pvs.item)) {
//
// Note it is not legal to use the data stack directly as the
// output location for a DO (might be resized)
if (Do_At_Throws(
&refinement,
VAL_ARRAY(pvs.item),
VAL_INDEX(pvs.item),
IS_RELATIVE(pvs.item)
? pvs.item_specifier // if relative, use parent's
: VAL_SPECIFIER(const_KNOWN(pvs.item)) // else embedded
)) {
*out = refinement;
DS_DROP_TO(dsp_orig);
return TRUE;
}
if (IS_VOID(&refinement)) continue;
DS_PUSH(&refinement);
}
else if (IS_GET_WORD(pvs.item)) {
DS_PUSH_TRASH;
*DS_TOP = *GET_OPT_VAR_MAY_FAIL(pvs.item, pvs.item_specifier);
if (IS_VOID(DS_TOP)) {
DS_DROP;
continue;
}
}
else DS_PUSH_RELVAL(pvs.item, pvs.item_specifier);
// Whatever we were trying to use as a refinement should now be
// on the top of the data stack, and only words are legal ATM
//
if (!IS_WORD(DS_TOP)) {
fail (Error(RE_BAD_REFINE, DS_TOP));
}
// Go ahead and canonize the word symbol so we don't have to
// do it each time in order to get a case-insenstive compare
//
INIT_WORD_SPELLING(DS_TOP, VAL_WORD_CANON(DS_TOP));
}
// To make things easier for processing, reverse the refinements on
// the data stack (we needed to evaluate them in forward order).
// This way we can just pop them as we go, and know if they weren't
// all consumed if it doesn't get back to `dsp_orig` by the end.
if (dsp_orig != DSP) {
REBVAL *bottom = DS_AT(dsp_orig + 1);
REBVAL *top = DS_TOP;
while (top > bottom) {
refinement = *bottom;
*bottom = *top;
*top = refinement;
top--;
bottom++;
}
}
}
else {
// !!! Historically this just ignores a result indicating this is a
// function with refinements, e.g. ':append/only'. However that
// ignoring seems unwise. It should presumably create a modified
// function in that case which acts as if it has the refinement.
//
// If the caller did not pass in a label pointer we assume they are
// likely not ready to process any refinements.
//
if (NOT_END(pvs.item + 1))
fail (Error(RE_TOO_LONG)); // !!! Better error or add feature
}
return FALSE;
}
