*/ static void Write_File_Port(REBREQ *file, REBVAL *data, REBCNT len, REBCNT args) /* ***********************************************************************/ { REBSER *ser; if (IS_BLOCK(data)) { // Form the values of the block // !! Could be made more efficient if we broke the FORM // into 32K chunks for writing. REB_MOLD mo; CLEARS(&mo); Reset_Mold(&mo); if (args & AM_WRITE_LINES) { mo.opts = 1 << MOPT_LINES; } Mold_Value(&mo, data, 0); Set_String(data, mo.series); // fall into next section len = SERIES_TAIL(mo.series); } // Auto convert string to UTF-8 if (IS_STRING(data)) { ser = Encode_UTF8_Value(data, len, ENCF_OS_CRLF); file->common.data = ser? BIN_HEAD(ser) : VAL_BIN_DATA(data); // No encoding may be needed len = SERIES_TAIL(ser); } else { file->common.data = VAL_BIN_DATA(data); } file->length = len; OS_DO_DEVICE(file, RDC_WRITE); }
STOID Form_Block_Series(REBSER *blk, REBCNT index, REB_MOLD *mold, REBSER *frame) { // Form a series (part_mold means mold non-string values): REBINT n; REBINT len = SERIES_TAIL(blk) - index; REBVAL *val; REBVAL *wval; if (len < 0) len = 0; for (n = 0; n < len;) { val = BLK_SKIP(blk, index+n); wval = 0; if (frame && (IS_WORD(val) || IS_GET_WORD(val))) { wval = Find_Word_Value(frame, VAL_WORD_SYM(val)); if (wval) val = wval; } Mold_Value(mold, val, wval != 0); n++; if (GET_MOPT(mold, MOPT_LINES)) { Append_Byte(mold->series, LF); } else { // Add a space if needed: if (n < len && mold->series->tail && *UNI_LAST(mold->series) != LF && !GET_MOPT(mold, MOPT_TIGHT) ) Append_Byte(mold->series, ' '); } } }
*/ REBINT PD_File(REBPVS *pvs) /* ***********************************************************************/ { REBSER *ser; REB_MOLD mo = {0}; REBCNT n; REBUNI c; REBSER *arg; if (pvs->setval) return PE_BAD_SET; ser = Copy_Series_Value(pvs->value); n = SERIES_TAIL(ser); if (n > 0) c = GET_ANY_CHAR(ser, n-1); if (n == 0 || c != '/') Append_Byte(ser, '/'); if (ANY_STR(pvs->select)) arg = VAL_SERIES(pvs->select); else { Reset_Mold(&mo); Mold_Value(&mo, pvs->select, 0); arg = mo.series; } c = GET_ANY_CHAR(arg, 0); n = (c == '/' || c == '\\') ? 1 : 0; Append_String(ser, arg, n, arg->tail-n); Set_Series(VAL_TYPE(pvs->value), pvs->store, ser); return PE_USE; }
*/ REBSER *Form_Reduce(REBSER *block, REBCNT index) /* ** Reduce a block and then form each value into a string. Return the ** string or NULL if an unwind triggered while reducing. ** ***********************************************************************/ { REBINT start = DSP + 1; REBINT n; REB_MOLD mo = {0}; while (index < BLK_LEN(block)) { index = Do_Next(block, index, 0); if (THROWN(DS_TOP)) { *DS_VALUE(start) = *DS_TOP; DSP = start; return NULL; } } Reset_Mold(&mo); for (n = start; n <= DSP; n++) Mold_Value(&mo, &DS_Base[n], 0); DSP = start; return Copy_String(mo.series, 0, -1); }
*/ REBSER *Form_Tight_Block(REBVAL *blk) /* ***********************************************************************/ { REB_MOLD mo = {0}; REBVAL *val; Reset_Mold(&mo); for (val = VAL_BLK_DATA(blk); NOT_END(val); val++) Mold_Value(&mo, val, 0); return Copy_String(mo.series, 0, -1); }
STOID Mold_Object(REBVAL *value, REB_MOLD *mold) { REBSER *wser; REBVAL *words; REBVAL *vals; // first value is context REBCNT n; REBOOL indented = !GET_MOPT(mold, MOPT_INDENT); ASSERT(VAL_OBJ_FRAME(value), RP_NO_OBJECT_FRAME); wser = VAL_OBJ_WORDS(value); // if (wser < 1000) // Dump_Block_Raw(VAL_OBJ_FRAME(value), 0, 1); words = BLK_HEAD(wser); vals = VAL_OBJ_VALUES(value); // first value is context Pre_Mold(value, mold); Append_Byte(mold->series, '['); // Prevent infinite looping: if (Find_Same_Block(MOLD_LOOP, value) > 0) { Append_Bytes(mold->series, "...]"); return; } Append_Val(MOLD_LOOP, value); mold->indent++; for (n = 1; n < SERIES_TAIL(wser); n++) { if ( !VAL_GET_OPT(words+n, OPTS_HIDE) && ((VAL_TYPE(vals+n) > REB_NONE) || !GET_MOPT(mold, MOPT_NO_NONE)) ){ if(indented) New_Indented_Line(mold); else if (n > 1) Append_Byte(mold->series, ' '); Append_UTF8(mold->series, Get_Sym_Name(VAL_WORD_SYM(words+n)), -1); //Print("Slot: %s", Get_Sym_Name(VAL_WORD_SYM(words+n))); Append_Bytes(mold->series, ": "); if (IS_WORD(vals+n) && !GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, '\''); Mold_Value(mold, vals+n, TRUE); } } mold->indent--; if (indented) New_Indented_Line(mold); Append_Byte(mold->series, ']'); End_Mold(mold); Remove_Last(MOLD_LOOP); }
*/ REBSER *Copy_Mold_Value(REBVAL *value, REBCNT opts) /* ** Form a value based on the mold opts provided. ** ***********************************************************************/ { REB_MOLD mo = {0}; mo.opts = opts; Reset_Mold(&mo); Mold_Value(&mo, value, TRUE); return Copy_String(mo.series, 0, -1); }
STOID Mold_Block_Series(REB_MOLD *mold, REBSER *series, REBCNT index, REBYTE *sep) { REBSER *out = mold->series; REBOOL line_flag = FALSE; // newline was part of block REBOOL had_lines = FALSE; REBVAL *value = BLK_SKIP(series, index); if (!sep) sep = "[]"; if (IS_END(value)) { Append_Bytes(out, sep); return; } // Recursion check: (variation of: Find_Same_Block(MOLD_LOOP, value)) for (value = BLK_HEAD(MOLD_LOOP); NOT_END(value); value++) { if (VAL_SERIES(value) == series) { Emit(mold, "C...C", sep[0], sep[1]); return; } } value = Append_Value(MOLD_LOOP); Set_Block(value, series); if (sep[1]) { Append_Byte(out, sep[0]); mold->indent++; } // else out->tail--; // why????? value = BLK_SKIP(series, index); while (NOT_END(value)) { if (VAL_GET_LINE(value)) { if (sep[1] || line_flag) New_Indented_Line(mold); had_lines = TRUE; } line_flag = TRUE; Mold_Value(mold, value, TRUE); value++; if (NOT_END(value)) Append_Byte(out, (sep[0] == '/') ? '/' : ' '); } if (sep[1]) { mold->indent--; if (VAL_GET_LINE(value) || had_lines) New_Indented_Line(mold); Append_Byte(out, sep[1]); } Remove_Last(MOLD_LOOP); }
STOID Mold_Simple_Block(REB_MOLD *mold, REBVAL *block, REBCNT len) { // Simple molder for error locations. Series must be valid. // Max length in chars must be provided. REBCNT start = SERIES_TAIL(mold->series); while (NOT_END(block)) { if ((SERIES_TAIL(mold->series) - start) > len) break; Mold_Value(mold, block, TRUE); block++; if (NOT_END(block)) Append_Byte(mold->series, ' '); } // If it's too large, truncate it: if ((SERIES_TAIL(mold->series) - start) > len) { SERIES_TAIL(mold->series) = start + len; Append_Bytes(mold->series, "..."); } }
*/ REBSER *Mold_Print_Value(REBVAL *value, REBCNT limit, REBFLG mold) /* ** Basis function for print. Can do a form or a mold based ** on the mold flag setting. Can limit string output to a ** specified size to prevent long console garbage output. ** ***********************************************************************/ { REB_MOLD mo = {0}; Reset_Mold(&mo); Mold_Value(&mo, value, mold); if (limit != 0 && STR_LEN(mo.series) > limit) { SERIES_TAIL(mo.series) = limit; Append_Bytes(mo.series, "..."); // adds a null at the tail } return mo.series; }
*/ REBSER *Form_Reduce(REBSER *block, REBCNT index) /* ***********************************************************************/ { REBINT start = DSP + 1; REBINT n; REB_MOLD mo = {0}; while (index < BLK_LEN(block)) { index = Do_Next(block, index, 0); } Reset_Mold(&mo); for (n = start; n <= DSP; n++) Mold_Value(&mo, &DS_Base[n], 0); DSP = start; return Copy_String(mo.series, 0, -1); }
*/ 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 }
xx*/ REBSER *Dump_Value(REBVAL *block, REBSER *series) /* ** Dump a values's contents for debugging purposes. ** ***********************************************************************/ { REB_MOLD mo = {0}; mo.digits = 17; // max digits if (VAL_TYPE(block) >= REB_MAX) Crash(RP_DATATYPE+7, VAL_TYPE(block)); ASSERT2(series, 9997); mo.series = series; Emit(&mo, "T: ", block); Mold_Value(&mo, block, TRUE); if (ANY_WORD(block)) { if (!VAL_WORD_FRAME(block)) Append_Bytes(series, " - unbound"); else if (VAL_WORD_INDEX(block) < 0) Append_Bytes(series, " - relative"); else Append_Bytes(series, " - absolute"); } return series; }
STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded) { ERROR_OBJ *err; REBVAL *msg; // Error message block // Protect against recursion. !!!! if (molded) { if (VAL_OBJ_FRAME(value) && VAL_ERR_NUM(value) >= RE_NOTE && VAL_ERR_OBJECT(value)) Mold_Object(value, mold); else { // Happens if throw or return is molded. // make error! 0-3 Pre_Mold(value, mold); Append_Int(mold->series, VAL_ERR_NUM(value)); End_Mold(mold); } return; } // If it is an unprocessed BREAK, THROW, CONTINUE, RETURN: if (VAL_ERR_NUM(value) < RE_NOTE || !VAL_ERR_OBJECT(value)) { VAL_ERR_OBJECT(value) = Make_Error(VAL_ERR_NUM(value), value, 0, 0); // spoofs field } err = VAL_ERR_VALUES(value); // Form: ** <type> Error: Emit(mold, "** WB", &err->type, RS_ERRS+0); // Append: error message ARG1, ARG2, etc. msg = Find_Error_Info(err, 0); if (msg) { if (!IS_BLOCK(msg)) Mold_Value(mold, msg, 0); else { //start = DSP + 1; //Reduce_In_Frame(VAL_ERR_OBJECT(value), VAL_BLK_DATA(msg)); //SERIES_TAIL(DS_Series) = DSP + 1; //Form_Block_Series(DS_Series, start, mold, 0); Form_Block_Series(VAL_SERIES(msg), 0, mold, VAL_ERR_OBJECT(value)); } } else Append_Boot_Str(mold->series, RS_ERRS+1); Append_Byte(mold->series, '\n'); // Form: ** Where: function value = &err->where; if (VAL_TYPE(value) > REB_NONE) { Append_Boot_Str(mold->series, RS_ERRS+2); Mold_Value(mold, value, 0); Append_Byte(mold->series, '\n'); } // Form: ** Near: location value = &err->nearest; if (VAL_TYPE(value) > REB_NONE) { Append_Boot_Str(mold->series, RS_ERRS+3); if (IS_STRING(value)) // special case: source file line number Append_String(mold->series, VAL_SERIES(value), 0, VAL_TAIL(value)); else if (IS_BLOCK(value)) Mold_Simple_Block(mold, VAL_BLK_DATA(value), 60); Append_Byte(mold->series, '\n'); } }
x*/ void Modify_StringX(REBCNT action, REBVAL *string, REBVAL *arg) /* ** Actions: INSERT, APPEND, CHANGE ** ** string [string!] {Series at point to insert} ** value [any-type!] {The value to insert} ** /part {Limits to a given length or position.} ** length [number! series! pair!] ** /only {Inserts a series as a series.} ** /dup {Duplicates the insert a specified number of times.} ** count [number! pair!] ** ***********************************************************************/ { REBSER *series = VAL_SERIES(string); REBCNT index = VAL_INDEX(string); REBCNT tail = VAL_TAIL(string); REBINT rlen; // length to be removed REBINT ilen = 1; // length to be inserted REBINT cnt = 1; // DUP count REBINT size; REBVAL *val; REBSER *arg_ser = 0; // argument series // Length of target (may modify index): (arg can be anything) rlen = Partial1((action == A_CHANGE) ? string : arg, DS_ARG(AN_LENGTH)); index = VAL_INDEX(string); if (action == A_APPEND || index > tail) index = tail; // If the arg is not a string, then we need to create a string: if (IS_BINARY(string)) { if (IS_INTEGER(arg)) { if (VAL_INT64(arg) > 255 || VAL_INT64(arg) < 0) Trap_Range(arg); arg_ser = Make_Binary(1); Append_Byte(arg_ser, VAL_CHAR(arg)); // check for size!!! } else if (!ANY_BINSTR(arg)) Trap_Arg(arg); } else if (IS_BLOCK(arg)) { // MOVE! REB_MOLD mo = {0}; arg_ser = mo.series = Make_Unicode(VAL_BLK_LEN(arg) * 10); // GC!? for (val = VAL_BLK_DATA(arg); NOT_END(val); val++) Mold_Value(&mo, val, 0); } else if (IS_CHAR(arg)) { // Optimize this case !!! arg_ser = Make_Unicode(1); Append_Byte(arg_ser, VAL_CHAR(arg)); } else if (!ANY_STR(arg) || IS_TAG(arg)) { arg_ser = Copy_Form_Value(arg, 0); } if (arg_ser) Set_String(arg, arg_ser); else arg_ser = VAL_SERIES(arg); // Length of insertion: ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg); // If Source == Destination we need to prevent possible conflicts. // Clone the argument just to be safe. // (Note: It may be possible to optimize special cases like append !!) if (series == VAL_SERIES(arg)) { arg_ser = Copy_Series_Part(arg_ser, VAL_INDEX(arg), ilen); // GC!? } // Get /DUP count: if (DS_REF(AN_DUP)) { cnt = Int32(DS_ARG(AN_COUNT)); if (cnt <= 0) return; // no changes } // Total to insert: size = cnt * ilen; if (action != A_CHANGE) { // Always expand series for INSERT and APPEND actions: Expand_Series(series, index, size); } else { if (size > rlen) Expand_Series(series, index, size-rlen); else if (size < rlen && DS_REF(AN_PART)) Remove_Series(series, index, rlen-size); else if (size + index > tail) { EXPAND_SERIES_TAIL(series, size - (tail - index)); } } // For dup count: for (; cnt > 0; cnt--) { Insert_String(series, index, arg_ser, VAL_INDEX(arg), ilen, TRUE); index += ilen; } TERM_SERIES(series); VAL_INDEX(string) = (action == A_APPEND) ? 0 : index; }
static void Mold_Error(const REBVAL *value, REB_MOLD *mold, REBFLG molded) { ERROR_OBJ *err; REBVAL *msg; // Error message block REBSER *frame; // Protect against recursion. !!!! if (molded) { if (VAL_OBJ_FRAME(value) && VAL_ERR_NUM(value) >= RE_NOTE && VAL_ERR_OBJECT(value)) Mold_Object(value, mold); else { // Happens if throw or return is molded. // make error! 0-3 Pre_Mold(value, mold); Append_Int(mold->series, VAL_ERR_NUM(value)); End_Mold(mold); } return; } if (VAL_ERR_NUM(value) < RE_THROW_MAX) { // Though we generally do not make error objects for THROWN() errors, // we do make one here for the purposes of molding. frame = Make_Error(VAL_ERR_NUM(value), value, 0, 0); err = ERR_VALUES(frame); } else { frame = VAL_ERR_OBJECT(value); err = VAL_ERR_VALUES(value); } // Form: ** <type> Error: Emit(mold, "** WB", &err->type, RS_ERRS+0); // Append: error message ARG1, ARG2, etc. msg = Find_Error_Info(err, 0); if (msg) { if (!IS_BLOCK(msg)) Mold_Value(mold, msg, 0); else { //start = DSP + 1; //Reduce_In_Frame(frame, VAL_BLK_DATA(msg)); //SERIES_TAIL(DS_Series) = DSP + 1; //Form_Block_Series(DS_Series, start, mold, 0); Form_Block_Series(VAL_SERIES(msg), 0, mold, frame); } } else Append_Boot_Str(mold->series, RS_ERRS+1); Append_Byte(mold->series, '\n'); // Form: ** Where: function value = &err->where; if (VAL_TYPE(value) > REB_NONE) { Append_Boot_Str(mold->series, RS_ERRS+2); Mold_Value(mold, value, 0); Append_Byte(mold->series, '\n'); } // Form: ** Near: location value = &err->nearest; if (VAL_TYPE(value) > REB_NONE) { Append_Boot_Str(mold->series, RS_ERRS+3); if (IS_STRING(value)) // special case: source file line number Append_String(mold->series, VAL_SERIES(value), 0, VAL_TAIL(value)); else if (IS_BLOCK(value)) Mold_Simple_Block(mold, VAL_BLK_DATA(value), 60); Append_Byte(mold->series, '\n'); } }