*/ REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2) /* ** Create a child frame from two parent frames. Merge common fields. ** Values from the second parent take precedence. ** ** Deep copy and rebind the child. ** ***********************************************************************/ { REBSER *wrds; REBSER *child; REBVAL *words; REBVAL *value; REBCNT n; REBINT *binds = WORDS_HEAD(Bind_Table); // Merge parent1 and parent2 words. // Keep the binding table. Collect_Start(BIND_ALL); // Setup binding table and BUF_WORDS with parent1 words: if (parent1) Collect_Object(parent1); // Add parent2 words to binding table and BUF_WORDS: Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL); // Allocate child (now that we know the correct size): wrds = Copy_Series(BUF_WORDS); child = Make_Block(SERIES_TAIL(wrds)); value = Append_Value(child); VAL_SET(value, REB_FRAME); VAL_FRM_WORDS(value) = wrds; VAL_FRM_SPEC(value) = 0; // Copy parent1 values: COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1); // Copy parent2 values: words = FRM_WORDS(parent2)+1; value = FRM_VALUES(parent2)+1; for (; NOT_END(words); words++, value++) { // no need to search when the binding table is available n = binds[VAL_WORD_CANON(words)]; BLK_HEAD(child)[n] = *value; } // Terminate the child frame: SERIES_TAIL(child) = SERIES_TAIL(wrds); BLK_TERM(child); // Deep copy the child Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE); // Rebind the child Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC); Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE); // release the bind table Collect_End(wrds); return child; }
*/ REBSER *Collect_End(REBSER *prior) /* ** Finish collecting words, and free the Bind_Table for reuse. ** ***********************************************************************/ { REBVAL *words; REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here // Reset binding table (note BUF_WORDS may have expanded): for (words = BLK_HEAD(BUF_WORDS); NOT_END(words); words++) binds[VAL_WORD_CANON(words)] = 0; // If no new words, prior frame: if (prior && SERIES_TAIL(BUF_WORDS) == SERIES_TAIL(prior)) { RESET_TAIL(BUF_WORDS); // allow reuse return FRM_WORD_SERIES(prior); } prior = Copy_Series(BUF_WORDS); RESET_TAIL(BUF_WORDS); // allow reuse BARE_SERIES(prior); // No GC ever needed for word list CHECK_BIND_TABLE; return prior; }
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc) /* ** Compress a binary (only). ** data ** /part ** length ** /crc32 ** ** Note: If the file length is "small", it can't overrun on ** compression too much so we use our magic numbers; otherwise, ** we'll just be safe by a percentage of the file size. This may ** be a bit much, though. ** ***********************************************************************/ { // NOTE: The use_crc flag is not present in Zlib 1.2.8 // Instead, compress's fifth paramter is the compression level // It can be a value from 1 to 9, or Z_DEFAULT_COMPRESSION if you // want it to pick what the library author considers the "worth it" // tradeoff of time to generally suggest. uLongf size; REBSER *output; REBINT err; REBYTE out_size[sizeof(REBCNT)]; if (len < 0) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX); output = Make_Binary(size); //DISABLE_GC; // !!! why?? // dest, dest-len, src, src-len, level err = z_compress2(BIN_HEAD(output), &size, BIN_HEAD(input) + index, len, Z_DEFAULT_COMPRESSION); if (err) { REBVAL arg; if (err == Z_MEM_ERROR) Trap_DEAD_END(RE_NO_MEMORY); SET_INTEGER(&arg, err); Trap1_DEAD_END(RE_BAD_PRESS, &arg); //!!!provide error string descriptions } SET_STR_END(output, size); SERIES_TAIL(output) = size; REBCNT_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end. Append_Series(output, (REBYTE*)out_size, sizeof(REBCNT)); if (SERIES_AVAIL(output) > 1024) // Is there wasted space? output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg. //ENABLE_GC; return output; }
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc) /* ** Compress a binary (only). ** data ** /part ** length ** /crc32 ** ** Note: If the file length is "small", it can't overrun on ** compression too much so we use our magic numbers; otherwise, ** we'll just be safe by a percentage of the file size. This may ** be a bit much, though. ** ***********************************************************************/ { REBCNT size; REBSER *output; REBINT err; REBYTE out_size[4]; if (len < 0) Trap0(RE_PAST_END); // !!! better msg needed size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX); output = Make_Binary(size); //DISABLE_GC; // !!! why?? // dest, dest-len, src, src-len, level err = Z_compress2(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc); if (err) { if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY); SET_INTEGER(DS_RETURN, err); Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions } SET_STR_END(output, size); SERIES_TAIL(output) = size; Long_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end. Append_Series(output, (REBYTE*)out_size, 4); if (SERIES_AVAIL(output) > 1024) // Is there wasted space? output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg. //ENABLE_GC; return output; }
*/ REBSER *Block_To_String_List(REBVAL *blk) /* ** Convert block of values to a string that holds ** a series of null terminated strings, followed ** by a final terminating string. ** ***********************************************************************/ { REB_MOLD mo = {0}; REBVAL *value; Reset_Mold(&mo); for (value = VAL_BLK_DATA(blk); NOT_END(value); value++) { Mold_Value(&mo, value, 0); Append_Byte(mo.series, 0); } Append_Byte(mo.series, 0); return Copy_Series(mo.series); // Unicode }
static REBSER *make_binary(REBVAL *arg, REBOOL make) { REBSER *ser; // MAKE BINARY! 123 switch (VAL_TYPE(arg)) { case REB_INTEGER: case REB_DECIMAL: if (make) ser = Make_Binary(Int32s(arg, 0)); else ser = Make_Binary_BE64(arg); break; // MAKE/TO BINARY! BINARY! case REB_BINARY: ser = Copy_Bytes(VAL_BIN_DATA(arg), VAL_LEN(arg)); break; // MAKE/TO BINARY! <any-string> case REB_STRING: case REB_FILE: case REB_EMAIL: case REB_URL: case REB_TAG: // case REB_ISSUE: ser = Encode_UTF8_Value(arg, VAL_LEN(arg), 0); break; case REB_BLOCK: // Join_Binary returns a shared buffer, so produce a copy: ser = Copy_Series(Join_Binary(arg)); break; // MAKE/TO BINARY! <tuple!> case REB_TUPLE: ser = Copy_Bytes(VAL_TUPLE(arg), VAL_TUPLE_LEN(arg)); break; // MAKE/TO BINARY! <char!> case REB_CHAR: ser = Make_Binary(6); ser->tail = Encode_UTF8_Char(BIN_HEAD(ser), VAL_CHAR(arg)); break; // MAKE/TO BINARY! <bitset!> case REB_BITSET: ser = Copy_Bytes(VAL_BIN(arg), VAL_TAIL(arg)); break; // MAKE/TO BINARY! <image!> case REB_IMAGE: ser = Make_Image_Binary(arg); break; case REB_MONEY: ser = Make_Binary(12); ser->tail = 12; deci_to_binary(ser->data, VAL_DECI(arg)); ser->data[12] = 0; break; default: ser = 0; } return ser; }