Пример #1
0
*/	REBFLG Copy_Function(REBVAL *value, REBVAL *args)
/*
***********************************************************************/
{
	REBVAL *spec = VAL_BLK(args);
	REBVAL *body = VAL_BLK_SKIP(args, 1);

	if (IS_END(spec)) body = 0;
	else {
		// Spec given, must be block or *
		if (IS_BLOCK(spec)) {
			VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
			VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
		} else
			if (!IS_STAR(spec)) return FALSE;
	}

	if (body && !IS_END(body)) {
		if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE;
		// Body must be block:
		if (!IS_BLOCK(body)) return FALSE;
		VAL_FUNC_BODY(value) = VAL_SERIES(body);
	}
	// No body, use protytpe:
	else if (IS_FUNCTION(value) || IS_CLOSURE(value))
		VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value));

	// Rebind function words:
	if (IS_FUNCTION(value))
		Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));

	return TRUE;
}
Пример #2
0
//
//  VAL_SPECIFIC_Debug: C
//
REBCTX *VAL_SPECIFIC_Debug(const REBVAL *v)
{
    REBCTX *specific;

    assert(NOT(GET_VAL_FLAG(v, VALUE_FLAG_RELATIVE)));
    assert(
        ANY_WORD(v)
        || ANY_ARRAY(v)
        || IS_VARARGS(v)
        || IS_FUNCTION(v)
        || ANY_CONTEXT(v)
    );

    specific = VAL_SPECIFIC_COMMON(v);

    if (specific != SPECIFIED) {
        //
        // Basic sanity check: make sure it's a context at all
        //
        if (!GET_CTX_FLAG(specific, ARRAY_FLAG_VARLIST)) {
            printf("Non-CONTEXT found as specifier in specific value\n");
            Panic_Series(cast(REBSER*, specific)); // may not be series either
        }

        // While an ANY-WORD! can be bound specifically to an arbitrary
        // object, an ANY-ARRAY! only becomes bound specifically to frames.
        // The keylist for a frame's context should come from a function's
        // paramlist, which should have a FUNCTION! value in keylist[0]
        //
        if (ANY_ARRAY(v))
            assert(IS_FUNCTION(CTX_ROOTKEY(specific)));
    }

    return specific;
}
Пример #3
0
void calculate_presses() {
  uint8_t usb_presses = 0;
  uint32_t i;
  for (i = 0; i < LAYER_COUNT * KEY_COUNT; i++) {
    if (matrix_state[i] >= DEBOUNCE_PASSES ) {
      uint8_t layer = i / KEY_COUNT;
      uint8_t row = (i - layer * KEY_COUNT) / COLUMN_COUNT;
      // Keys are wired from right to left but layout goes from left to right
      uint8_t column = COLUMN_COUNT - (i - layer * KEY_COUNT - row * COLUMN_COUNT + 1);
      uint64_t keycode = layers[layer][row * COLUMN_COUNT + column];
      //DEBUG("keypress: ");
      //debug_phex64(keycode);
      //DEBUG("\r\n");
      if (IS_FUNCTION(keycode)) {
        // regular layout functions
        (layer_functions[keycode & FUNCTION_MASK])();
      } else if (IS_PRE_FUNCTION(keycode)) {
        // pre-invoke functions have already been processed
      } else if (IS_LAYER(keycode)) {
        // layer set
        //DEBUG("layer");
        current_layer_number = keycode & LAYER_MASK;
      } else if (IS_MODIFIER_KEY(keycode)) {
        // modifier keys do not take a spot in keys array
        keyboard_modifier_keys |= MODIFIERS(keycode);
      } else if (IS_REGULAR_KEY(keycode)) {
        if (usb_presses < 6) {
          keyboard_modifier_keys |= MODIFIERS(keycode);
          keyboard_keys[usb_presses++] = KEY(keycode);
        }
      }
    }
  }
}
Пример #4
0
//
//  Val_Init_Context: C
//
// Common routine for initializing OBJECT, MODULE!, PORT!, and ERROR!
//
// A fully constructed context can reconstitute the ANY-CONTEXT! REBVAL that
// is its canon form from a single pointer...the REBVAL sitting in the 0 slot
// of the context's varlist.
//
void Val_Init_Context(REBVAL *out, enum Reb_Kind kind, REBCTX *context) {
    //
    // In a debug build we check to make sure the type of the embedded value
    // matches the type of what is intended (so someone who thinks they are
    // initializing a REB_OBJECT from a CONTEXT does not accidentally get a
    // REB_ERROR, for instance.)  It's a point for several other integrity
    // checks as well.
    //
#if !defined(NDEBUG)
    REBVAL *value = CTX_VALUE(context);

    assert(ANY_CONTEXT(value));
    assert(CTX_TYPE(context) == kind);

    assert(VAL_CONTEXT(value) == context);

    if (!CTX_KEYLIST(context)) {
        Debug_Fmt("Context found with no keylist set");
        Panic_Context(context);
    }

    assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST));

    // !!! Historically spec is a frame of an object for a "module spec",
    // may want to use another word of that and make a block "spec"
    //
    if (IS_FRAME(CTX_VALUE(context))) {
        assert(IS_FUNCTION(FUNC_VALUE(CTX_FRAME_FUNC(context))));
    }
    else
        assert(
            NOT(CTX_SPEC(context))
            || ANY_CONTEXT(CTX_VALUE(CTX_SPEC(context)))
        );
#endif

    // Some contexts (stack frames in particular) start out unmanaged, and
    // then check to see if an operation like Val_Init_Context set them to
    // managed.  If not, they will free the context.  This avoids the need
    // for the garbage collector to have to deal with the series if there's
    // no reason too.
    //
    // Here is a case of where we mark the context as having an extant usage,
    // so that at minimum this value must become unreachable from the root GC
    // set before they are GC'd.  For another case, see INIT_WORD_CONTEXT(),
    // where an ANY-WORD! can mark a context as in use.
    //
    ENSURE_ARRAY_MANAGED(CTX_VARLIST(context));

    // Keylists are different, because they may-or-may-not-be-reused by some
    // operations.  There needs to be a uniform policy on their management,
    // or certain routines would return "sometimes managed, sometimes not"
    // keylist series...a bad invariant.
    //
    ASSERT_ARRAY_MANAGED(CTX_KEYLIST(context));

    *out = *CTX_VALUE(context);
}
Пример #5
0
static REBOOL Same_Func(const RELVAL *val, const RELVAL *arg)
{
    assert(IS_FUNCTION(val) && IS_FUNCTION(arg));

    if (VAL_FUNC_PARAMLIST(val) == VAL_FUNC_PARAMLIST(arg)) {
        assert(VAL_FUNC_DISPATCHER(val) == VAL_FUNC_DISPATCHER(arg));
        assert(VAL_FUNC_BODY(val) == VAL_FUNC_BODY(arg));

        // All functions that have the same paramlist are not necessarily the
        // "same function".  For instance, every RETURN shares a common
        // paramlist, but the binding is different in the REBVAL instances
        // in order to know where to "exit from".

        return LOGICAL(VAL_BINDING(val) == VAL_BINDING(arg));
    }

    return FALSE;
}
Пример #6
0
char CORD__pos_fetch(register CORD_pos p)
{
    /* Leaf is a function node */
    struct CORD_pe * pe = &((p)[0].path[(p)[0].path_len]);
    CORD leaf = pe -> pe_cord;
    register struct Function * f = &(((CordRep *)leaf) -> function);

    if (!IS_FUNCTION(leaf)) ABORT("CORD_pos_fetch: bad leaf");
    return ((*(f -> fn))(p[0].cur_pos - pe -> pe_start_pos, f -> client_data));
}
Пример #7
0
*/  void Bind_Frame(REBSER *obj)
/*
**      Clone a frame, knowing which types of values need to be
**		copied, deep copied, and rebound.
**
***********************************************************************/
{
	REBVAL *val;
	REBOOL funcs = FALSE;

	//DISABLE_GC;
	// Copy functions:
	for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
		if (IS_FUNCTION(val)) {
			Clone_Function(val, val); 
			funcs = TRUE;
		}
		else if (IS_CLOSURE(val)) {
			funcs = TRUE;
		}
	}

	// Rebind all values:
	Bind_Block(obj, BLK_SKIP(obj, 1), BIND_DEEP | BIND_FUNC);

	if (funcs) {
		// Rebind functions:
		for (val = BLK_SKIP(obj, 1); NOT_END(val); val++) {
			if (IS_FUNCTION(val)) {
				Bind_Relative(VAL_FUNC_ARGS(val), VAL_FUNC_BODY(val), VAL_FUNC_BODY(val));
			}
			else if (IS_CLOSURE(val)) {
			}
		}
	}

	//ENABLE_GC;
}
Пример #8
0
STOID Mold_Function(REBVAL *value, REB_MOLD *mold)
{
	Pre_Mold(value, mold);

	Append_Byte(mold->series, '[');

	Mold_Block_Series(mold, VAL_FUNC_SPEC(value), 0, 0); //// & ~(1<<MOPT_MOLD_ALL)); // Never literalize it (/all).

	if (IS_FUNCTION(value) || IS_CLOSURE(value))
		Mold_Block_Series(mold, VAL_FUNC_BODY(value), 0, 0);

	Append_Byte(mold->series, ']');
	End_Mold(mold);
}
Пример #9
0
*/  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);
	}
}
Пример #10
0
char CORD__pos_fetch(CORD_pos p)
{
    /* Leaf is a function node */
    struct CORD_pe * pe;
    CORD leaf;
    struct Function * f;

    if (!CORD_pos_valid(p))
        ABORT("CORD_pos_fetch: invalid argument");
    pe = &p[0].path[p[0].path_len];
    leaf = pe -> pe_cord;
    if (!IS_FUNCTION(leaf))
        ABORT("CORD_pos_fetch: bad leaf");
    f = &((CordRep *)leaf)->function;
    return ((*(f -> fn))(p[0].cur_pos - pe -> pe_start_pos, f -> client_data));
}
Пример #11
0
*/  void Bind_Stack_Block(REBSER *body, REBSER *block)
/*
***********************************************************************/
{
	REBINT dsf = DSF;

	// Find body (frame) on stack:
	while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) {
		dsf = PRIOR_DSF(dsf);
		if (dsf <= 0) Trap0(RE_NOT_DEFINED);  // better message !!!!
	}

	if (IS_FUNCTION(DSF_FUNC(dsf))) {
		Bind_Relative(VAL_FUNC_ARGS(DSF_FUNC(dsf)), body, block);
	}
}
Пример #12
0
REB_R N_debug(REBFRM *frame_) {
    PARAM(1, value);
    REBVAL *value = ARG(value);

    if (IS_VOID(value)) {
        //
        // e.g. just `>> debug` and [enter] in the console.  Ideally this
        // would shift the REPL into a mode where all commands issued were
        // assumed to be in the debug dialect, similar to Ren Garden's
        // modalities like `debug>>`.
        //
        Debug_Fmt("Sorry, there is no debug>> 'mode' yet in the console.");
        goto modify_with_confidence;
    }

    if (IS_INTEGER(value) || IS_FRAME(value) || IS_FUNCTION(value)) {
        REBFRM *frame;

        // We pass TRUE here to account for an extra stack level... the one
        // added by DEBUG itself, which presumably should not count.
        //
        if (!(frame = Frame_For_Stack_Level(&HG_Stack_Level, value, TRUE)))
            fail (Error_Invalid_Arg(value));

        Val_Init_Block(D_OUT, Make_Where_For_Frame(frame));
        return R_OUT;
    }

    assert(IS_BLOCK(value));

    Debug_Fmt(
        "Sorry, but the `debug [...]` dialect is not defined yet.\n"
        "Change the stack level (integer!, frame!, function!)\n"
        "Or try out these commands:\n"
        "\n"
        "    BREAKPOINT, RESUME, BACKTRACE\n"
    );

modify_with_confidence:
    Debug_Fmt(
        "(Note: Ren-C is 'modify-with-confidence'...so just because a debug\n"
        "feature you want isn't implemented doesn't mean you can't add it!)\n"
    );

    return R_BLANK;
}
Пример #13
0
*/  static void Bind_Values_Inner_Loop(REBINT *binds, REBVAL value[], REBSER *frame, REBCNT mode)
/*
**		Bind_Values_Core() sets up the binding table and then calls
**		this recursive routine to do the actual binding.
**
***********************************************************************/
{
	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?
			REBCNT n = binds[VAL_WORD_CANON(value)];
			if (n != 0) {
				if (n == NO_RESULT) n = 0; // SELF word
				assert(n < SERIES_TAIL(frame));
				// 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)))) {
					Expand_Frame(frame, 1, 1);
					Append_Frame(frame, value, 0);
					binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
				}
			}
		}
		else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
			Bind_Values_Inner_Loop(
				binds, VAL_BLK_DATA(value), frame, mode
			);
		else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
			Bind_Values_Inner_Loop(
				binds, BLK_HEAD(VAL_FUNC_BODY(value)), frame, mode
			);
	}
}
Пример #14
0
//
//  Rebind_Values_Deep: C
//
// Rebind all words that reference src target to dst target.
// Rebind is always deep.
//
void Rebind_Values_Deep(
    REBCTX *src,
    REBCTX *dst,
    RELVAL *head,
    struct Reb_Binder *opt_binder
) {
    RELVAL *value = head;
    for (; NOT_END(value); value++) {
        if (ANY_ARRAY(value)) {
            Rebind_Values_Deep(src, dst, VAL_ARRAY_AT(value), opt_binder);
        }
        else if (
            ANY_WORD(value)
            && GET_VAL_FLAG(value, WORD_FLAG_BOUND)
            && !GET_VAL_FLAG(value, VALUE_FLAG_RELATIVE)
            && VAL_WORD_CONTEXT(KNOWN(value)) == src
        ) {
            INIT_WORD_CONTEXT(value, dst);

            if (opt_binder != NULL) {
                INIT_WORD_INDEX(
                    value,
                    Try_Get_Binder_Index(opt_binder, VAL_WORD_CANON(value))
                );
            }
        }
        else if (IS_FUNCTION(value) && IS_FUNCTION_INTERPRETED(value)) {
            //
            // !!! Extremely questionable feature--walking into function
            // bodies and changing them.  This R3-Alpha concept was largely
            // broken (didn't work for closures) and created a lot of extra
            // garbage (inheriting an object's methods meant making deep
            // copies of all that object's method bodies...each time).
            // Ren-C has a different idea in the works.
            //
            Rebind_Values_Deep(
                src, dst, VAL_FUNC_BODY(value), opt_binder
            );
        }
    }
}
Пример #15
0
*/  void Bind_Stack_Word(REBSER *body, REBVAL *word)
/*
***********************************************************************/
{
	REBINT dsf = DSF;
	REBINT index;

	// Find body (frame) on stack:
	while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) {
		dsf = PRIOR_DSF(dsf);
		if (dsf <= 0) Trap1(RE_NOT_IN_CONTEXT, word);
	}

	if (IS_FUNCTION(DSF_FUNC(dsf))) {
		index = Find_Arg_Index(VAL_FUNC_ARGS(DSF_FUNC(dsf)), VAL_WORD_SYM(word));
		if (!index) Trap1(RE_NOT_IN_CONTEXT, word);
		VAL_WORD_FRAME(word) = body;
		VAL_WORD_INDEX(word) = -index;
	} else
		Crash(9100); // !!!  function is not there!
}
Пример #16
0
*/  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);
	}
}
Пример #17
0
SV *
toPerl(USER_OBJECT_ val, Rboolean perlOwned)
{
 int n = GET_LENGTH(val);
 dTHX;
 SV *sv = &sv_undef;

  if(val == NULL_USER_OBJECT)
     return(sv);

  if(isRSReferenceObject(val)){
    return(getForeignPerlReference(val));
  }

  if(GET_LENGTH(GET_CLASS(val))) {
      SV *o = userLevelConversionToPerl(val);
      if(!o)
	  return(o);
  }


 if(n == 1) {
  if(IS_CHARACTER(val))
      sv = newSVpv(CHAR_DEREF(STRING_ELT(val, 0)), 0);
  else if(IS_LOGICAL(val))
      sv = newSViv(LOGICAL_DATA(val)[0]);
  else if(IS_INTEGER(val))
      sv = newSViv(INTEGER_DATA(val)[0]);
  else if(IS_NUMERIC(val))
      sv = newSVnv(NUMERIC_DATA(val)[0]);
  else if(IS_FUNCTION(val)) 
      sv = RPerl_createRProxy(val);
 } else {
  AV *arr;
  int i;
    arr = newAV();
    SvREFCNT_inc(arr);
    if(n > 0)
      av_extend(arr, n);
 /* Did try using av_make() and storing the SVs in an array first, but didn't fix the problem
    of bizarre array.
  */
 for(i = 0; i < n ; i++) {
  if(IS_CHARACTER(val))
      sv = newSVpv(CHAR_DEREF(STRING_ELT(val, i)), 0);
  else if(IS_LOGICAL(val))
      sv = newSViv(LOGICAL_DATA(val)[i]);
  else if(IS_INTEGER(val))
      sv = newSViv(INTEGER_DATA(val)[i]);
  else if(IS_NUMERIC(val))
      sv = newSVnv(NUMERIC_DATA(val)[i]);

  SvREFCNT_inc(sv);
  av_push(arr, sv);
 }
   sv = (SV *) arr;
   SvREFCNT_dec(arr);

#if 0
  {SV *rv = newSVrv(arr, NULL);
   sv = rv;
  }
#endif
 }

 if(perlOwned)
#if 0 /*XXX Just experimenting */
   sv = sv_2mortal(sv);
#else
   sv = SvREFCNT_inc(sv);
#endif

 return(sv);
}
Пример #18
0
//
//  Do_Breakpoint_Throws: C
//
// A call to Do_Breakpoint_Throws does delegation to a hook in the host, which
// (if registered) will generally start an interactive session for probing the
// environment at the break.  The `resume` native cooperates by being able to
// give back a value (or give back code to run to produce a value) that the
// call to breakpoint returns.
//
// RESUME has another feature, which is to be able to actually unwind and
// simulate a return /AT a function *further up the stack*.  (This may be
// switched to a feature of a "STEP OUT" command at some point.)
//
REBOOL Do_Breakpoint_Throws(
    REBVAL *out,
    REBOOL interrupted, // Ctrl-C (as opposed to a BREAKPOINT)
    const REBVAL *default_value,
    REBOOL do_default
) {
    REBVAL *target = NONE_VALUE;

    REBVAL temp;
    VAL_INIT_WRITABLE_DEBUG(&temp);

    if (!PG_Breakpoint_Quitting_Hook) {
        //
        // Host did not register any breakpoint handler, so raise an error
        // about this as early as possible.
        //
        fail (Error(RE_HOST_NO_BREAKPOINT));
    }

    // We call the breakpoint hook in a loop, in order to keep running if any
    // inadvertent FAILs or THROWs occur during the interactive session.
    // Only a conscious call of RESUME speaks the protocol to break the loop.
    //
    while (TRUE) {
        struct Reb_State state;
        REBCTX *error;

    push_trap:
        PUSH_TRAP(&error, &state);

        // The host may return a block of code to execute, but cannot
        // while evaluating do a THROW or a FAIL that causes an effective
        // "resumption".  Halt is the exception, hence we PUSH_TRAP and
        // not PUSH_UNHALTABLE_TRAP.  QUIT is also an exception, but a
        // desire to quit is indicated by the return value of the breakpoint
        // hook (which may or may not decide to request a quit based on the
        // QUIT command being run).
        //
        // The core doesn't want to get involved in presenting UI, so if
        // an error makes it here and wasn't trapped by the host first that
        // is a bug in the host.  It should have done its own PUSH_TRAP.
        //
        if (error) {
        #if !defined(NDEBUG)
            REBVAL error_value;
            VAL_INIT_WRITABLE_DEBUG(&error_value);

            Val_Init_Error(&error_value, error);
            PROBE_MSG(&error_value, "Error not trapped during breakpoint:");
            Panic_Array(CTX_VARLIST(error));
        #endif

            // In release builds, if an error managed to leak out of the
            // host's breakpoint hook somehow...just re-push the trap state
            // and try it again.
            //
            goto push_trap;
        }

        // Call the host's breakpoint hook.
        //
        if (PG_Breakpoint_Quitting_Hook(&temp, interrupted)) {
            //
            // If a breakpoint hook returns TRUE that means it wants to quit.
            // The value should be the /WITH value (as in QUIT/WITH)
            //
            assert(!THROWN(&temp));
            *out = *ROOT_QUIT_NATIVE;
            CONVERT_NAME_TO_THROWN(out, &temp, FALSE);
            return TRUE; // TRUE = threw
        }

        // If a breakpoint handler returns FALSE, then it should have passed
        // back a "resume instruction" triggered by a call like:
        //
        //     resume/do [fail "This is how to fail from a breakpoint"]
        //
        // So now that the handler is done, we will allow any code handed back
        // to do whatever FAIL it likes vs. trapping that here in a loop.
        //
        DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

        // Decode and process the "resume instruction"
        {
            struct Reb_Frame *frame;
            REBVAL *mode;
            REBVAL *payload;

            assert(IS_GROUP(&temp));
            assert(VAL_LEN_HEAD(&temp) == RESUME_INST_MAX);

            mode = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_MODE);
            payload = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_PAYLOAD);
            target = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_TARGET);

            // The first thing we need to do is determine if the target we
            // want to return to has another breakpoint sandbox blocking
            // us.  If so, what we need to do is actually retransmit the
            // resume instruction so it can break that wall, vs. transform
            // it into an EXIT/FROM that would just get intercepted.
            //
            if (!IS_NONE(target)) {
            #if !defined(NDEBUG)
                REBOOL found = FALSE;
            #endif

                for (frame = FS_TOP; frame != NULL; frame = frame->prior) {
                    if (frame->mode != CALL_MODE_FUNCTION)
                        continue;

                    if (
                        frame != FS_TOP
                        && FUNC_CLASS(frame->func) == FUNC_CLASS_NATIVE
                        && (
                            FUNC_CODE(frame->func) == &N_pause
                            || FUNC_CODE(frame->func) == &N_breakpoint
                        )
                    ) {
                        // We hit a breakpoint (that wasn't this call to
                        // breakpoint, at the current FS_TOP) before finding
                        // the sought after target.  Retransmit the resume
                        // instruction so that level will get it instead.
                        //
                        *out = *ROOT_RESUME_NATIVE;
                        CONVERT_NAME_TO_THROWN(out, &temp, FALSE);
                        return TRUE; // TRUE = thrown
                    }

                    if (IS_FRAME(target)) {
                        if (NOT(frame->flags & DO_FLAG_FRAME_CONTEXT))
                            continue;
                        if (
                            VAL_CONTEXT(target)
                            == AS_CONTEXT(frame->data.context)
                        ) {
                            // Found a closure matching the target before we
                            // reached a breakpoint, no need to retransmit.
                            //
                        #if !defined(NDEBUG)
                            found = TRUE;
                        #endif
                            break;
                        }
                    }
                    else {
                        assert(IS_FUNCTION(target));
                        if (frame->flags & DO_FLAG_FRAME_CONTEXT)
                            continue;
                        if (VAL_FUNC(target) == frame->func) {
                            //
                            // Found a function matching the target before we
                            // reached a breakpoint, no need to retransmit.
                            //
                        #if !defined(NDEBUG)
                            found = TRUE;
                        #endif
                            break;
                        }
                    }
                }

                // RESUME should not have been willing to use a target that
                // is not on the stack.
                //
            #if !defined(NDEBUG)
                assert(found);
            #endif
            }

            if (IS_NONE(mode)) {
                //
                // If the resume instruction had no /DO or /WITH of its own,
                // then it doesn't override whatever the breakpoint provided
                // as a default.  (If neither the breakpoint nor the resume
                // provided a /DO or a /WITH, result will be UNSET.)
                //
                goto return_default; // heeds `target`
            }

            assert(IS_LOGIC(mode));

            if (VAL_LOGIC(mode)) {
                if (DO_VAL_ARRAY_AT_THROWS(&temp, payload)) {
                    //
                    // Throwing is not compatible with /AT currently.
                    //
                    if (!IS_NONE(target))
                        fail (Error_No_Catch_For_Throw(&temp));

                    // Just act as if the BREAKPOINT call itself threw
                    //
                    *out = temp;
                    return TRUE; // TRUE = thrown
                }

                // Ordinary evaluation result...
            }
            else
                temp = *payload;
        }

        // The resume instruction will be GC'd.
        //
        goto return_temp;
    }

    DEAD_END;

return_default:

    if (do_default) {
        if (DO_VAL_ARRAY_AT_THROWS(&temp, default_value)) {
            //
            // If the code throws, we're no longer in the sandbox...so we
            // bubble it up.  Note that breakpoint runs this code at its
            // level... so even if you request a higher target, any throws
            // will be processed as if they originated at the BREAKPOINT
            // frame.  To do otherwise would require the EXIT/FROM protocol
            // to add support for DO-ing at the receiving point.
            //
            *out = temp;
            return TRUE; // TRUE = thrown
        }
    }
    else
        temp = *default_value; // generally UNSET! if no /WITH

return_temp:

    // The easy case is that we just want to return from breakpoint
    // directly, signaled by the target being NONE!.
    //
    if (IS_NONE(target)) {
        *out = temp;
        return FALSE; // FALSE = not thrown
    }

    // If the target is a function, then we're looking to simulate a return
    // from something up the stack.  This uses the same mechanic as
    // definitional returns--a throw named by the function or closure frame.
    //
    // !!! There is a weak spot in definitional returns for FUNCTION! that
    // they can only return to the most recent invocation; which is a weak
    // spot of FUNCTION! in general with stack relative variables.  Also,
    // natives do not currently respond to definitional returns...though
    // they can do so just as well as FUNCTION! can.
    //
    *out = *target;
    CONVERT_NAME_TO_THROWN(out, &temp, TRUE);

    return TRUE; // TRUE = thrown
}
Пример #19
0
//
//  Frame_For_Stack_Level: C
//
// Level can be an UNSET!, an INTEGER!, an ANY-FUNCTION!, or a FRAME!.  If
// level is UNSET! then it means give whatever the first call found is.
//
// Returns NULL if the given level number does not correspond to a running
// function on the stack.
//
// Can optionally give back the index number of the stack level (counting
// where the most recently pushed stack level is the lowest #)
//
// !!! Unfortunate repetition of logic inside of BACKTRACE; find a way to
// unify the logic for omitting things like breakpoint frames, or either
// considering pending frames or not...
//
struct Reb_Frame *Frame_For_Stack_Level(
    REBCNT *number_out,
    const REBVAL *level,
    REBOOL skip_current
) {
    struct Reb_Frame *frame = FS_TOP;
    REBOOL first = TRUE;
    REBINT num = 0;

    if (IS_INTEGER(level)) {
        if (VAL_INT32(level) < 0) {
            //
            // !!! fail() here, or just return NULL?
            //
            return NULL;
        }
    }

    // We may need to skip some number of frames, if there have been stack
    // levels added since the numeric reference point that "level" was
    // supposed to refer to has changed.  For now that's only allowed to
    // be one level, because it's rather fuzzy which stack levels to
    // omit otherwise (pending? parens?)
    //
    if (skip_current)
        frame = frame->prior;

    for (; frame != NULL; frame = frame->prior) {
        if (frame->mode != CALL_MODE_FUNCTION) {
            //
            // Don't consider pending calls, or GROUP!, or any non-invoked
            // function as a candidate to target.
            //
            // !!! The inability to target a GROUP! by number is an artifact
            // of implementation, in that there's no hook in Do_Core() at
            // the point of group evaluation to process the return.  The
            // matter is different with a pending function call, because its
            // arguments are only partially processed--hence something
            // like a RESUME/AT or an EXIT/FROM would not know which array
            // index to pick up running from.
            //
            continue;
        }

        if (first) {
            if (
                IS_FUNCTION_AND(FUNC_VALUE(frame->func), FUNC_CLASS_NATIVE)
                && (
                    FUNC_CODE(frame->func) == &N_pause
                    || FUNC_CODE(frame->func) == N_breakpoint
                )
            ) {
                // this is considered the "0".  Return it only if 0 was requested
                // specifically (you don't "count down to it");
                //
                if (IS_INTEGER(level) && num == VAL_INT32(level))
                    goto return_maybe_set_number_out;
                else {
                    first = FALSE;
                    continue;
                }
            }
            else {
                ++num; // bump up from 0
            }
        }

        if (IS_INTEGER(level) && num == VAL_INT32(level))
            goto return_maybe_set_number_out;

        first = FALSE;

        if (frame->mode != CALL_MODE_FUNCTION) {
            //
            // Pending frames don't get numbered
            //
            continue;
        }

        if (IS_UNSET(level) || IS_NONE(level)) {
            //
            // Take first actual frame if unset or none
            //
            goto return_maybe_set_number_out;
        }
        else if (IS_INTEGER(level)) {
            ++num;
            if (num == VAL_INT32(level))
                goto return_maybe_set_number_out;
        }
        else if (IS_FRAME(level)) {
            if (
                (frame->flags & DO_FLAG_FRAME_CONTEXT)
                && frame->data.context == VAL_CONTEXT(level)
            ) {
                goto return_maybe_set_number_out;
            }
        }
        else {
            assert(IS_FUNCTION(level));
            if (VAL_FUNC(level) == frame->func)
                goto return_maybe_set_number_out;
        }
    }

    // Didn't find it...
    //
    return NULL;

return_maybe_set_number_out:
    if (number_out)
        *number_out = num;
    return frame;
}
Пример #20
0
//
//  Do_String()
//
// This is a version of a routine that was offered by the RL_Api, which has
// been expanded here in order to permit the necessary customizations for
// interesting REPL behavior w.r.t. binding, error handling, and response
// to throws.
//
// !!! Now that this code has been moved into the host, the convoluted
// integer-return-scheme can be eliminated and the code integrated more
// clearly into the surrounding calls.
//
int Do_String(
    int *exit_status,
    REBVAL *out,
    const REBYTE *text,
    REBOOL at_breakpoint
) {
    struct Reb_State state;
    REBCTX *error;

    // Breakpoint REPLs are nested, and we may wish to jump out of them to
    // the topmost level via a HALT.  However, all other errors need to be
    // confined, so that if one is doing evaluations during the pause of
    // a breakpoint an error doesn't "accidentally resume" by virtue of
    // jumping the stack out of the REPL.
    //
    // The topmost layer REPL, however, needs to catch halts in order to
    // keep control and not crash out.
    //
    if (at_breakpoint)
        PUSH_TRAP(&error, &state);
    else
        PUSH_UNHALTABLE_TRAP(&error, &state);

// The first time through the following code 'error' will be NULL, but...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!

    if (error) {
        // Save error for WHY?
        REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);

        if (ERR_NUM(error) == RE_HALT) {
            assert(!at_breakpoint);
            return -1; // !!! Revisit hardcoded #
        }

        Val_Init_Error(out, error);
        *last = *out;
        return -cast(REBINT, ERR_NUM(error));
    }

    REBARR *code = Scan_UTF8_Managed(text, LEN_BYTES(text));

    // Where code ends up being bound when loaded at the REPL prompt should
    // be more generally configurable.  (It may be, for instance, that one
    // wants to run something with it not bound at all.)  Such choices
    // must come from this REPL host...not from the interpreter itself.
    {
        // First the scanned code is bound into the user context with a
        // fallback to the lib context.
        //
        // !!! This code is very old, and is how the REPL has bound since
        // R3-Alpha.  It comes from RL_Do_String, but should receive a modern
        // review of why it's written exactly this way.
        //
        REBCTX *user_ctx = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER));

        REBVAL vali;
        SET_INTEGER(&vali, CTX_LEN(user_ctx) + 1);

        Bind_Values_All_Deep(ARR_HEAD(code), user_ctx);
        Resolve_Context(user_ctx, Lib_Context, &vali, FALSE, FALSE);

        // If we're stopped at a breakpoint, the REPL should have a concept
        // of what stack level it is inspecting (conveyed by the |#|>> in the
        // prompt).  This does a binding pass using the function for that
        // stack level, just the way a body is bound during Make_Function()
        //
        if (at_breakpoint) {
            REBVAL level;
            SET_INTEGER(&level, HG_Stack_Level);

            REBFRM *frame = Frame_For_Stack_Level(NULL, &level, FALSE);
            assert(frame);

            // Need to manage because it may be no words get bound into it,
            // and we're not putting it into a FRAME! value, so it might leak
            // otherwise if it's reified.
            //
            REBCTX *frame_ctx = Context_For_Frame_May_Reify_Managed(frame);

            Bind_Values_Deep(ARR_HEAD(code), frame_ctx);
        }

        // !!! This was unused code that used to be in Do_String from
        // RL_Api.  It was an alternative path under `flags` which said
        // "Bind into lib or user spaces?" and then "Top words will be
        // added to lib".  Is it relevant in any way?
        //
        /* Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context);
        Bind_Values_Deep(ARR_HEAD(code), Lib_Context); */
    }

    if (Do_At_Throws(out, code, 0, SPECIFIED)) { // `code` will be GC protected
        if (at_breakpoint) {
            if (
                IS_FUNCTION(out)
                && VAL_FUNC_DISPATCHER(out) == &N_resume
            ) {
                //
                // This means we're done with the embedded REPL.  We want to
                // resume and may be returning a piece of code that will be
                // run by the finishing BREAKPOINT command in the target
                // environment.
                //
                // We'll never return a halt, so we reuse -1 (in this very
                // temporary scheme built on the very clunky historical REPL,
                // which will not last much longer...fingers crossed.)
                //
                DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
                CATCH_THROWN(out, out);
                *exit_status = -1;
                return -1;
            }

            if (
                IS_FUNCTION(out)
                && VAL_FUNC_DISPATCHER(out) == &N_quit
            ) {
                //
                // It would be frustrating if the system did not respond to
                // a QUIT and forced you to do `resume/with [quit]`.  So
                // this is *not* caught, rather passed back up with the
                // special -2 status code.
                //
                DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
                CATCH_THROWN(out, out);
                *exit_status = -2;
                return -2;
            }
        }
        else {
            // We are at the top level REPL, where we catch QUIT and for
            // now, also EXIT as meaning you want to leave.
            //
            if (
                IS_FUNCTION(out)
                && (
                    VAL_FUNC_DISPATCHER(out) == &N_quit
                    || VAL_FUNC_DISPATCHER(out) == &N_exit
                )
            ) {
                DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
                CATCH_THROWN(out, out);
                *exit_status = Exit_Status_From_Value(out);
                return -2; // Revisit hardcoded #
            }
        }

        fail (Error_No_Catch_For_Throw(out));
    }

    DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);

    return 0;
}
Пример #21
0
bool
is_function (Value* self)
{
	return IS_FUNCTION(self);
}
Пример #22
0
//
//  Bind_Values_Inner_Loop: C
//
// Bind_Values_Core() sets up the binding table and then calls
// this recursive routine to do the actual binding.
//
static void Bind_Values_Inner_Loop(
    struct Reb_Binder *binder,
    RELVAL *head,
    REBCTX *context,
    REBU64 bind_types, // !!! REVIEW: force word types low enough for 32-bit?
    REBU64 add_midstream_types,
    REBFLGS flags
) {
    RELVAL *value = head;
    for (; NOT_END(value); value++) {
        REBU64 type_bit = FLAGIT_KIND(VAL_TYPE(value));

        if (type_bit & bind_types) {
            REBSTR *canon = VAL_WORD_CANON(value);
            REBCNT n = Try_Get_Binder_Index(binder, canon);
            if (n != 0) {
                assert(n <= CTX_LEN(context));

                // We're overwriting any previous binding, which may have
                // been relative.
                //
                CLEAR_VAL_FLAG(value, VALUE_FLAG_RELATIVE);

                SET_VAL_FLAG(value, WORD_FLAG_BOUND);
                INIT_WORD_CONTEXT(value, context);
                INIT_WORD_INDEX(value, n);
            }
            else if (type_bit & add_midstream_types) {
                //
                // Word is not in context, so add it if option is specified
                //
                Expand_Context(context, 1);
                Append_Context(context, value, 0);
                Add_Binder_Index(binder, canon, VAL_WORD_INDEX(value));
            }
        }
        else if (ANY_ARRAY(value) && (flags & BIND_DEEP)) {
            Bind_Values_Inner_Loop(
                binder,
                VAL_ARRAY_AT(value),
                context,
                bind_types,
                add_midstream_types,
                flags
            );
        }
        else if (
            IS_FUNCTION(value)
            && IS_FUNCTION_INTERPRETED(value)
            && (flags & BIND_FUNC)
        ) {
            // !!! Likely-to-be deprecated functionality--rebinding inside the
            // content of an already formed function.  :-/
            //
            Bind_Values_Inner_Loop(
                binder,
                VAL_FUNC_BODY(value),
                context,
                bind_types,
                add_midstream_types,
                flags
            );
        }
    }
}
Пример #23
0
//
//  Do_Path_Throws: 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(
    REBVAL *out,
    REBSYM *label_sym,
    const REBVAL *path,
    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(out));
    assert(!IN_DATA_STACK(path));
    assert(!opt_setval || !IN_DATA_STACK(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!

    // 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);
        if (IS_UNSET(pvs.value))
            fail (Error(RE_NO_VALUE, pvs.item));
    }
    else {
        // !!! Ideally there would be some way to protect pvs.value during
        // successive path dispatches to make sure it does not get written.
        // This is semi-dangerously giving pvs.value a reference into the
        // input path, which should not be modified!

        pvs.value = VAL_ARRAY_AT(pvs.orig);
    }

    // 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_0(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:
            fail (Error(RE_INVALID_PATH, pvs.orig, pvs.item));
        }
    }
    else if (!IS_FUNCTION(pvs.value))
        fail (Error(RE_BAD_PATH_TYPE, pvs.orig, 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) *pvs.store = *pvs.value;

    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_sym) {
        REBVAL refinement;
        VAL_INIT_WRITABLE_DEBUG(&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_sym = VAL_WORD_SYM(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_sym = 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_NONE(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_VAL_ARRAY_AT_THROWS(&refinement, pvs.item)) {
                    *out = refinement;
                    DS_DROP_TO(dsp_orig);
                    return TRUE;
                }
                if (IS_NONE(&refinement)) continue;
                DS_PUSH(&refinement);
            }
            else if (IS_GET_WORD(pvs.item)) {
                DS_PUSH_TRASH;
                *DS_TOP = *GET_OPT_VAR_MAY_FAIL(pvs.item);
                if (IS_NONE(DS_TOP)) {
                    DS_DROP;
                    continue;
                }
            }
            else DS_PUSH(pvs.item);

            // 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_SYM(DS_TOP, SYMBOL_TO_CANON(VAL_WORD_SYM(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;
}