*/ void Sieve_Ports(REBSER *ports)
/*
** Remove all ports not found in the WAKE list.
** ports could be NULL, in which case the WAKE list is cleared.
**
***********************************************************************/
{
REBVAL *port;
REBVAL *waked;
REBVAL *val;
REBCNT n;
port = Get_System(SYS_PORTS, PORTS_SYSTEM);
if (!IS_PORT(port)) return;
waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
if (!IS_BLOCK(waked)) return;
for (n = 0; ports && n < SERIES_TAIL(ports);) {
val = BLK_SKIP(ports, n);
if (IS_PORT(val)) {
assert(VAL_TAIL(waked) != 0);
if (VAL_TAIL(waked) == Find_Block_Simple(VAL_SERIES(waked), 0, val)) {//not found
Remove_Series(ports, n, 1);
continue;
}
}
n++;
}
//clear waked list
RESET_SERIES(VAL_SERIES(waked));
}
*/ 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 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 Throw_Return_Value(REBVAL *value)
/*
** Throws a series value using error temp values.
**
***********************************************************************/
{
REBVAL *val;
REBVAL *err;
REBSER *blk = VAL_SERIES(TASK_ERR_TEMPS);
RESET_SERIES(blk);
val = Append_Value(blk);
*val = *value;
err = Append_Value(blk);
SET_THROW(err, RE_RETURN, val);
VAL_ERR_SYM(err) = SYM_RETURN; // indicates it is "virtual" (parse return)
Throw_Break(err);
}
*/ REBSER *Parse_Lines(REBSER *src)
/*
** Convert a string buffer to a block of strings.
** Note that the string must already be converted
** to REBOL LF format (no CRs).
**
***********************************************************************/
{
REBSER *blk;
REBUNI c;
REBCNT i;
REBCNT s;
REBVAL *val;
REBOOL uni = !BYTE_SIZE(src);
REBYTE *bp = BIN_HEAD(src);
REBUNI *up = UNI_HEAD(src);
blk = BUF_EMIT;
RESET_SERIES(blk);
// Scan string, looking for LF and CR terminators:
for (i = s = 0; i < SERIES_TAIL(src); i++) {
c = uni ? up[i] : bp[i];
if (c == LF || c == CR) {
val = Append_Value(blk);
Set_String(val, Copy_String(src, s, i - s));
VAL_SET_LINE(val);
// Skip CRLF if found:
if (c == CR && LF == uni ? up[i] : bp[i]) i++;
s = i;
}
}
// Partial line (no linefeed):
if (s + 1 != i) {
val = Append_Value(blk);
Set_String(val, Copy_String(src, s, i - s));
VAL_SET_LINE(val);
}
return Copy_Block(blk, 0);
}
*/ static REB_R Console_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
***********************************************************************/
{
REBREQ *req;
REBINT result;
REBVAL *arg = D_ARG(2);
REBSER *ser;
Validate_Port(port, action);
arg = D_ARG(2);
*D_OUT = *D_ARG(1);
req = cast(REBREQ*, Use_Port_State(port, RDI_STDIO, sizeof(REBREQ)));
switch (action) {
case A_READ:
// If not open, open it:
if (!IS_OPEN(req)) {
if (OS_DO_DEVICE(req, RDC_OPEN)) Trap_Port_DEAD_END(RE_CANNOT_OPEN, port, req->error);
}
// If no buffer, create a buffer:
arg = OFV(port, STD_PORT_DATA);
if (!IS_STRING(arg) && !IS_BINARY(arg)) {
Set_Binary(arg, MAKE_OS_BUFFER(OUT_BUF_SIZE));
}
ser = VAL_SERIES(arg);
RESET_SERIES(ser);
req->common.data = BIN_HEAD(ser);
req->length = SERIES_AVAIL(ser);
#ifdef nono
// Is the buffer large enough?
req->length = SERIES_AVAIL(ser); // space available
if (req->length < OUT_BUF_SIZE/2) Extend_Series(ser, OUT_BUF_SIZE);
req->length = SERIES_AVAIL(ser);
// Don't make buffer too large: Bug #174 ?????
if (req->length > 1024) req->length = 1024; //???
req->common.data = STR_TAIL(ser); // write at tail //???
if (SERIES_TAIL(ser) == 0) req->actual = 0; //???
#endif
result = OS_DO_DEVICE(req, RDC_READ);
if (result < 0) Trap_Port_DEAD_END(RE_READ_ERROR, port, req->error);
#ifdef nono
// Does not belong here!!
// Remove or replace CRs:
result = 0;
for (n = 0; n < req->actual; n++) {
chr = GET_ANY_CHAR(ser, n);
if (chr == CR) {
chr = LF;
// Skip LF if it follows:
if ((n+1) < req->actual &&
LF == GET_ANY_CHAR(ser, n+1)) n++;
}
SET_ANY_CHAR(ser, result, chr);
result++;
}
#endif
// !!! Among many confusions in this file, it said "Another copy???"
//Set_String(D_OUT, Copy_OS_Str(ser->data, result));
Set_Binary(D_OUT, Copy_Bytes(req->common.data, req->actual));
break;
case A_OPEN:
// ?? why???
//if (OS_DO_DEVICE(req, RDC_OPEN)) Trap_Port_DEAD_END(RE_CANNOT_OPEN, port);
SET_OPEN(req);
break;
case A_CLOSE:
SET_CLOSED(req);
//OS_DO_DEVICE(req, RDC_CLOSE);
break;
case A_OPENQ:
if (IS_OPEN(req)) return R_TRUE;
return R_FALSE;
default:
Trap_Action_DEAD_END(REB_PORT, action);
}
return R_OUT;
}
*/ REBSER *Parse_String(REBSER *series, REBCNT index, REBVAL *rules, REBCNT flags)
/*
***********************************************************************/
{
REBCNT tail = series->tail;
REBSER *blk;
REBSER *set;
REBCNT begin;
REBCNT end;
REBOOL skip_spaces = !(flags & PF_ALL);
REBUNI uc;
blk = BUF_EMIT; // shared series
RESET_SERIES(blk);
// String of delimiters or single character:
if (IS_STRING(rules) || IS_CHAR(rules)) {
begin = Find_Max_Bit(rules);
if (begin <= ' ') begin = ' ' + 1;
set = Make_Bitset(begin);
Set_Bits(set, rules, TRUE);
}
// None, so use defaults ",;":
else {
set = Make_Bitset(1+MAX(',',';'));
Set_Bit(set, ',', TRUE);
Set_Bit(set, ';', TRUE);
}
SAVE_SERIES(set);
// If required, make space delimiters too:
if (skip_spaces) {
for (uc = 1; uc <= ' '; uc++) Set_Bit(set, uc, TRUE);
}
while (index < tail) {
if (--Eval_Count <= 0 || Eval_Signals) Do_Signals();
// Skip whitespace if not /all refinement:
if (skip_spaces) {
uc = 0;
for (; index < tail; index++) {
uc = GET_ANY_CHAR(series, index);
if (!IS_WHITE(uc)) break;
}
}
else
uc = GET_ANY_CHAR(series, index); // prefetch
if (index < tail) {
// Handle quoted strings (in a simple way):
if (uc == '"') {
begin = ++index; // eat quote
for (; index < tail; index++) {
uc = GET_ANY_CHAR(series, index);
if (uc == '"') break;
}
end = index;
if (index < tail) index++;
}
// All other tokens:
else {
begin = index;
for (; index < tail; index++) {
if (Check_Bit(set, GET_ANY_CHAR(series, index), !(flags & PF_CASE))) break;
}
end = index;
}
// Skip trailing spaces:
if (skip_spaces)
for (; index < tail; index++) {
uc = GET_ANY_CHAR(series, index);
if (!IS_WHITE(uc)) break;
}
// Check for and remove separator:
if (Check_Bit(set, GET_ANY_CHAR(series, index), !(flags & PF_CASE))) index++;
// Append new string:
Set_String(Append_Value(blk), Copy_String(series, begin, end - begin));
}
}
UNSAVE_SERIES(set);
return Copy_Block(blk, 0);
}
