*/ void Reset_Mold(REB_MOLD *mold)
/*
***********************************************************************/
{
REBSER *buf = BUF_MOLD;
REBINT len;
if (!buf) Panic(RP_NO_BUFFER);
if (SERIES_REST(buf) > MAX_COMMON)
Shrink_Series(buf, MIN_COMMON);
BLK_RESET(MOLD_LOOP);
RESET_SERIES(buf);
mold->series = buf;
// This is not needed every time, but w/o a functional way to set the option,
// it must be done like this and each time.
if (GET_MOPT(mold, MOPT_MOLD_ALL)) len = MAX_DIGITS;
else {
// !!! It may be necessary to mold out values before the options
// block is loaded, and this 'Get_System_Int' is a bottleneck which
// crashes that in early debugging. BOOT_ERRORS is sufficient.
if (PG_Boot_Phase >= BOOT_ERRORS)
len = Get_System_Int(SYS_OPTIONS, OPTIONS_DECIMAL_DIGITS, MAX_DIGITS);
else
len = MAX_DIGITS;
if (len > MAX_DIGITS) len = MAX_DIGITS;
else if (len < 0) len = 0;
}
mold->digits = len;
}
*/ void Reset_Mold(REB_MOLD *mold)
/*
***********************************************************************/
{
REBSER *buf = BUF_MOLD;
REBINT len;
if (!buf) Crash(RP_NO_BUFFER);
if (SERIES_REST(buf) > MAX_COMMON)
Shrink_Series(buf, MIN_COMMON);
BLK_RESET(MOLD_LOOP);
RESET_SERIES(buf);
mold->series = buf;
// This is not needed every time, but w/o a functional way to set the option,
// it must be done like this and each time.
if (GET_MOPT(mold, MOPT_MOLD_ALL)) len = MAX_DIGITS;
else {
len = Get_System_Int(SYS_OPTIONS, OPTIONS_DECIMAL_DIGITS, MAX_DIGITS);
if (len > MAX_DIGITS) len = MAX_DIGITS;
else if (len < 0) len = 0;
}
mold->digits = len;
}
*/ void Init_Words(REBFLG only)
/*
** Only flags BIND_Table creation only (for threads).
**
***********************************************************************/
{
REBCNT n = Get_Hash_Prime(WORD_TABLE_SIZE * 4); // extra to reduce rehashing
if (!only) {
// Create the hash for locating words quickly:
// Note that the TAIL is never changed for this series.
PG_Word_Table.hashes = Make_Series(n+1, sizeof(REBCNT), FALSE);
KEEP_SERIES(PG_Word_Table.hashes, "word hashes"); // pointer array
Clear_Series(PG_Word_Table.hashes);
PG_Word_Table.hashes->tail = n;
// The word (symbol) table itself:
PG_Word_Table.series = Make_Block(WORD_TABLE_SIZE);
SET_NONE(BLK_HEAD(PG_Word_Table.series)); // Put a NONE at head.
KEEP_SERIES(PG_Word_Table.series, "word table"); // words are never GC'd
BARE_SERIES(PG_Word_Table.series); // don't bother to GC scan it
PG_Word_Table.series->tail = 1; // prevent the zero case
// A normal char array to hold symbol names:
PG_Word_Names = Make_Binary(6 * WORD_TABLE_SIZE); // average word size
KEEP_SERIES(PG_Word_Names, "word names");
}
// The bind table. Used to cache context indexes for given symbols.
Bind_Table = Make_Series(SERIES_REST(PG_Word_Table.series), 4, FALSE);
KEEP_SERIES(Bind_Table, "bind table"); // numeric table
CLEAR_SERIES(Bind_Table);
Bind_Table->tail = PG_Word_Table.series->tail;
}
*/ void Check_Stack(void)
/*
***********************************************************************/
{
if ((DSP + 100) > (REBINT)SERIES_REST(DS_Series))
Trap0(RE_STACK_OVERFLOW);
}
*/ void Reset_Bias(REBSER *series)
/*
** Reset series bias.
**
***********************************************************************/
{
REBCNT len;
REBYTE *data = series->data;
len = SERIES_BIAS(series);
SERIES_SET_BIAS(series, 0);
SERIES_REST(series) += len;
series->data -= SERIES_WIDE(series) * len;
memmove(series->data, data, SERIES_USED(series));
}
*/ void Dump_Series(REBSER *series, REBYTE *memo)
/*
***********************************************************************/
{
if (!series) return;
Debug_Fmt(
Str_Dump[0], //"%s Series %x %s: Wide: %2d - Bias: %d Tail: %d Rest: %d Size: %6d"
memo,
series,
(SERIES_LABEL(series) ? SERIES_LABEL(series) : "-"),
SERIES_WIDE(series),
SERIES_BIAS(series),
SERIES_TAIL(series),
SERIES_REST(series),
SERIES_TOTAL(series)
);
if (SERIES_WIDE(series) == sizeof(REBVAL))
Dump_Values(BLK_HEAD(series), SERIES_TAIL(series));
else
Dump_Bytes(series->data, (SERIES_TAIL(series)+1) * SERIES_WIDE(series));
}
RL_API int RL_Series(REBSER *series, REBCNT what)
/*
** Get series information.
**
** Returns:
** Returns information related to a series.
** Arguments:
** series - any series pointer (string or block)
** what - indicates what information to return (see RXI_SER enum)
** Notes:
** Invalid what arg nums will return zero.
*/
{
switch (what) {
case RXI_SER_DATA: return (int)SERIES_DATA(series); // problem for 64 bit !!
case RXI_SER_TAIL: return SERIES_TAIL(series);
case RXI_SER_LEFT: return SERIES_AVAIL(series);
case RXI_SER_SIZE: return SERIES_REST(series);
case RXI_SER_WIDE: return SERIES_WIDE(series);
}
return 0;
}
*/ void Append_Mem_Extra(REBSER *series, const REBYTE *data, REBCNT len, REBCNT extra)
/*
** An optimized function for appending raw memory bytes to
** a byte-sized series. The series will be expanded if room
** is needed. A zero terminator will be added at the tail.
** The extra size will be assured in the series, but is not
** part of the appended length. (Allows adding additional bytes.)
**
***********************************************************************/
{
REBCNT tail = series->tail;
if ((tail + len + extra + 1) >= SERIES_REST(series)) {
Expand_Series(series, tail, len+extra); // series->tail changed
series->tail -= extra;
}
else {
series->tail += len;
}
memcpy(series->data + tail, data, len);
STR_TERM(series);
}
*/ void Remove_Series(REBSER *series, REBCNT index, REBINT len)
/*
** Remove a series of values (bytes, longs, reb-vals) from the
** series at the given index.
**
***********************************************************************/
{
REBCNT start;
REBCNT length;
REBYTE *data;
if (len <= 0) return;
// Optimized case of head removal:
if (index == 0) {
if ((REBCNT)len > series->tail) len = series->tail;
SERIES_TAIL(series) -= len;
if (SERIES_TAIL(series) == 0) {
// Reset bias to zero:
len = SERIES_BIAS(series);
SERIES_SET_BIAS(series, 0);
SERIES_REST(series) += len;
series->data -= SERIES_WIDE(series) * len;
CLEAR(series->data, SERIES_WIDE(series)); // terminate
} else {
// Add bias to head:
REBCNT bias = SERIES_BIAS(series);
if (REB_U32_ADD_OF(bias, len, &bias))
raise Error_0(RE_OVERFLOW);
if (bias > 0xffff) { //bias is 16-bit, so a simple SERIES_ADD_BIAS could overflow it
REBYTE *data = series->data;
data += SERIES_WIDE(series) * len;
series->data -= SERIES_WIDE(series) * SERIES_BIAS(series);
SERIES_REST(series) += SERIES_BIAS(series);
SERIES_SET_BIAS(series, 0);
memmove(series->data, data, SERIES_USED(series));
} else {
SERIES_SET_BIAS(series, bias);
SERIES_REST(series) -= len;
series->data += SERIES_WIDE(series) * len;
if ((start = SERIES_BIAS(series))) {
// If more than half biased:
if (start >= MAX_SERIES_BIAS || start > SERIES_REST(series))
Reset_Bias(series);
}
}
}
return;
}
if (index >= series->tail) return;
start = index * SERIES_WIDE(series);
// Clip if past end and optimize the remove operation:
if (len + index >= series->tail) {
series->tail = index;
CLEAR(series->data + start, SERIES_WIDE(series));
return;
}
length = (SERIES_LEN(series) + 1) * SERIES_WIDE(series); // include term.
series->tail -= (REBCNT)len;
len *= SERIES_WIDE(series);
data = series->data + start;
memmove(data, data + len, length - (start + len));
CHECK_MEMORY(5);
}
*/ REBYTE *Scan_Item(REBYTE *src, REBYTE *end, REBUNI term, REBYTE *invalid)
/*
** Scan as UTF8 an item like a file or URL.
**
** Returns continuation point or zero for error.
**
** Put result into the MOLD_BUF as uni-chars.
**
***********************************************************************/
{
REBUNI c;
REBSER *buf;
buf = BUF_MOLD;
RESET_TAIL(buf);
while (src < end && *src != term) {
c = *src;
// End of stream?
if (c == 0) break;
// If no term, then any white will terminate:
if (!term && IS_WHITE(c)) break;
// Ctrl chars are invalid:
if (c < ' ') return 0; // invalid char
if (c == '\\') c = '/';
// Accept %xx encoded char:
else if (c == '%') {
if (!Scan_Hex2(src+1, &c, FALSE)) return 0;
src += 2;
}
// Accept ^X encoded char:
else if (c == '^') {
if (src+1 == end) return 0; // nothing follows ^
c = Scan_Char(&src);
if (!term && IS_WHITE(c)) break;
src--;
}
// Accept UTF8 encoded char:
else if (c >= 0x80) {
c = Decode_UTF8_Char(&src, 0); // zero on error
if (c == 0) return 0;
}
// Is char as literal valid? (e.g. () [] etc.)
else if (invalid && strchr(invalid, c)) return 0;
src++;
*UNI_SKIP(buf, buf->tail) = c; // not affected by Extend_Series
if (++(buf->tail) >= SERIES_REST(buf)) Extend_Series(buf, 1);
}
if (*src && *src == term) src++;
UNI_TERM(buf);
return src;
}
*/ REBYTE *Scan_Quote(REBYTE *src, SCAN_STATE *scan_state)
/*
** Scan a quoted string, handling all the escape characters.
**
** The result will be put into the temporary MOLD_BUF unistring.
**
***********************************************************************/
{
REBINT nest = 0;
REBUNI term;
REBINT chr;
REBCNT lines = 0;
REBSER *buf = BUF_MOLD;
RESET_TAIL(buf);
term = (*src++ == '{') ? '}' : '"'; // pick termination
while (*src != term || nest > 0) {
chr = *src;
switch (chr) {
case 0:
return 0; // Scan_state shows error location.
case '^':
chr = Scan_Char(&src);
if (chr == -1) return 0;
src--;
break;
case '{':
if (term != '"') nest++;
break;
case '}':
if (term != '"' && nest > 0) nest--;
break;
case CR:
if (src[1] == LF) src++;
// fall thru
case LF:
if (term == '"') return 0;
lines++;
chr = LF;
break;
default:
if (chr >= 0x80) {
chr = Decode_UTF8_Char(&src, 0); // zero on error
if (chr == 0) return 0;
}
}
src++;
*UNI_SKIP(buf, buf->tail) = chr;
if (++(buf->tail) >= SERIES_REST(buf)) Extend_Series(buf, 1);
}
src++; // Skip ending quote or brace.
if (scan_state) scan_state->line_count += lines;
UNI_TERM(buf);
return src;
}
