*/ void Debug_String(const void *p, REBCNT len, REBOOL uni, REBINT lines) /* ***********************************************************************/ { REBUNI uc; const REBYTE *bp = uni ? NULL : cast(const REBYTE *, p); const REBUNI *up = uni ? cast(const REBUNI *, p) : NULL; if (Trace_Limit > 0) { if (Trace_Buffer->tail >= Trace_Limit) Remove_Series(Trace_Buffer, 0, 2000); if (len == UNKNOWN) len = uni ? Strlen_Uni(up) : LEN_BYTES(bp); // !!! account for unicode! for (; len > 0; len--) { uc = uni ? *up++ : *bp++; Append_Byte(Trace_Buffer, uc); } //Append_Unencoded_Len(Trace_Buffer, bp, len); for (; lines > 0; lines--) Append_Byte(Trace_Buffer, LF); } else { Prin_OS_String(p, len, uni); for (; lines > 0; lines--) Print_OS_Line(); } }
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, ' '); } } }
STOID Mold_Tag(REBVAL *value, REB_MOLD *mold) { Append_Byte(mold->series, '<'); Insert_String(mold->series, AT_TAIL, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0); Append_Byte(mold->series, '>'); }
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); }
*/ void Post_Mold(REBVAL *value, REB_MOLD *mold) /* ** For series that has an index, add the index for mold/all. ** Add closing block. ** ***********************************************************************/ { if (VAL_INDEX(value)) { Append_Byte(mold->series, ' '); Append_Int(mold->series, VAL_INDEX(value)+1); } if (GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, ']'); }
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_Function(REBVAL *value, REB_MOLD *mold) { Pre_Mold(value, mold); Append_Byte(mold->series, '['); Mold_Block_Series(mold, VAL_FUNC_SPEC(value), 0, 0); //// & ~(1<<MOPT_MOLD_ALL)); // Never literalize it (/all). if (IS_FUNCTION(value) || IS_CLOSURE(value)) Mold_Block_Series(mold, VAL_FUNC_BODY(value), 0, 0); Append_Byte(mold->series, ']'); End_Mold(mold); }
*/ 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; }
*/ void New_Indented_Line(REB_MOLD *mold) /* ** Create a newline with auto-indent on next line if needed. ** ***********************************************************************/ { REBINT n; REBUNI *cp = 0; // Check output string has content already but no terminator: if (mold->series->tail) { cp = UNI_LAST(mold->series); if (*cp == ' ' || *cp == '\t') *cp = '\n'; else cp = 0; } // Add terminator: if (!cp) Append_Byte(mold->series, '\n'); // Add proper indentation: if (!GET_MOPT(mold, MOPT_INDENT)) { for (n = 0; n < mold->indent; n++) Append_Bytes(mold->series, " "); } }
*/ void End_Mold(REB_MOLD *mold) /* ** Finish the mold, depending on /ALL with close block. ** ***********************************************************************/ { if (GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, ']'); }
*/ 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 }
STOID Mold_Handle(REBVAL *value, REB_MOLD *mold) { const REBYTE *name = VAL_HANDLE_NAME(value); if (name != NULL) { Append_Bytes(mold->series, "#[handle! "); Append_Bytes(mold->series, cs_cast(name)); Append_Byte(mold->series, ']'); } else { Emit(mold, "+T", value); } }
STOID Mold_Logic(REB_MOLD *mold, REBVAL *value) { REBYTE buf[20]; Pre_Mold(value, mold); INT_TO_STR(VAL_LOGIC(value), buf); Append_Bytes(mold->series, buf); Append_Byte(mold->series, ' '); old_Block_Series(mold, BLK_HEAD(VAL_LOGIC_WORDS(value)), 0); End_Mold(mold); }
xx*/ void Dump_Block(REBVAL *blk, REBINT len) /* ** Dump a block's contents for debugging purposes. ** ***********************************************************************/ { REBSER *series; //REBVAL *blk = BLK_HEAD(block); //Print("BLOCK: %x Tail: %d Size: %d", block, block->tail, block->rest); // change to a make string!!! no need to append to a series, this is a debug function series = Make_Binary(100); Append_Bytes(series, "[\n"); while (NOT_END(blk) && len-- > 0) { Append_Byte(series, '\t'); Dump_Value(blk, series); Append_Byte(series, '\n'); blk++; } Append_Byte(series, ']'); *STR_TAIL(series) = 0; Debug_Str(STR_HEAD(series)); }
*/ RL_API int RL_Do_Binary(REBYTE *bin, REBINT length, REBCNT flags, REBCNT key, RXIARG *result) /* ** Evaluate an encoded binary script such as compressed text. ** ** Returns: ** The datatype of the result or zero if error in the encoding. ** Arguments: ** bin - by default, a REBOL compressed UTF-8 (or ASCII) script. ** length - the length of the data. ** flags - special flags (set to zero at this time). ** key - encoding, encryption, or signature key. ** result - value returned from evaluation. ** Notes: ** As of A104, only compressed scripts are supported, however, ** rebin, cloaked, signed, and encrypted formats will be supported. ** ***********************************************************************/ { REBSER spec = {0}; REBSER *text; REBVAL *val; #ifdef DUMP_INIT_SCRIPT int f; #endif //Cloak(TRUE, code, NAT_SPEC_SIZE, &key[0], 20, TRUE); spec.data = bin; spec.tail = length; text = Decompress(&spec, 0, -1, 10000000, 0); if (!text) return FALSE; Append_Byte(text, 0); #ifdef DUMP_INIT_SCRIPT f = _open("host-boot.r", _O_CREAT | _O_RDWR, _S_IREAD | _S_IWRITE ); _write(f, STR_HEAD(text), LEN_BYTES(STR_HEAD(text))); _close(f); #endif SAVE_SERIES(text); val = Do_String(text->data, flags); UNSAVE_SERIES(text); if (IS_ERROR(val)) // && (VAL_ERR_NUM(val) != RE_QUIT)) { Print_Value(val, 1000, FALSE); if (result) { *result = Value_To_RXI(val); return Reb_To_RXT[VAL_TYPE(val)]; } return 0; }
STOID Mold_Typeset(REBVAL *value, REB_MOLD *mold, REBFLG molded) { REBINT n; if (molded) { Pre_Mold(value, mold); // #[typeset! or make typeset! Append_Byte(mold->series, '['); } // Convert bits to types (we can make this more efficient !!) for (n = 0; n < REB_MAX; n++) { if (TYPE_CHECK(value, n)) { Emit(mold, "+DN ", SYM_DATATYPE_TYPE, n + 1); } } Trim_Tail(mold->series, ' '); if (molded) { //Form_Typeset(value, mold & ~(1<<MOPT_MOLD_ALL)); Append_Byte(mold->series, ']'); End_Mold(mold); } }
STOID Mold_Map(REBVAL *value, REB_MOLD *mold, REBFLG molded) { REBSER *mapser = VAL_SERIES(value); REBVAL *val; // Prevent endless mold loop: if (Find_Same_Block(MOLD_LOOP, value) > 0) { Append_Bytes(mold->series, "...]"); return; } Append_Val(MOLD_LOOP, value); if (molded) { Pre_Mold(value, mold); Append_Byte(mold->series, '['); } // Mold all non-none entries mold->indent++; for (val = BLK_HEAD(mapser); NOT_END(val) && NOT_END(val+1); val += 2) { if (!IS_NONE(val+1)) { if (molded) New_Indented_Line(mold); Emit(mold, "V V", val, val+1); if (!molded) Append_Byte(mold->series, '\n'); } } mold->indent--; if (molded) { New_Indented_Line(mold); Append_Byte(mold->series, ']'); } End_Mold(mold); Remove_Last(MOLD_LOOP); }
static REBSER *make_string(REBVAL *arg, REBOOL make) { REBSER *ser = 0; // MAKE <type> 123 if (make && (IS_INTEGER(arg) || IS_DECIMAL(arg))) { ser = Make_Binary(Int32s(arg, 0)); } // MAKE/TO <type> <binary!> else if (IS_BINARY(arg)) { REBYTE *bp = VAL_BIN_DATA(arg); REBCNT len = VAL_LEN(arg); switch (What_UTF(bp, len)) { case 0: break; case 8: // UTF-8 encoded bp += 3; len -= 3; break; default: Trap0(RE_BAD_DECODE); } ser = Decode_UTF_String(bp, len, 8); // UTF-8 } // MAKE/TO <type> <any-string> else if (ANY_BINSTR(arg)) { ser = Copy_String(VAL_SERIES(arg), VAL_INDEX(arg), VAL_LEN(arg)); } // MAKE/TO <type> <any-word> else if (ANY_WORD(arg)) { ser = Copy_Mold_Value(arg, TRUE); //ser = Append_UTF8(0, Get_Word_Name(arg), -1); } // MAKE/TO <type> #"A" else if (IS_CHAR(arg)) { ser = (VAL_CHAR(arg) > 0xff) ? Make_Unicode(2) : Make_Binary(2); Append_Byte(ser, VAL_CHAR(arg)); } // MAKE/TO <type> <any-value> // else if (IS_NONE(arg)) { // ser = Make_Binary(0); // } else ser = Copy_Form_Value(arg, 1<<MOPT_TIGHT); return ser; }
*/ void Emit_Time(REB_MOLD *mold, const REBVAL *value) /* ***********************************************************************/ { REB_TIMEF tf; const char *fmt; Split_Time(VAL_TIME(value), &tf); // loses sign if (tf.s == 0 && tf.n == 0) fmt = "I:2"; else fmt = "I:2:2"; if (VAL_TIME(value) < (REBI64)0) Append_Byte(mold->series, '-'); Emit(mold, fmt, tf.h, tf.m, tf.s, 0); if (tf.n > 0) Emit(mold, ".i", tf.n); }
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, "..."); } }
*/ void Mold_Binary(REBVAL *value, REB_MOLD *mold) /* ***********************************************************************/ { REBCNT len = VAL_LEN(value); REBSER *out; switch (Get_System_Int(SYS_OPTIONS, OPTIONS_BINARY_BASE, 16)) { default: case 16: out = Encode_Base16(value, 0, len > 32); break; case 64: Append_Bytes(mold->series, "64"); out = Encode_Base64(value, 0, len > 64); break; case 2: Append_Byte(mold->series, '2'); out = Encode_Base2(value, 0, len > 8); break; } Emit(mold, "#{E}", out); }
*/ REBCNT Modify_String(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, const REBVAL *src_val, REBCNT flags, REBINT dst_len, REBINT dups) /* ** action: INSERT, APPEND, CHANGE ** ** dst_ser: target ** dst_idx: position ** src_val: source ** flags: AN_PART ** dst_len: length to remove ** dups: dup count ** ** return: new dst_idx ** ***********************************************************************/ { REBSER *src_ser = 0; REBCNT src_idx = 0; REBCNT src_len; REBCNT tail = SERIES_TAIL(dst_ser); REBINT size; // total to insert if (dups < 0) return (action == A_APPEND) ? 0 : dst_idx; if (action == A_APPEND || dst_idx > tail) dst_idx = tail; // If the src_val is not a string, then we need to create a string: if (GET_FLAG(flags, AN_SERIES)) { // used to indicate a BINARY series if (IS_INTEGER(src_val)) { src_ser = Append_Byte(0, Int8u(src_val)); // creates a binary } else if (IS_BLOCK(src_val)) { src_ser = Join_Binary(src_val); // NOTE: it's the shared FORM buffer! } else if (IS_CHAR(src_val)) { src_ser = Make_Binary(6); // (I hate unicode) src_ser->tail = Encode_UTF8_Char(BIN_HEAD(src_ser), VAL_CHAR(src_val)); } else if (!ANY_BINSTR(src_val)) Trap_Arg_DEAD_END(src_val); } else if (IS_CHAR(src_val)) { src_ser = Append_Byte(0, VAL_CHAR(src_val)); // unicode ok too } else if (IS_BLOCK(src_val)) { src_ser = Form_Tight_Block(src_val); } else if (!ANY_STR(src_val) || IS_TAG(src_val)) { src_ser = Copy_Form_Value(src_val, 0); } // Use either new src or the one that was passed: if (src_ser) { src_len = SERIES_TAIL(src_ser); } else { src_ser = VAL_SERIES(src_val); src_idx = VAL_INDEX(src_val); src_len = VAL_LEN(src_val); } // For INSERT or APPEND with /PART use the dst_len not src_len: if (action != A_CHANGE && GET_FLAG(flags, AN_PART)) src_len = dst_len; // 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 (dst_ser == src_ser) { src_ser = Copy_Series_Part(src_ser, src_idx, src_len); src_idx = 0; } // Total to insert: size = dups * src_len; if (action != A_CHANGE) { // Always expand dst_ser for INSERT and APPEND actions: Expand_Series(dst_ser, dst_idx, size); } else { if (size > dst_len) Expand_Series(dst_ser, dst_idx, size - dst_len); else if (size < dst_len && GET_FLAG(flags, AN_PART)) Remove_Series(dst_ser, dst_idx, dst_len - size); else if (size + dst_idx > tail) { EXPAND_SERIES_TAIL(dst_ser, size - (tail - dst_idx)); } } // For dup count: for (; dups > 0; dups--) { Insert_String(dst_ser, dst_idx, src_ser, src_idx, src_len, TRUE); dst_idx += src_len; } TERM_SERIES(dst_ser); return (action == A_APPEND) ? 0 : dst_idx; }
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'); } }
*/ void Emit_Date(REB_MOLD *mold, const REBVAL *value_orig) /* ***********************************************************************/ { REBYTE buf[64]; REBYTE *bp = &buf[0]; REBINT tz; REBYTE dash = GET_MOPT(mold, MOPT_SLASH_DATE) ? '/' : '-'; // We don't want to modify the incoming date value we are molding, // so we make a copy that we can tweak during the emit process REBVAL value_buffer = *value_orig; REBVAL *value = &value_buffer; if ( VAL_MONTH(value) == 0 || VAL_MONTH(value) > 12 || VAL_DAY(value) == 0 || VAL_DAY(value) > 31 ) { Append_Unencoded(mold->series, "?date?"); return; } if (VAL_TIME(value) != NO_TIME) Adjust_Date_Zone(value, FALSE); // Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT] bp = Form_Int(bp, (REBINT)VAL_DAY(value)); *bp++ = dash; memcpy(bp, Month_Names[VAL_MONTH(value)-1], 3); bp += 3; *bp++ = dash; bp = Form_Int_Pad(bp, (REBINT)VAL_YEAR(value), 6, -4, '0'); *bp = 0; Append_Unencoded(mold->series, s_cast(buf)); if (VAL_TIME(value) != NO_TIME) { Append_Byte(mold->series, '/'); Emit_Time(mold, value); if (VAL_ZONE(value) != 0) { bp = &buf[0]; tz = VAL_ZONE(value); if (tz < 0) { *bp++ = '-'; tz = -tz; } else *bp++ = '+'; bp = Form_Int(bp, tz/4); *bp++ = ':'; bp = Form_Int_Pad(bp, (tz&3) * 15, 2, 2, '0'); *bp = 0; Append_Unencoded(mold->series, s_cast(buf)); } } }
*/ REBSER *Emit(REB_MOLD *mold, REBYTE *fmt, ...) /* ***********************************************************************/ { va_list args; REBYTE ender = 0; REBSER *series = mold->series; ASSERT2(SERIES_WIDE(series) ==2, 9997); va_start(args, fmt); for (; *fmt; fmt++) { switch (*fmt) { case 'W': // Word symbol Append_UTF8(series, Get_Word_Name(va_arg(args, REBVAL*)), -1); break; case 'V': // Value Mold_Value(mold, va_arg(args, REBVAL*), TRUE); break; case 'S': // String of bytes Append_Bytes(series, va_arg(args, REBYTE*)); break; case 'C': // Char Append_Byte(series, va_arg(args, REBCNT)); break; case 'E': // Series (byte or uni) { REBSER *src = va_arg(args, REBSER*); Insert_String(series, SERIES_TAIL(series), src, 0, SERIES_TAIL(src), 0); } break; case 'I': // Integer Append_Int(series, va_arg(args, REBINT)); break; case 'i': Append_Int_Pad(series, va_arg(args, REBINT), -9); Trim_Tail(mold->series, '0'); break; case '2': // 2 digit int (for time) Append_Int_Pad(series, va_arg(args, REBINT), 2); break; case 'T': // Type name Append_UTF8(series, Get_Type_Name(va_arg(args, REBVAL*)), -1); break; case 'N': // Symbol name Append_UTF8(series, Get_Sym_Name(va_arg(args, REBCNT)), -1); break; case '+': // Add #[ if mold/all if (GET_MOPT(mold, MOPT_MOLD_ALL)) { Append_Bytes(series, "#["); ender = ']'; } break; case 'D': // Datatype symbol: #[type if (ender) { Append_UTF8(series, Get_Sym_Name(va_arg(args, REBCNT)), -1); Append_Byte(series, ' '); } else va_arg(args, REBCNT); // ignore it break; case 'B': // Boot string Append_Boot_Str(series, va_arg(args, REBINT)); break; default: Append_Byte(series, *fmt); } } va_end(args); if (ender) Append_Byte(series, ender); return series; }
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; }
STOID Mold_Block(REBVAL *value, REB_MOLD *mold) { REBYTE *sep; REBOOL all = GET_MOPT(mold, MOPT_MOLD_ALL); REBSER *series = mold->series; REBFLG over = FALSE; if (SERIES_WIDE(VAL_SERIES(value)) == 0) Crash(RP_BAD_WIDTH, sizeof(REBVAL), 0, VAL_TYPE(value)); // Optimize when no index needed: if (VAL_INDEX(value) == 0 && !IS_MAP(value)) // && (VAL_TYPE(value) <= REB_LIT_PATH)) all = FALSE; // If out of range, do not cause error to avoid error looping. if (VAL_INDEX(value) >= VAL_TAIL(value)) over = TRUE; // Force it into [] if (all || (over && !IS_BLOCK(value) && !IS_PAREN(value))) { SET_FLAG(mold->opts, MOPT_MOLD_ALL); Pre_Mold(value, mold); // #[block! part //if (over) Append_Bytes(mold->series, "[]"); //else Mold_Block_Series(mold, VAL_SERIES(value), 0, 0); Post_Mold(value, mold); } else { switch(VAL_TYPE(value)) { case REB_MAP: Pre_Mold(value, mold); sep = 0; case REB_BLOCK: if (GET_MOPT(mold, MOPT_ONLY)) { CLR_FLAG(mold->opts, MOPT_ONLY); // only top level sep = "\000\000"; } else sep = 0; break; case REB_PAREN: sep = "()"; break; case REB_GET_PATH: series = Append_Byte(series, ':'); sep = "/"; break; case REB_LIT_PATH: series = Append_Byte(series, '\''); /* fall through */ case REB_PATH: case REB_SET_PATH: sep = "/"; break; } if (over) Append_Bytes(mold->series, sep ? sep : (REBYTE*)("[]")); else Mold_Block_Series(mold, VAL_SERIES(value), VAL_INDEX(value), sep); if (VAL_TYPE(value) == REB_SET_PATH) Append_Byte(series, ':'); } }
*/ void Mold_Value(REB_MOLD *mold, REBVAL *value, REBFLG molded) /* ** Mold or form any value to string series tail. ** ***********************************************************************/ { REBYTE buf[60]; REBINT len; REBSER *ser = mold->series; CHECK_STACK(&len); ASSERT2(SERIES_WIDE(mold->series) == sizeof(REBUNI), RP_BAD_SIZE); ASSERT2(ser, RP_NO_BUFFER); // Special handling of string series: { if (ANY_STR(value) && !IS_TAG(value)) { // Forming a string: if (!molded) { Insert_String(ser, -1, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0); return; } // Special format for ALL string series when not at head: if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) { Mold_All_String(value, mold); return; } } switch (VAL_TYPE(value)) { case REB_NONE: Emit(mold, "+N", SYM_NONE); break; case REB_LOGIC: // if (!molded || !VAL_LOGIC_WORDS(value) || !GET_MOPT(mold, MOPT_MOLD_ALL)) Emit(mold, "+N", VAL_LOGIC(value) ? SYM_TRUE : SYM_FALSE); // else // Mold_Logic(mold, value); break; case REB_INTEGER: len = Emit_Integer(buf, VAL_INT64(value)); goto append; case REB_DECIMAL: case REB_PERCENT: len = Emit_Decimal(buf, VAL_DECIMAL(value), IS_PERCENT(value)?DEC_MOLD_PERCENT:0, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT], mold->digits); goto append; case REB_MONEY: len = Emit_Money(value, buf, mold->opts); goto append; case REB_CHAR: Mold_Uni_Char(ser, VAL_CHAR(value), (REBOOL)molded, (REBOOL)GET_MOPT(mold, MOPT_MOLD_ALL)); break; case REB_PAIR: len = Emit_Decimal(buf, VAL_PAIR_X(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2); Append_Bytes_Len(ser, buf, len); Append_Byte(ser, 'x'); len = Emit_Decimal(buf, VAL_PAIR_Y(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2); Append_Bytes_Len(ser, buf, len); //Emit(mold, "IxI", VAL_PAIR_X(value), VAL_PAIR_Y(value)); break; case REB_TUPLE: len = Emit_Tuple(value, buf); goto append; case REB_TIME: //len = Emit_Time(value, buf, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT]); Emit_Time(mold, value); break; case REB_DATE: Emit_Date(mold, value); break; case REB_STRING: // FORM happens in top section. Mold_String_Series(value, mold); break; case REB_BINARY: if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) { Mold_All_String(value, mold); return; } Mold_Binary(value, mold); break; case REB_FILE: if (VAL_LEN(value) == 0) { Append_Bytes(ser, "%\"\""); break; } Mold_File(value, mold); break; case REB_EMAIL: case REB_URL: Mold_Url(value, mold); break; case REB_TAG: if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) { Mold_All_String(value, mold); return; } Mold_Tag(value, mold); break; // Mold_Issue(value, mold); // break; case REB_BITSET: Pre_Mold(value, mold); // #[bitset! or make bitset! Mold_Bitset(value, mold); End_Mold(mold); break; case REB_IMAGE: Pre_Mold(value, mold); if (!GET_MOPT(mold, MOPT_MOLD_ALL)) { Append_Byte(ser, '['); Mold_Image_Data(value, mold); Append_Byte(ser, ']'); End_Mold(mold); } else { REBVAL val = *value; VAL_INDEX(&val) = 0; // mold all of it Mold_Image_Data(&val, mold); Post_Mold(value, mold); } break; case REB_BLOCK: case REB_PAREN: if (!molded) Form_Block_Series(VAL_SERIES(value), VAL_INDEX(value), mold, 0); else Mold_Block(value, mold); break; case REB_PATH: case REB_SET_PATH: case REB_GET_PATH: case REB_LIT_PATH: Mold_Block(value, mold); break; case REB_VECTOR: Mold_Vector(value, mold, molded); break; case REB_DATATYPE: if (!molded) Emit(mold, "N", VAL_DATATYPE(value) + 1); else Emit(mold, "+DN", SYM_DATATYPE_TYPE, VAL_DATATYPE(value) + 1); break; case REB_TYPESET: Mold_Typeset(value, mold, molded); break; case REB_WORD: // This is a high frequency function, so it is optimized. Append_UTF8(ser, Get_Sym_Name(VAL_WORD_SYM(value)), -1); break; case REB_SET_WORD: Emit(mold, "W:", value); break; case REB_GET_WORD: Emit(mold, ":W", value); break; case REB_LIT_WORD: Emit(mold, "\'W", value); break; case REB_REFINEMENT: Emit(mold, "/W", value); break; case REB_ISSUE: Emit(mold, "#W", value); break; case REB_CLOSURE: case REB_FUNCTION: case REB_NATIVE: case REB_ACTION: case REB_COMMAND: Mold_Function(value, mold); break; case REB_OBJECT: case REB_MODULE: case REB_PORT: if (!molded) Form_Object(value, mold); else Mold_Object(value, mold); break; case REB_TASK: Mold_Object(value, mold); //// | (1<<MOPT_NO_NONE)); break; case REB_ERROR: Mold_Error(value, mold, molded); break; case REB_MAP: Mold_Map(value, mold, molded); break; case REB_GOB: { REBSER *blk; Pre_Mold(value, mold); blk = Gob_To_Block(VAL_GOB(value)); Mold_Block_Series(mold, blk, 0, 0); End_Mold(mold); } break; case REB_EVENT: Mold_Event(value, mold); break; case REB_REBCODE: case REB_OP: case REB_FRAME: case REB_HANDLE: case REB_STRUCT: case REB_LIBRARY: case REB_UTYPE: // Value has no printable form, so just print its name. if (!molded) Emit(mold, "?T?", value); else Emit(mold, "+T", value); break; case REB_END: case REB_UNSET: if (molded) Emit(mold, "+T", value); break; default: Crash(RP_DATATYPE+5, VAL_TYPE(value)); } return; append: Append_Bytes_Len(ser, buf, len); }
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'); } }