示例#1
0
static inline int get_dir(const char* path ,char* buf ,int* pi ,int* bi)
{
  const char* head = NULL;
  const char* tail = NULL;
  int len = 0;
  int path_len = 0;
  int ret = 0;
  
  if(IS_END(path))
    return END;

  path += *pi;
  buf += *bi;
  
  path_len = strlen(path);
  head = path;
  tail = (path_len-1) >= 0 ? memchr(path+1 ,'/' ,path_len-1) : NULL;

  if(!tail)  // so it must be the last dir
    {
      len = path_len;

      if(IS_RELATIVE(head))
	{
	  buf -= drop_last_dir(buf);
	  buf[0] = '\0';
	  return END;
	}
      
      buf[len] = '\0'; // end fixed string
      ret = LAST;
    }
  else if(IS_RELATIVE(head))
    {
      *bi -= drop_last_dir(buf);
      *pi += 3; // length of "/.."
      return RELATIVE;
    }
  else // not relative path
    {
      len = tail - head;
      ret = NORMAL;
    }

  memcpy(buf ,head ,len);
  *bi += len;
  *pi += len;
  
  return ret;
}
示例#2
0
文件: c-value.c 项目: rhencke/rebol
//
//  COPY_VALUE_Debug: C
//
// The implementation of COPY_VALUE_CORE is designed to be fairly optimal
// (since it is being called in lieu of what would have been a memcpy() or
// plain assignment).  It is left in its raw form as an inline function to
// to help convey that it is nearly as efficient as an assignment.
//
// This adds some verbose checking in the debug build to help debug cases
// where the relative information bits are incorrect.
//
void COPY_VALUE_Debug(
    REBVAL *dest,
    const RELVAL *src,
    REBCTX *specifier
) {
    assert(!IS_END(src));
    assert(!IS_TRASH_DEBUG(src));

#ifdef __cplusplus
    Assert_Cell_Writable(dest, __FILE__, __LINE__);
#endif

    if (IS_RELATIVE(src)) {
        assert(ANY_WORD(src) || ANY_ARRAY(src));
        if (specifier == SPECIFIED) {
            Debug_Fmt("Internal Error: Relative item used with SPECIFIED");
            PROBE_MSG(src, "word or array");
            PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "func");
            assert(FALSE);
        }
        else if (
            VAL_RELATIVE(src)
            != VAL_FUNC(CTX_FRAME_FUNC_VALUE(specifier))
        ) {
            Debug_Fmt("Internal Error: Function mismatch in specific binding");
            PROBE_MSG(src, "word or array");
            PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "expected func");
            PROBE_MSG(CTX_FRAME_FUNC_VALUE(specifier), "actual func");
            assert(FALSE);
        }
    }
    COPY_VALUE_CORE(dest, src, specifier);
}
示例#3
0
文件: c-bind.c 项目: rgchris/ren-c
//
//  Bind_Relative_Inner_Loop: C
//
// Recursive function for relative function word binding.  Returns TRUE if
// any relative bindings were made.
//
static void Bind_Relative_Inner_Loop(
    struct Reb_Binder *binder,
    RELVAL *head,
    REBARR *paramlist,
    REBU64 bind_types
) {
    RELVAL *value = head;

    for (; NOT_END(value); value++) {
        REBU64 type_bit = FLAGIT_KIND(VAL_TYPE(value));

        // The two-pass copy-and-then-bind should have gotten rid of all the
        // relative values to other functions during the copy.
        //
        // !!! Long term, in a single pass copy, this would have to deal
        // with relative values and run them through the specification
        // process if they were not just getting overwritten.
        //
        assert(!IS_RELATIVE(value));

        if (type_bit & bind_types) {
            REBINT n = Try_Get_Binder_Index(binder, VAL_WORD_CANON(value));
            if (n != 0) {
                //
                // Word's canon symbol is in frame.  Relatively bind it.
                // (clear out existing binding flags first).
                //
                UNBIND_WORD(value);
                SET_VAL_FLAGS(value, WORD_FLAG_BOUND | VALUE_FLAG_RELATIVE);
                INIT_WORD_FUNC(value, AS_FUNC(paramlist)); // incomplete func
                INIT_WORD_INDEX(value, n);
            }
        }
        else if (ANY_ARRAY(value)) {
            Bind_Relative_Inner_Loop(
                binder, VAL_ARRAY_AT(value), paramlist, bind_types
            );

            // Set the bits in the ANY-ARRAY! REBVAL to indicate that it is
            // relative to the function.
            //
            // !!! Technically speaking it is not necessary for an array to
            // be marked relative if it doesn't contain any relative words
            // under it.  However, for uniformity in the near term, it's
            // easiest to debug if there is a clear mark on arrays that are
            // part of a deep copy of a function body either way.
            //
            SET_VAL_FLAG(value, VALUE_FLAG_RELATIVE);
            INIT_RELATIVE(value, AS_FUNC(paramlist)); // incomplete func
        }
    }
}
示例#4
0
文件: c-value.c 项目: rhencke/rebol
//
//  Assert_No_Relative: C
//
// Check to make sure there are no relative values in an array, maybe deeply.
//
// !!! What if you have an ANY-ARRAY! inside your array at a position N,
// but there is a relative value in the VAL_ARRAY() of that value at an
// index earlier than N?  This currently considers that an error since it
// checks the whole array...which is more conservative (asserts on more
// cases).  But should there be a flag to ask to honor the index?
//
void Assert_No_Relative(REBARR *array, REBOOL deep)
{
    RELVAL *item = ARR_HEAD(array);
    while (NOT_END(item)) {
        if (IS_RELATIVE(item)) {
            Debug_Fmt("Array contained relative item and wasn't supposed to.");
            PROBE_MSG(item, "relative item");
            Panic_Array(array);
        }
        if (!IS_VOID_OR_SAFE_TRASH(item) && ANY_ARRAY(item) && deep)
             Assert_No_Relative(VAL_ARRAY(item), deep);
        ++item;
    }
}
示例#5
0
文件: c-value.c 项目: rhencke/rebol
//
//  INIT_WORD_INDEX_Debug: C
//
void INIT_WORD_INDEX_Debug(RELVAL *v, REBCNT i)
{
    assert(ANY_WORD(v));
    assert(GET_VAL_FLAG((v), WORD_FLAG_BOUND));
    if (IS_RELATIVE(v))
        assert(
            VAL_WORD_CANON(v)
            == VAL_PARAM_CANON(FUNC_PARAM(VAL_WORD_FUNC(v), i))
        );
    else
        assert(
            VAL_WORD_CANON(v)
            == CTX_KEY_CANON(VAL_WORD_CONTEXT(KNOWN(v)), i)
        );
    v->payload.any_word.index = i;
}
示例#6
0
//
//  Copy_Rerelativized_Array_Deep_Managed: C
//
// The invariant of copying in general is that when you are done with the
// copy, there are no relative values in that copy.  One exception to this
// is the deep copy required to make a relative function body in the first
// place (which it currently does in two passes--a normal deep copy followed
// by a relative binding).  The other exception is when a relativized
// function body is copied to make another relativized function body.
//
// This is specialized logic for the latter case.  It's constrained enough
// to be simple (all relative values are known to be relative to the same
// function), and the feature is questionable anyway.  So it's best not to
// further complicate ordinary copying with a parameterization to copy
// and change all the relative binding information from one function's
// paramlist to another.
//
REBARR *Copy_Rerelativized_Array_Deep_Managed(
    REBARR *original,
    REBACT *before, // references to `before` will be changed to `after`
    REBACT *after
){
    const REBFLGS flags = NODE_FLAG_MANAGED;

    REBARR *copy = Make_Array_For_Copy(ARR_LEN(original), flags, original);
    RELVAL *src = ARR_HEAD(original);
    RELVAL *dest = ARR_HEAD(copy);

    for (; NOT_END(src); ++src, ++dest) {
        if (not IS_RELATIVE(src)) {
            Move_Value(dest, KNOWN(src));
            continue;
        }

        // All relative values under a sub-block must be relative to the
        // same function.
        //
        assert(VAL_RELATIVE(src) == before);

        Move_Value_Header(dest, src);

        if (ANY_ARRAY_OR_PATH(src)) {
            INIT_VAL_NODE(
                dest,
                Copy_Rerelativized_Array_Deep_Managed(
                    VAL_ARRAY(src), before, after
                )
            );
            PAYLOAD(Any, dest).second = PAYLOAD(Any, src).second;
            INIT_BINDING(dest, after); // relative binding
        }
        else {
            assert(ANY_WORD(src));
            PAYLOAD(Any, dest) = PAYLOAD(Any, src);
            INIT_BINDING(dest, after);
        }

    }

    TERM_ARRAY_LEN(copy, ARR_LEN(original));

    return copy;
}
示例#7
0
文件: c-bind.c 项目: rgchris/ren-c
//
//  Unbind_Values_Core: C
//
// Unbind words in a block, optionally unbinding those which are
// bound to a particular target (if target is NULL, then all
// words will be unbound regardless of their VAL_WORD_CONTEXT).
//
void Unbind_Values_Core(RELVAL *head, REBCTX *context, REBOOL deep)
{
    RELVAL *value = head;
    for (; NOT_END(value); value++) {
        if (
            ANY_WORD(value)
            && (
                !context
                || (
                    IS_WORD_BOUND(value)
                    && !IS_RELATIVE(value)
                    && VAL_WORD_CONTEXT(KNOWN(value)) == context
                )
            )
        ) {
            UNBIND_WORD(value);
        }
        else if (ANY_ARRAY(value) && deep)
            Unbind_Values_Core(VAL_ARRAY_AT(value), context, TRUE);
    }
}
示例#8
0
文件: dlstart.c 项目: wermut/musl
void _dlstart_c(size_t *sp, size_t *dynv)
{
	size_t i, aux[AUX_CNT], dyn[DYN_CNT];

	int argc = *sp;
	char **argv = (void *)(sp+1);

	for (i=argc+1; argv[i]; i++);
	size_t *auxv = (void *)(argv+i+1);

	for (i=0; i<AUX_CNT; i++) aux[i] = 0;
	for (i=0; auxv[i]; i+=2) if (auxv[i]<AUX_CNT)
		aux[auxv[i]] = auxv[i+1];

	for (i=0; i<DYN_CNT; i++) dyn[i] = 0;
	for (i=0; dynv[i]; i+=2) if (dynv[i]<DYN_CNT)
		dyn[dynv[i]] = dynv[i+1];

	/* If the dynamic linker is invoked as a command, its load
	 * address is not available in the aux vector. Instead, compute
	 * the load address as the difference between &_DYNAMIC and the
	 * virtual address in the PT_DYNAMIC program header. */
	unsigned char *base = (void *)aux[AT_BASE];
	if (!base) {
		size_t phnum = aux[AT_PHNUM];
		size_t phentsize = aux[AT_PHENT];
		Phdr *ph = (void *)aux[AT_PHDR];
		for (i=phnum; i--; ph = (void *)((char *)ph + phentsize)) {
			if (ph->p_type == PT_DYNAMIC) {
				base = (void *)((size_t)dynv - ph->p_vaddr);
				break;
			}
		}
	}

	/* MIPS uses an ugly packed form for GOT relocations. Since we
	 * can't make function calls yet and the code is tiny anyway,
	 * it's simply inlined here. */
	if (NEED_MIPS_GOT_RELOCS) {
		size_t local_cnt = 0;
		size_t *got = (void *)(base + dyn[DT_PLTGOT]);
		for (i=0; dynv[i]; i+=2) if (dynv[i]==DT_MIPS_LOCAL_GOTNO)
			local_cnt = dynv[i+1];
		for (i=0; i<local_cnt; i++) got[i] += (size_t)base;
	}

	/* The use of the reloc_info structure and nested loops is a trick
	 * to work around the fact that we can't necessarily make function
	 * calls yet. Each struct in the array serves like the arguments
	 * to a function call. */
	struct {
		void *rel;
		size_t size;
		size_t stride;
	} reloc_info[] = {
		{ base+dyn[DT_JMPREL], dyn[DT_PLTRELSZ], 2+(dyn[DT_PLTREL]==DT_RELA) },
		{ base+dyn[DT_REL], dyn[DT_RELSZ], 2 },
		{ base+dyn[DT_RELA], dyn[DT_RELASZ], 3 },
		{ 0, 0, 0 }
	};

	for (i=0; reloc_info[i].stride; i++) {
		size_t *rel = reloc_info[i].rel;
		size_t rel_size = reloc_info[i].size;
		size_t stride = reloc_info[i].stride;
		for (; rel_size; rel+=stride, rel_size-=stride*sizeof(size_t)) {
			if (!IS_RELATIVE(rel[1])) continue;
			size_t *rel_addr = (void *)(base + rel[0]);
			size_t addend = stride==3 ? rel[2] : *rel_addr;
			*rel_addr = (size_t)base + addend;
		}
	}

	const char *strings = (void *)(base + dyn[DT_STRTAB]);
	const Sym *syms = (void *)(base + dyn[DT_SYMTAB]);

	/* Call dynamic linker stage-2, __dls2 */
	for (i=0; ;i++) {
		const char *s = strings + syms[i].st_name;
		if (s[0]=='_' && s[1]=='_' && s[2]=='d'
		 && s[3]=='l' && s[4]=='s' && s[5]=='2' && !s[6])
			break;
	}
	((stage2_func)(base + syms[i].st_value))(base);

	/* Call dynamic linker stage-3, __dls3 */
	for (i=0; ;i++) {
		const char *s = strings + syms[i].st_name;
		if (s[0]=='_' && s[1]=='_' && s[2]=='d'
		 && s[3]=='l' && s[4]=='s' && s[5]=='3' && !s[6])
			break;
	}
	((stage3_func)(base + syms[i].st_value))(sp);
}
示例#9
0
void _dlstart_c(size_t *sp, size_t *dynv)
{
	size_t i, aux[AUX_CNT], dyn[DYN_CNT];
	size_t *rel, rel_size, base;

	int argc = *sp;
	char **argv = (void *)(sp+1);

	for (i=argc+1; argv[i]; i++);
	size_t *auxv = (void *)(argv+i+1);

	for (i=0; i<AUX_CNT; i++) aux[i] = 0;
	for (i=0; auxv[i]; i+=2) if (auxv[i]<AUX_CNT)
		aux[auxv[i]] = auxv[i+1];

#if DL_FDPIC
	struct fdpic_loadseg *segs, fakeseg;
	size_t j;
	if (dynv) {
		/* crt_arch.h entry point asm is responsible for reserving
		 * space and moving the extra fdpic arguments to the stack
		 * vector where they are easily accessible from C. */
		segs = ((struct fdpic_loadmap *)(sp[-1] ? sp[-1] : sp[-2]))->segs;
	} else {
		/* If dynv is null, the entry point was started from loader
		 * that is not fdpic-aware. We can assume normal fixed-
		 * displacement ELF loading was performed, but when ldso was
		 * run as a command, finding the Ehdr is a heursitic: we
		 * have to assume Phdrs start in the first 4k of the file. */
		base = aux[AT_BASE];
		if (!base) base = aux[AT_PHDR] & -4096;
		segs = &fakeseg;
		segs[0].addr = base;
		segs[0].p_vaddr = 0;
		segs[0].p_memsz = -1;
		Ehdr *eh = (void *)base;
		Phdr *ph = (void *)(base + eh->e_phoff);
		size_t phnum = eh->e_phnum;
		size_t phent = eh->e_phentsize;
		while (phnum-- && ph->p_type != PT_DYNAMIC)
			ph = (void *)((size_t)ph + phent);
		dynv = (void *)(base + ph->p_vaddr);
	}
#endif

	for (i=0; i<DYN_CNT; i++) dyn[i] = 0;
	for (i=0; dynv[i]; i+=2) if (dynv[i]<DYN_CNT)
		dyn[dynv[i]] = dynv[i+1];

#if DL_FDPIC
	for (i=0; i<DYN_CNT; i++) {
		if (i==DT_RELASZ || i==DT_RELSZ) continue;
		if (!dyn[i]) continue;
		for (j=0; dyn[i]-segs[j].p_vaddr >= segs[j].p_memsz; j++);
		dyn[i] += segs[j].addr - segs[j].p_vaddr;
	}
	base = 0;

	const Sym *syms = (void *)dyn[DT_SYMTAB];

	rel = (void *)dyn[DT_RELA];
	rel_size = dyn[DT_RELASZ];
	for (; rel_size; rel+=3, rel_size-=3*sizeof(size_t)) {
		if (!IS_RELATIVE(rel[1], syms)) continue;
		for (j=0; rel[0]-segs[j].p_vaddr >= segs[j].p_memsz; j++);
		size_t *rel_addr = (void *)
			(rel[0] + segs[j].addr - segs[j].p_vaddr);
		if (R_TYPE(rel[1]) == REL_FUNCDESC_VAL) {
			*rel_addr += segs[rel_addr[1]].addr
				- segs[rel_addr[1]].p_vaddr
				+ syms[R_SYM(rel[1])].st_value;
			rel_addr[1] = dyn[DT_PLTGOT];
		} else {
			size_t val = syms[R_SYM(rel[1])].st_value;
			for (j=0; val-segs[j].p_vaddr >= segs[j].p_memsz; j++);
			*rel_addr = rel[2] + segs[j].addr - segs[j].p_vaddr + val;
		}
	}
#else
	/* If the dynamic linker is invoked as a command, its load
	 * address is not available in the aux vector. Instead, compute
	 * the load address as the difference between &_DYNAMIC and the
	 * virtual address in the PT_DYNAMIC program header. */
	base = aux[AT_BASE];
	if (!base) {
		size_t phnum = aux[AT_PHNUM];
		size_t phentsize = aux[AT_PHENT];
		Phdr *ph = (void *)aux[AT_PHDR];
		for (i=phnum; i--; ph = (void *)((char *)ph + phentsize)) {
			if (ph->p_type == PT_DYNAMIC) {
				base = (size_t)dynv - ph->p_vaddr;
				break;
			}
		}
	}

	/* MIPS uses an ugly packed form for GOT relocations. Since we
	 * can't make function calls yet and the code is tiny anyway,
	 * it's simply inlined here. */
	if (NEED_MIPS_GOT_RELOCS) {
		size_t local_cnt = 0;
		size_t *got = (void *)(base + dyn[DT_PLTGOT]);
		for (i=0; dynv[i]; i+=2) if (dynv[i]==DT_MIPS_LOCAL_GOTNO)
			local_cnt = dynv[i+1];
		for (i=0; i<local_cnt; i++) got[i] += base;
	}

	rel = (void *)(base+dyn[DT_REL]);
	rel_size = dyn[DT_RELSZ];
	for (; rel_size; rel+=2, rel_size-=2*sizeof(size_t)) {
		if (!IS_RELATIVE(rel[1], 0)) continue;
		size_t *rel_addr = (void *)(base + rel[0]);
		*rel_addr += base;
	}

	rel = (void *)(base+dyn[DT_RELA]);
	rel_size = dyn[DT_RELASZ];
	for (; rel_size; rel+=3, rel_size-=3*sizeof(size_t)) {
		if (!IS_RELATIVE(rel[1], 0)) continue;
		size_t *rel_addr = (void *)(base + rel[0]);
		*rel_addr = base + rel[2];
	}
#endif

	stage2_func dls2;
	GETFUNCSYM(&dls2, __dls2, base+dyn[DT_PLTGOT]);
	dls2((void *)base, sp);
}
示例#10
0
文件: n-reduce.c 项目: rgchris/ren-c
//
//  Compose_Any_Array_Throws: C
//
// Compose a block from a block of un-evaluated values and GROUP! arrays that
// are evaluated.  This calls into Do_Core, so if 'into' is provided, then its
// series must be protected from garbage collection.
//
//     deep - recurse into sub-blocks
//     only - parens that return blocks are kept as blocks
//
// Writes result value at address pointed to by out.
//
REBOOL Compose_Any_Array_Throws(
    REBVAL *out,
    const REBVAL *any_array,
    REBOOL deep,
    REBOOL only,
    REBOOL into
) {
    REBDSP dsp_orig = DSP;

    Reb_Enumerator e;
    PUSH_SAFE_ENUMERATOR(&e, any_array); // evaluating could disrupt any_array

    while (NOT_END(e.value)) {
        UPDATE_EXPRESSION_START(&e); // informs the error delivery better

        if (IS_GROUP(e.value)) {
            //
            // We evaluate here, but disable lookahead so it only evaluates
            // the GROUP! and doesn't trigger errors on what's after it.
            //
            REBVAL evaluated;
            DO_NEXT_REFETCH_MAY_THROW(&evaluated, &e, DO_FLAG_NO_LOOKAHEAD);
            if (THROWN(&evaluated)) {
                *out = evaluated;
                DS_DROP_TO(dsp_orig);
                DROP_SAFE_ENUMERATOR(&e);
                return TRUE;
            }

            if (IS_BLOCK(&evaluated) && !only) {
                //
                // compose [blocks ([a b c]) merge] => [blocks a b c merge]
                //
                RELVAL *push = VAL_ARRAY_AT(&evaluated);
                while (NOT_END(push)) {
                    //
                    // `evaluated` is known to be specific, but its specifier
                    // may be needed to derelativize its children.
                    //
                    DS_PUSH_RELVAL(push, VAL_SPECIFIER(&evaluated));
                    push++;
                }
            }
            else if (!IS_VOID(&evaluated)) {
                //
                // compose [(1 + 2) inserts as-is] => [3 inserts as-is]
                // compose/only [([a b c]) unmerged] => [[a b c] unmerged]
                //
                DS_PUSH(&evaluated);
            }
            else {
                //
                // compose [(print "Voids *vanish*!")] => []
                //
            }
        }
        else if (deep) {
            if (IS_BLOCK(e.value)) {
                //
                // compose/deep [does [(1 + 2)] nested] => [does [3] nested]

                REBVAL specific;
                COPY_VALUE(&specific, e.value, e.specifier);

                REBVAL composed;
                if (Compose_Any_Array_Throws(
                    &composed,
                    &specific,
                    TRUE,
                    only,
                    into
                )) {
                    *out = composed;
                    DS_DROP_TO(dsp_orig);
                    DROP_SAFE_ENUMERATOR(&e);
                    return TRUE;
                }

                DS_PUSH(&composed);
            }
            else {
                if (ANY_ARRAY(e.value)) {
                    //
                    // compose [copy/(orig) (copy)] => [copy/(orig) (copy)]
                    // !!! path and second group are copies, first group isn't
                    //
                    REBARR *copy = Copy_Array_Shallow(
                        VAL_ARRAY(e.value),
                        IS_RELATIVE(e.value)
                            ? e.specifier // use parent specifier if relative...
                            : VAL_SPECIFIER(const_KNOWN(e.value)) // else child's
                    );
                    DS_PUSH_TRASH;
                    Val_Init_Array_Index(
                        DS_TOP, VAL_TYPE(e.value), copy, VAL_INDEX(e.value)
                    ); // ...manages
                }
                else
                    DS_PUSH_RELVAL(e.value, e.specifier);
            }
            FETCH_NEXT_ONLY_MAYBE_END(&e);
        }
        else {
            //
            // compose [[(1 + 2)] (reverse "wollahs")] => [[(1 + 2)] "shallow"]
            //
            DS_PUSH_RELVAL(e.value, e.specifier);
            FETCH_NEXT_ONLY_MAYBE_END(&e);
        }
    }

    if (into)
        Pop_Stack_Values_Into(out, dsp_orig);
    else
        Val_Init_Array(out, VAL_TYPE(any_array), Pop_Stack_Values(dsp_orig));

    DROP_SAFE_ENUMERATOR(&e);
    return FALSE;
}
示例#11
0
文件: c-path.c 项目: rgchris/ren-c
//
//  Next_Path_Throws: C
//
// Evaluate next part of a path.
//
REBOOL Next_Path_Throws(REBPVS *pvs)
{
    REBPEF dispatcher;

    // Path must have dispatcher, else return:
    dispatcher = Path_Dispatch[VAL_TYPE(pvs->value)];
    if (!dispatcher) return FALSE; // unwind, then check for errors

    pvs->item++;

    //Debug_Fmt("Next_Path: %r/%r", pvs->path-1, pvs->path);

    // Determine the "selector".  See notes on pvs->selector_temp for why
    // a local variable can't be used for the temporary space.
    //
    if (IS_GET_WORD(pvs->item)) { // e.g. object/:field
        pvs->selector
            = GET_MUTABLE_VAR_MAY_FAIL(pvs->item, pvs->item_specifier);

        if (IS_VOID(pvs->selector))
            fail (Error_No_Value_Core(pvs->item, pvs->item_specifier));

        SET_TRASH_IF_DEBUG(&pvs->selector_temp);
    }
    // object/(expr) case:
    else if (IS_GROUP(pvs->item)) {
        if (Do_At_Throws(
            &pvs->selector_temp,
            VAL_ARRAY(pvs->item),
            VAL_INDEX(pvs->item),
            IS_RELATIVE(pvs->item)
                ? pvs->item_specifier // if relative, use parent specifier...
                : VAL_SPECIFIER(const_KNOWN(pvs->item)) // ...else use child's
        )) {
            *pvs->store = pvs->selector_temp;
            return TRUE;
        }

        pvs->selector = &pvs->selector_temp;
    }
    else {
        // object/word and object/value case:
        //
        COPY_VALUE(&pvs->selector_temp, pvs->item, pvs->item_specifier);
        pvs->selector = &pvs->selector_temp;
    }

    switch (dispatcher(pvs)) {
    case PE_OK:
        break;

    case PE_SET_IF_END:
        if (pvs->opt_setval && IS_END(pvs->item + 1)) {
            *pvs->value = *pvs->opt_setval;
            pvs->opt_setval = NULL;
        }
        break;

    case PE_NONE:
        SET_BLANK(pvs->store);
    case PE_USE_STORE:
        pvs->value = pvs->store;
        pvs->value_specifier = SPECIFIED;
        break;

    default:
        assert(FALSE);
    }

    if (NOT_END(pvs->item + 1)) return Next_Path_Throws(pvs);

    return FALSE;
}
示例#12
0
文件: c-path.c 项目: rgchris/ren-c
//
//  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;
}