*/ 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');
}
}
