// // Copy_Array_At_Max_Shallow: C // // Shallow copy an array from the given index for given maximum // length (clipping if it exceeds the array length) // REBARR *Copy_Array_At_Max_Shallow( REBARR *original, REBCNT index, REBSPC *specifier, REBCNT max ){ const REBFLGS flags = 0; if (index > ARR_LEN(original)) return Make_Array_For_Copy(0, flags, original); if (index + max > ARR_LEN(original)) max = ARR_LEN(original) - index; REBARR *copy = Make_Array_For_Copy(max, flags, original); REBCNT count = 0; const RELVAL *src = ARR_AT(original, index); RELVAL *dest = ARR_HEAD(copy); for (; count < max; ++count, ++src, ++dest) Derelativize(dest, src, specifier); TERM_ARRAY_LEN(copy, max); return copy; }
// // Copy_Array_At_Extra_Shallow: C // // Shallow copy an array from the given index thru the tail. // Additional capacity beyond what is required can be added // by giving an `extra` count of how many value cells one needs. // REBARR *Copy_Array_At_Extra_Shallow( REBARR *original, REBCNT index, REBSPC *specifier, REBCNT extra, REBFLGS flags ){ REBCNT len = ARR_LEN(original); if (index > len) return Make_Array_For_Copy(extra, flags, original); len -= index; REBARR *copy = Make_Array_For_Copy(len + extra, flags, original); RELVAL *src = ARR_AT(original, index); RELVAL *dest = ARR_HEAD(copy); REBCNT count = 0; for (; count < len; ++count, ++dest, ++src) Derelativize(dest, src, specifier); TERM_ARRAY_LEN(copy, len); return copy; }
// // Copy_Array_Core_Managed_Inner_Loop: C // // static REBARR *Copy_Array_Core_Managed_Inner_Loop( REBARR *original, REBCNT index, REBSPC *specifier, REBCNT tail, REBCNT extra, // currently no one uses--would it also apply deep (?) REBFLGS flags, REBU64 types ){ assert(index <= tail and tail <= ARR_LEN(original)); assert(flags & NODE_FLAG_MANAGED); REBCNT len = tail - index; // Currently we start by making a shallow copy and then adjust it REBARR *copy = Make_Array_For_Copy(len + extra, flags, original); RELVAL *src = ARR_AT(original, index); RELVAL *dest = ARR_HEAD(copy); REBCNT count = 0; for (; count < len; ++count, ++dest, ++src) { Clonify( Derelativize(dest, src, specifier), flags, types ); } TERM_ARRAY_LEN(copy, len); return copy; }
// // Alloc_Tail_Array: C // // Append a REBVAL-size slot to Rebol Array series at its tail. // Will use existing memory capacity already in the series if it // is available, but will expand the series if necessary. // Returns the new value for you to initialize. // // Note: Updates the termination and tail. // RELVAL *Alloc_Tail_Array(REBARR *a) { EXPAND_SERIES_TAIL(SER(a), 1); TERM_ARRAY_LEN(a, ARR_LEN(a)); RELVAL *last = ARR_LAST(a); TRASH_CELL_IF_DEBUG(last); // !!! was an END marker, good enough? return last; }
// // 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; }
// // Copy_Values_Len_Extra_Shallow_Core: C // // Shallow copy the first 'len' values of `head` into a new series created to // hold that many entries, with an optional bit of extra space at the end. // REBARR *Copy_Values_Len_Extra_Shallow_Core( const RELVAL *head, REBSPC *specifier, REBCNT len, REBCNT extra, REBFLGS flags ){ REBARR *a = Make_Array_Core(len + extra, flags); REBCNT count = 0; const RELVAL *src = head; RELVAL *dest = ARR_HEAD(a); for (; count < len; ++count, ++src, ++dest) { if (KIND_BYTE(src) == REB_NULLED) assert(flags & ARRAY_FLAG_NULLEDS_LEGAL); Derelativize(dest, src, specifier); } TERM_ARRAY_LEN(a, len); return a; }
// // Vector_To_Array: C // // Convert a vector to a block. // REBARR *Vector_To_Array(const REBVAL *vect) { REBCNT len = VAL_LEN_AT(vect); REBYTE *data = SER_DATA_RAW(VAL_SERIES(vect)); REBCNT type = VECT_TYPE(VAL_SERIES(vect)); REBARR *array = NULL; REBCNT n; RELVAL *val; if (len <= 0) fail (Error_Invalid_Arg(vect)); array = Make_Array(len); val = ARR_HEAD(array); for (n = VAL_INDEX(vect); n < VAL_LEN_HEAD(vect); n++, val++) { VAL_RESET_HEADER(val, (type >= VTSF08) ? REB_DECIMAL : REB_INTEGER); VAL_INT64(val) = get_vect(type, data, n); // can be int or decimal } TERM_ARRAY_LEN(array, len); assert(IS_END(val)); return array; }
// // Modify_Array: C // // Returns new dst_idx // REBCNT Modify_Array( REBCNT action, // INSERT, APPEND, CHANGE REBARR *dst_arr, // target REBCNT dst_idx, // position const REBVAL *src_val, // source REBCNT flags, // AN_ONLY, AN_PART REBINT dst_len, // length to remove REBINT dups // dup count ) { REBCNT tail = ARR_LEN(dst_arr); REBINT ilen = 1; // length to be inserted const RELVAL *src_rel; REBCTX *specifier; if (IS_VOID(src_val) || dups < 0) { // If they are effectively asking for "no action" then all we have // to do is return the natural index result for the operation. // (APPEND will return 0, insert the tail of the insertion...so index) return (action == SYM_APPEND) ? 0 : dst_idx; } if (action == SYM_APPEND || dst_idx > tail) dst_idx = tail; // Check /PART, compute LEN: if (!GET_FLAG(flags, AN_ONLY) && ANY_ARRAY(src_val)) { // Adjust length of insertion if changing /PART: if (action != SYM_CHANGE && GET_FLAG(flags, AN_PART)) ilen = dst_len; else ilen = VAL_LEN_AT(src_val); // Are we modifying ourselves? If so, copy src_val block first: if (dst_arr == VAL_ARRAY(src_val)) { REBARR *copy = Copy_Array_At_Shallow( VAL_ARRAY(src_val), VAL_INDEX(src_val), VAL_SPECIFIER(src_val) ); MANAGE_ARRAY(copy); // !!! Review: worth it to not manage and free? src_rel = ARR_HEAD(copy); specifier = SPECIFIED; // copy already specified it } else { src_rel = VAL_ARRAY_AT(src_val); // skips by VAL_INDEX values specifier = VAL_SPECIFIER(src_val); } } else { // use passed in RELVAL and specifier src_rel = src_val; specifier = SPECIFIED; // it's a REBVAL, not a RELVAL, so specified } REBINT size = dups * ilen; // total to insert if (action != SYM_CHANGE) { // Always expand dst_arr for INSERT and APPEND actions: Expand_Series(ARR_SERIES(dst_arr), dst_idx, size); } else { if (size > dst_len) Expand_Series(ARR_SERIES(dst_arr), dst_idx, size-dst_len); else if (size < dst_len && GET_FLAG(flags, AN_PART)) Remove_Series(ARR_SERIES(dst_arr), dst_idx, dst_len-size); else if (size + dst_idx > tail) { EXPAND_SERIES_TAIL(ARR_SERIES(dst_arr), size - (tail - dst_idx)); } } tail = (action == SYM_APPEND) ? 0 : size + dst_idx; #if !defined(NDEBUG) if (IS_ARRAY_MANAGED(dst_arr)) { REBINT i; for (i = 0; i < ilen; ++i) ASSERT_VALUE_MANAGED(&src_rel[i]); } #endif for (; dups > 0; dups--) { REBINT index = 0; for (; index < ilen; ++index, ++dst_idx) { COPY_VALUE( SINK(ARR_HEAD(dst_arr) + dst_idx), src_rel + index, specifier ); } } TERM_ARRAY_LEN(dst_arr, ARR_LEN(dst_arr)); ASSERT_ARRAY(dst_arr); return tail; }
// // Make_Context_For_Action_Push_Partials: C // // This creates a FRAME! context with NULLED cells in the unspecialized slots // that are available to be filled. For partial refinement specializations // in the action, it will push the refinement to the stack. In this way it // retains the ordering information implicit in the partial refinements of an // action's existing specialization. // // It is able to take in more specialized refinements on the stack. These // will be ordered *after* partial specializations in the function already. // The caller passes in the stack pointer of the lowest priority refinement, // which goes up to DSP for the highest of those added specializations. // // Since this is walking the parameters to make the frame already--and since // we don't want to bind to anything specialized out (including the ad-hoc // refinements added on the stack) we go ahead and collect bindings from the // frame if needed. // REBCTX *Make_Context_For_Action_Push_Partials( const REBVAL *action, // need ->binding, so can't just be a REBACT* REBDSP lowest_ordered_dsp, // caller can add refinement specializations struct Reb_Binder *opt_binder, REBFLGS prep // cell formatting mask bits, result managed if non-stack ){ REBDSP highest_ordered_dsp = DSP; REBACT *act = VAL_ACTION(action); REBCNT num_slots = ACT_NUM_PARAMS(act) + 1; // +1 is for CTX_ARCHETYPE() REBARR *varlist = Make_Array_Core(num_slots, SERIES_MASK_VARLIST); REBVAL *rootvar = RESET_CELL( ARR_HEAD(varlist), REB_FRAME, CELL_MASK_CONTEXT ); INIT_VAL_CONTEXT_VARLIST(rootvar, varlist); INIT_VAL_CONTEXT_PHASE(rootvar, VAL_ACTION(action)); INIT_BINDING(rootvar, VAL_BINDING(action)); const REBVAL *param = ACT_PARAMS_HEAD(act); REBVAL *arg = rootvar + 1; const REBVAL *special = ACT_SPECIALTY_HEAD(act); // of exemplar/paramlist REBCNT index = 1; // used to bind REFINEMENT! values to parameter slots REBCTX *exemplar = ACT_EXEMPLAR(act); // may be null if (exemplar) assert(special == CTX_VARS_HEAD(exemplar)); else assert(special == ACT_PARAMS_HEAD(act)); for (; NOT_END(param); ++param, ++arg, ++special, ++index) { arg->header.bits = prep; if (Is_Param_Hidden(param)) { // specialized out assert(GET_CELL_FLAG(special, ARG_MARKED_CHECKED)); Move_Value(arg, special); // doesn't copy ARG_MARKED_CHECKED SET_CELL_FLAG(arg, ARG_MARKED_CHECKED); continue_specialized: assert(not IS_NULLED(arg)); assert(GET_CELL_FLAG(arg, ARG_MARKED_CHECKED)); continue; // Eval_Core() double-checks type in debug build } assert(NOT_CELL_FLAG(special, ARG_MARKED_CHECKED)); REBSTR *canon = VAL_PARAM_CANON(param); // for adding to binding if (not TYPE_CHECK(param, REB_TS_REFINEMENT)) { // nothing to push continue_unspecialized: assert(arg->header.bits == prep); Init_Nulled(arg); if (opt_binder) { if (not Is_Param_Unbindable(param)) Add_Binder_Index(opt_binder, canon, index); } continue; } // Unspecialized refinement slots may have an SYM-WORD! in them that // reflects a partial that needs to be pushed to the stack. (They // are in *reverse* order of use.) assert( (special == param and IS_PARAM(special)) or (IS_SYM_WORD(special) or IS_NULLED(special)) ); if (IS_SYM_WORD(special)) { REBCNT partial_index = VAL_WORD_INDEX(special); Init_Any_Word_Bound( // push a SYM-WORD! to data stack DS_PUSH(), REB_SYM_WORD, VAL_STORED_CANON(special), exemplar, partial_index ); } // Unspecialized or partially specialized refinement. Check the // passed-in refinements on the stack for usage. // REBDSP dsp = highest_ordered_dsp; for (; dsp != lowest_ordered_dsp; --dsp) { REBVAL *ordered = DS_AT(dsp); if (VAL_STORED_CANON(ordered) != canon) continue; // just continuing this loop assert(not IS_WORD_BOUND(ordered)); // we bind only one INIT_BINDING(ordered, varlist); INIT_WORD_INDEX_UNCHECKED(ordered, index); if (not Is_Typeset_Invisible(param)) // needs argument goto continue_unspecialized; // If refinement named on stack takes no arguments, then it can't // be partially specialized...only fully, and won't be bound: // // specialize 'append/only [only: false] ; only not bound // Init_Word(arg, VAL_STORED_CANON(ordered)); Refinify(arg); SET_CELL_FLAG(arg, ARG_MARKED_CHECKED); goto continue_specialized; } goto continue_unspecialized; } TERM_ARRAY_LEN(varlist, num_slots); MISC_META_NODE(varlist) = nullptr; // GC sees this, we must initialize // !!! Can't pass SERIES_FLAG_STACK_LIFETIME into Make_Array_Core(), // because TERM_ARRAY_LEN won't let it set stack array lengths. // if (prep & CELL_FLAG_STACK_LIFETIME) SET_SERIES_FLAG(varlist, STACK_LIFETIME); INIT_CTX_KEYLIST_SHARED(CTX(varlist), ACT_PARAMLIST(act)); return CTX(varlist); }