// // Destroy_External_Storage: C // // Destroy the external storage pointed by `->data` by calling the routine // `free_func` if it's not NULL // // out Result // ser The series // free_func A routine to free the storage, if it's NULL, only mark the // external storage non-accessible // REB_R Destroy_External_Storage(REBVAL *out, REBSER *ser, REBVAL *free_func) { SET_VOID(out); if (!GET_SER_FLAG(ser, SERIES_FLAG_EXTERNAL)) { fail (Error(RE_NO_EXTERNAL_STORAGE)); } if (!GET_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE)) { REBVAL i; SET_INTEGER(&i, cast(REBUPT, SER_DATA_RAW(ser))); fail (Error(RE_ALREADY_DESTROYED, &i)); } CLEAR_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE); if (free_func) { REBVAL safe; REBARR *array; REBVAL *elem; REBOOL threw; array = Make_Array(2); MANAGE_ARRAY(array); PUSH_GUARD_ARRAY(array); elem = Alloc_Tail_Array(array); *elem = *free_func; elem = Alloc_Tail_Array(array); SET_INTEGER(elem, cast(REBUPT, SER_DATA_RAW(ser))); threw = Do_At_Throws(&safe, array, 0, SPECIFIED); // 2 non-relative val DROP_GUARD_ARRAY(array); if (threw) return R_OUT_IS_THROWN; } return R_OUT; }
// // 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; }
// // RL_Make_Block: C // // Allocate a series suitable for storing Rebol values. This series // can be used as a backing store for a BLOCK!, but also for any // other Rebol Array type (GROUP!, PATH!, GET-PATH!, SET-PATH!, or // LIT-PATH!). // // Returns: // A pointer to a block series. // Arguments: // size - the length of the block. The system will add one extra // for the end-of-block marker. // Notes: // Blocks are allocated with REBOL's internal memory manager. // Internal structures may change, so NO assumptions should be made! // Blocks are automatically garbage collected if there are // no references to them from REBOL code (C code does nothing.) // However, you can lock blocks to prevent deallocation. (?? default) // RL_API REBSER *RL_Make_Block(u32 size) { REBARR * array = Make_Array(size); MANAGE_ARRAY(array); return ARR_SERIES(array); }