//
// Form_Int_Pad: C
//
// Form an integer string in the given buffer with a min
// width padded out with the given character. Len > 0 left
// aligned. Len < 0 is right aligned.
//
// If len = 0 and val = 0, a null string is formed.
// Make sure you have room in your buffer before calling this!
//
REBYTE *Form_Int_Pad(REBYTE *buf, REBI64 val, REBINT max, REBINT len, REBYTE pad)
{
REBYTE tmp[MAX_NUM_LEN];
REBINT n;
n = Form_Int_Len(tmp, val, max + 1);
if (n == 0) {
strcpy(s_cast(buf), "??");
return buf; // too long
}
if (len >= 0) {
strcpy(s_cast(buf), s_cast(tmp));
buf += n;
for (; n < len; n++) *buf++ = pad;
}
else { // len < 0
for (; n < -len; len++) *buf++ = pad;
strcpy(s_cast(buf), s_cast(tmp));
buf += n;
}
*buf = 0;
return buf;
}
//
// MF_Tuple: C
//
void MF_Tuple(REB_MOLD *mo, const REBCEL *v, bool form)
{
UNUSED(form);
// "Buffer must be large enough to hold longest tuple.
// Longest is: (3 digits + '.') * 11 nums + 1 term => 45"
//
// !!! ^-- Out of date comments; TUPLE! needs review and replacement.
//
REBYTE buf[60];
REBCNT len = VAL_TUPLE_LEN(v);
const REBYTE *tp = cast(const REBYTE *, VAL_TUPLE(v));
REBYTE *out = buf;
for (; len > 0; len--, tp++) {
out = Form_Int(out, *tp);
*out++ = '.';
}
len = VAL_TUPLE_LEN(v);
while (len++ < 3) {
*out++ = '0';
*out++ = '.';
}
*--out = 0;
Append_Ascii_Len(mo->series, s_cast(buf), out - buf);
}
*/ DEVICE_CMD Read_DNS(REBREQ *sock)
/*
** Initiate the GetHost request and return immediately.
** Note the temporary results buffer (must be freed later).
**
***********************************************************************/
{
char *host;
#ifdef HAS_ASYNC_DNS
HANDLE handle;
#else
HOSTENT *he;
#endif
host = OS_ALLOC_ARRAY(char, MAXGETHOSTSTRUCT); // be sure to free it
#ifdef HAS_ASYNC_DNS
if (!GET_FLAG(sock->modes, RST_REVERSE)) // hostname lookup
handle = WSAAsyncGetHostByName(Event_Handle, WM_DNS, s_cast(sock->common.data), host, MAXGETHOSTSTRUCT);
else
handle = WSAAsyncGetHostByAddr(Event_Handle, WM_DNS, s_cast(&sock->special.net.remote_ip), 4, AF_INET, host, MAXGETHOSTSTRUCT);
if (handle != 0) {
sock->special.net.host_info = host;
sock->requestee.handle = handle;
return DR_PEND; // keep it on pending list
}
#else
// Use old-style blocking DNS (mainly for testing purposes):
if (GET_FLAG(sock->modes, RST_REVERSE)) {
he = gethostbyaddr(
cast(char*, &sock->special.net.remote_ip), 4, AF_INET
);
if (he) {
sock->special.net.host_info = host; //???
sock->common.data = b_cast(he->h_name);
SET_FLAG(sock->flags, RRF_DONE);
return DR_DONE;
}
}
//
// Dump_Values: C
//
// Print values in raw hex; If memory is corrupted this still needs to work.
//
void Dump_Values(RELVAL *vp, REBCNT count)
{
REBYTE buf[2048];
REBYTE *cp;
REBCNT l, n;
REBCNT *bp = (REBCNT*)vp;
const REBYTE *type;
cp = buf;
for (l = 0; l < count; l++) {
REBVAL *val = cast(REBVAL*, bp);
cp = Form_Hex_Pad(cp, l, 8);
*cp++ = ':';
*cp++ = ' ';
type = Get_Type_Name((REBVAL*)bp);
for (n = 0; n < 11; n++) {
if (*type) *cp++ = *type++;
else *cp++ = ' ';
}
*cp++ = ' ';
for (n = 0; n < sizeof(REBVAL) / sizeof(REBCNT); n++) {
cp = Form_Hex_Pad(cp, *bp++, 8);
*cp++ = ' ';
}
n = 0;
if (IS_WORD(val) || IS_GET_WORD(val) || IS_SET_WORD(val)) {
const REBYTE *name = STR_HEAD(VAL_WORD_SPELLING(val));
n = snprintf(
s_cast(cp), sizeof(buf) - (cp - buf), " (%s)", cs_cast(name)
);
}
*(cp + n) = 0;
Debug_Str(s_cast(buf));
cp = buf;
}
}
*/ DEVICE_CMD Read_IO(REBREQ *req)
/*
** Low level "raw" standard input function.
**
** The request buffer must be long enough to hold result.
**
** Result is NOT terminated (the actual field has length.)
**
***********************************************************************/
{
long total = 0;
int len = req->length;
if (GET_FLAG(req->modes, RDM_NULL)) {
req->common.data[0] = 0;
return DR_DONE;
}
req->actual = 0;
if (Std_Inp >= 0) {
interrupted = 0;
// Perform a processed read or a raw read?
#ifndef HAS_SMART_CONSOLE
if (Term_IO)
total = Read_Line(Term_IO, s_cast(req->common.data), len);
else
#endif
total = read(Std_Inp, req->common.data, len); /* will be restarted in case of signal */
if (total < 0) {
req->error = errno;
return DR_ERROR;
}
if (interrupted) {
char noop[] = "does[]\n";
APPEND_BYTES_LIMIT(req->common.data, cb_cast(noop), len);
total += sizeof(noop);
}
req->actual = total;
}
return DR_DONE;
}
//
// Dump_Bytes: C
//
void Dump_Bytes(REBYTE *bp, REBCNT limit)
{
const REBCNT max_lines = 120;
REBYTE buf[2048];
REBYTE str[40];
REBYTE *cp, *tp;
REBYTE c;
REBCNT l, n;
REBCNT cnt = 0;
cp = buf;
for (l = 0; l < max_lines; l++) {
cp = Form_Hex_Pad(cp, (REBUPT) bp, 8);
*cp++ = ':';
*cp++ = ' ';
tp = str;
for (n = 0; n < 16; n++) {
if (cnt++ >= limit) break;
c = *bp++;
cp = Form_Hex2(cp, c);
if ((n & 3) == 3) *cp++ = ' ';
if ((c < 32) || (c > 126)) c = '.';
*tp++ = c;
}
for (; n < 16; n++) {
c = ' ';
*cp++ = c;
*cp++ = c;
if ((n & 3) == 3) *cp++ = ' ';
if ((c < 32) || (c > 126)) c = '.';
*tp++ = c;
}
*tp++ = 0;
for (tp = str; *tp;) *cp++ = *tp++;
*cp = 0;
Debug_Str(s_cast(buf));
if (cnt >= limit) break;
cp = buf;
}
}
*/ void Debug_Series(const REBSER *ser)
/*
***********************************************************************/
{
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
// This routine is also a little catalog of the outlying series
// types in terms of sizing, just to know what they are.
if (BYTE_SIZE(ser))
Debug_Str(s_cast(BIN_HEAD(ser)));
else if (IS_BLOCK_SERIES(ser)) {
REBVAL value;
// May not actually be a REB_BLOCK, but we put it in a value
// container for now saying it is so we can output it. Because
// it may be a frame or otherwise, we use a raw VAL_SET
VAL_SET(&value, REB_BLOCK);
VAL_SERIES(&value) = m_cast(REBSER *, ser); // not actually modifying
VAL_INDEX(&value) = 0;
Debug_Fmt("%r", &value);
} else if (SERIES_WIDE(ser) == sizeof(REBUNI))
//
// Read_IO: C
//
// Low level "raw" standard input function.
//
// The request buffer must be long enough to hold result.
//
// Result is NOT terminated (the actual field has length.)
//
DEVICE_CMD Read_IO(REBREQ *req)
{
long total = 0;
int len = req->length;
if (GET_FLAG(req->modes, RDM_NULL)) {
req->common.data[0] = 0;
return DR_DONE;
}
req->actual = 0;
if (Std_Inp >= 0) {
interrupted = 0;
// Perform a processed read or a raw read?
#ifndef HAS_SMART_CONSOLE
if (Term_IO)
total = Read_Line(Term_IO, s_cast(req->common.data), len);
else
#endif
total = read(Std_Inp, req->common.data, len); /* will be restarted in case of signal */
if (total < 0) {
req->error = errno;
return DR_ERROR;
}
if (interrupted) {
char noop[] = "does[]\n";
APPEND_BYTES_LIMIT(req->common.data, cb_cast(noop), len);
total += sizeof(noop);
}
req->actual = total;
}
return DR_DONE;
}
*/ void Debug_Series(const REBSER *ser)
/*
***********************************************************************/
{
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
// This routine is also a little catalog of the outlying series
// types in terms of sizing, just to know what they are.
if (BYTE_SIZE(ser))
Debug_Str(s_cast(BIN_HEAD(ser)));
else if (Is_Array_Series(ser)) {
REBVAL value;
// May not actually be a REB_BLOCK, but we put it in a value
// container for now saying it is so we can output it. It may be
// a frame and we may not want to Manage_Series here, so we use a
// raw VAL_SET instead of Val_Init_Block
VAL_SET(&value, REB_BLOCK);
VAL_SERIES(&value) = m_cast(REBSER *, ser); // not actually modifying
VAL_INDEX(&value) = 0;
Debug_Fmt("%r", &value);
} else if (SERIES_WIDE(ser) == sizeof(REBUNI))
/* parse struct attribute */
static void parse_attr (REBVAL *blk, REBINT *raw_size, REBUPT *raw_addr)
{
REBVAL *attr = VAL_BLK_DATA(blk);
*raw_size = -1;
*raw_addr = 0;
while (NOT_END(attr)) {
if (IS_SET_WORD(attr)) {
switch (VAL_WORD_CANON(attr)) {
case SYM_RAW_SIZE:
++ attr;
if (IS_INTEGER(attr)) {
if (*raw_size > 0) /* duplicate raw-size */
raise Error_Invalid_Arg(attr);
*raw_size = VAL_INT64(attr);
if (*raw_size <= 0)
raise Error_Invalid_Arg(attr);
}
else
raise Error_Invalid_Arg(attr);
break;
case SYM_RAW_MEMORY:
++ attr;
if (IS_INTEGER(attr)) {
if (*raw_addr != 0) /* duplicate raw-memory */
raise Error_Invalid_Arg(attr);
*raw_addr = VAL_UNT64(attr);
if (*raw_addr == 0)
raise Error_Invalid_Arg(attr);
}
else
raise Error_Invalid_Arg(attr);
break;
case SYM_EXTERN:
++ attr;
if (*raw_addr != 0) /* raw-memory is exclusive with extern */
raise Error_Invalid_Arg(attr);
if (!IS_BLOCK(attr)
|| VAL_LEN(attr) != 2) {
raise Error_Invalid_Arg(attr);
}
else {
REBVAL *lib;
REBVAL *sym;
CFUNC *addr;
lib = VAL_BLK_SKIP(attr, 0);
sym = VAL_BLK_SKIP(attr, 1);
if (!IS_LIBRARY(lib))
raise Error_Invalid_Arg(attr);
if (IS_CLOSED_LIB(VAL_LIB_HANDLE(lib)))
raise Error_0(RE_BAD_LIBRARY);
if (!ANY_BINSTR(sym))
raise Error_Invalid_Arg(sym);
addr = OS_FIND_FUNCTION(
LIB_FD(VAL_LIB_HANDLE(lib)), s_cast(VAL_DATA(sym))
);
if (!addr)
raise Error_1(RE_SYMBOL_NOT_FOUND, sym);
*raw_addr = cast(REBUPT, addr);
}
break;
/*
case SYM_ALIGNMENT:
++ attr;
if (IS_INTEGER(attr)) {
alignment = VAL_INT64(attr);
} else {
raise Error_Invalid_Arg(attr);
}
break;
*/
default:
raise Error_Invalid_Arg(attr);
}
}
else
raise Error_Invalid_Arg(attr);
++ attr;
}
}
*/ 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));
}
}
}
//
// Call_Core: C
//
// flags:
// 1: wait, is implied when I/O redirection is enabled
// 2: console
// 4: shell
// 8: info
// 16: show
//
// Return -1 on error, otherwise the process return code.
//
// POSIX previous simple version was just 'return system(call);'
// This uses 'execvp' which is "POSIX.1 conforming, UNIX compatible"
//
REB_R Call_Core(REBFRM *frame_) {
PROCESS_INCLUDE_PARAMS_OF_CALL_INTERNAL_P;
UNUSED(REF(console)); // !!! actually not paid attention to, why?
// SECURE was never actually done for R3-Alpha
//
Check_Security(Canon(SYM_CALL), POL_EXEC, ARG(command));
// Make sure that if the output or error series are STRING! or BINARY!,
// they are not read-only, before we try appending to them.
//
if (IS_TEXT(ARG(output)) or IS_BINARY(ARG(output)))
FAIL_IF_READ_ONLY(ARG(output));
if (IS_TEXT(ARG(error)) or IS_BINARY(ARG(error)))
FAIL_IF_READ_ONLY(ARG(error));
char *inbuf;
size_t inbuf_size;
if (not REF(input)) {
null_input_buffer:
inbuf = nullptr;
inbuf_size = 0;
}
else switch (VAL_TYPE(ARG(input))) {
case REB_LOGIC:
goto null_input_buffer;
case REB_TEXT: {
inbuf_size = rebSpellIntoQ(nullptr, 0, ARG(input), rebEND);
inbuf = rebAllocN(char, inbuf_size);
size_t check;
check = rebSpellIntoQ(inbuf, inbuf_size, ARG(input), rebEND);
UNUSED(check);
break; }
case REB_FILE: {
size_t size;
inbuf = s_cast(rebBytes( // !!! why fileNAME size passed in???
&size,
"file-to-local", ARG(input),
rebEND
));
inbuf_size = size;
break; }
case REB_BINARY: {
inbuf = s_cast(rebBytes(&inbuf_size, ARG(input), rebEND));
break; }
default:
panic (ARG(input)); // typechecking should not have allowed it
}
bool flag_wait;
if (
REF(wait)
or (
IS_TEXT(ARG(input)) or IS_BINARY(ARG(input))
or IS_TEXT(ARG(output)) or IS_BINARY(ARG(output))
or IS_TEXT(ARG(error)) or IS_BINARY(ARG(error))
) // I/O redirection implies /WAIT
){
flag_wait = true;
}
else
flag_wait = false;
// We synthesize the argc and argv from the "command", and in the process
// we do dynamic allocations of argc strings through the API. These need
// to be freed before we return.
//
char *cmd;
int argc;
const char **argv;
if (IS_TEXT(ARG(command))) {
//
// !!! POSIX does not offer the ability to take a single command
// line string when invoking a process. You have to use an argv[]
// array. The only workaround to this is to run through a shell--
// but that would give you a new environment. We only parse the
// command line if forced (Windows can call with a single command
// line, but has the reverse problem: it has to make the command
// line out of argv[] parts if you pass an array).
//
if (not REF(shell)) {
REBVAL *block = rebValue(
"parse-command-to-argv*", ARG(command), rebEND
);
Move_Value(ARG(command), block);
rebRelease(block);
goto block_command;
}
cmd = rebSpell(ARG(command), rebEND);
argc = 1;
argv = rebAllocN(const char*, (argc + 1));
// !!! Make two copies because it frees cmd and all the argv. Review.
//
argv[0] = rebSpell(ARG(command), rebEND);
argv[1] = nullptr;
}
else if (IS_BLOCK(ARG(command))) {
//
// Emit_Decimal: C
//
REBINT Emit_Decimal(
REBYTE *cp,
REBDEC d,
REBFLGS flags, // DEC_MOLD_PERCENT, DEC_MOLD_MINIMAL
REBYTE point,
REBINT decimal_digits
) {
REBYTE *start = cp, *sig, *rve;
int e, sgn;
REBINT digits_obtained;
/* sanity checks */
if (decimal_digits < MIN_DIGITS) decimal_digits = MIN_DIGITS;
else if (decimal_digits > MAX_DIGITS) decimal_digits = MAX_DIGITS;
sig = (REBYTE *) dtoa (d, 0, decimal_digits, &e, &sgn, (char **) &rve);
digits_obtained = rve - sig;
/* handle sign */
if (sgn) *cp++ = '-';
if (flags & DEC_MOLD_PERCENT) e += 2;
if ((e > decimal_digits) || (e <= -6)) {
/* e-format */
*cp++ = *sig++;
/* insert the radix point */
*cp++ = point;
/* insert the rest */
memcpy(cp, sig, digits_obtained - 1);
cp += digits_obtained - 1;
} else if (e > 0) {
if (e <= digits_obtained) {
/* insert digits preceding point */
memcpy (cp, sig, e);
cp += e;
sig += e;
*cp++ = point;
/* insert digits following point */
memcpy(cp, sig, digits_obtained - e);
cp += digits_obtained - e;
} else {
/* insert all digits obtained */
memcpy (cp, sig, digits_obtained);
cp += digits_obtained;
/* insert zeros preceding point */
memset (cp, '0', e - digits_obtained);
cp += e - digits_obtained;
*cp++ = point;
}
e = 0;
} else {
*cp++ = '0';
*cp++ = point;
memset(cp, '0', -e);
cp -= e;
memcpy(cp, sig, digits_obtained);
cp += digits_obtained;
e = 0;
}
// Add at least one zero after point (unless percent or pair):
if (*(cp - 1) == point) {
if ((flags & DEC_MOLD_PERCENT) || (flags & DEC_MOLD_MINIMAL))
cp--;
else
*cp++ = '0';
}
// Add E part if needed:
if (e) {
*cp++ = 'e';
INT_TO_STR(e - 1, cp);
cp = b_cast(strchr(s_cast(cp), 0));
}
if (flags & DEC_MOLD_PERCENT) *cp++ = '%';
*cp = 0;
return cp - start;
}
*/ void Mold_Value(REB_MOLD *mold, const REBVAL *value, REBFLG molded)
/*
** Mold or form any value to string series tail.
**
***********************************************************************/
{
REBYTE buf[60];
REBINT len;
REBSER *ser = mold->series;
CHECK_C_STACK_OVERFLOW(&len);
assert(SERIES_WIDE(mold->series) == sizeof(REBUNI));
assert(ser);
// 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_Unencoded_Len(ser, s_cast(buf), len);
Append_Byte(ser, 'x');
len = Emit_Decimal(buf, VAL_PAIR_Y(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
Append_Unencoded_Len(ser, s_cast(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_Unencoded(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_STRUCT:
{
REBSER *blk;
Pre_Mold(value, mold);
blk = Struct_To_Block(&VAL_STRUCT(value));
Mold_Block_Series(mold, blk, 0, 0);
End_Mold(mold);
}
break;
case REB_ROUTINE:
Pre_Mold(value, mold);
Mold_Block_Series(mold, VAL_ROUTINE_SPEC(value), 0, NULL);
End_Mold(mold);
break;
case REB_LIBRARY:
Pre_Mold(value, mold);
DS_PUSH_NONE;
*DS_TOP = *(REBVAL*)SERIES_DATA(VAL_LIB_SPEC(value));
Mold_File(DS_TOP, mold);
DS_DROP;
End_Mold(mold);
break;
case REB_CALLBACK:
Pre_Mold(value, mold);
Mold_Block_Series(mold, VAL_ROUTINE_SPEC(value), 0, NULL);
End_Mold(mold);
break;
case REB_REBCODE:
case REB_OP:
case REB_FRAME:
case REB_HANDLE:
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:
assert(FALSE);
Panic_Core(RP_DATATYPE+5, VAL_TYPE(value));
}
return;
append:
Append_Unencoded_Len(ser, s_cast(buf), len);
}
//
// Mold_Vector: C
//
void Mold_Vector(const REBVAL *value, REB_MOLD *mold, REBOOL molded)
{
REBSER *vect = VAL_SERIES(value);
REBYTE *data = SER_DATA_RAW(vect);
REBCNT bits = VECT_TYPE(vect);
// REBCNT dims = vect->size >> 8;
REBCNT len;
REBCNT n;
REBCNT c;
union {REBU64 i; REBDEC d;} v;
REBYTE buf[32];
REBYTE l;
if (GET_MOPT(mold, MOPT_MOLD_ALL)) {
len = VAL_LEN_HEAD(value);
n = 0;
} else {
len = VAL_LEN_AT(value);
n = VAL_INDEX(value);
}
if (molded) {
enum Reb_Kind kind = (bits >= VTSF08) ? REB_DECIMAL : REB_INTEGER;
Pre_Mold(value, mold);
if (!GET_MOPT(mold, MOPT_MOLD_ALL))
Append_Codepoint_Raw(mold->series, '[');
if (bits >= VTUI08 && bits <= VTUI64)
Append_Unencoded(mold->series, "unsigned ");
Emit(
mold,
"N I I [",
Canon(SYM_FROM_KIND(kind)),
bit_sizes[bits & 3],
len
);
if (len)
New_Indented_Line(mold);
}
c = 0;
for (; n < SER_LEN(vect); n++) {
v.i = get_vect(bits, data, n);
if (bits < VTSF08) {
l = Emit_Integer(buf, v.i);
} else {
l = Emit_Decimal(buf, v.d, 0, '.', mold->digits);
}
Append_Unencoded_Len(mold->series, s_cast(buf), l);
if ((++c > 7) && (n + 1 < SER_LEN(vect))) {
New_Indented_Line(mold);
c = 0;
}
else
Append_Codepoint_Raw(mold->series, ' ');
}
if (len) {
//
// remove final space (overwritten with terminator)
//
TERM_UNI_LEN(mold->series, UNI_LEN(mold->series) - 1);
}
if (molded) {
if (len) New_Indented_Line(mold);
Append_Codepoint_Raw(mold->series, ']');
if (!GET_MOPT(mold, MOPT_MOLD_ALL)) {
Append_Codepoint_Raw(mold->series, ']');
}
else {
Post_Mold(value, mold);
}
}
}
