// // 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; }