*/ static void Sort_String(REBVAL *string, REBFLG ccase, REBVAL *skipv, REBVAL *compv, REBVAL *part, REBFLG all, REBFLG rev)
/*
***********************************************************************/
{
REBCNT len;
REBCNT skip = 1;
REBCNT size = 1;
int (*sfunc)(const void *v1, const void *v2);
// Determine length of sort:
len = Partial(string, 0, part, 0);
if (len <= 1) return;
// Skip factor:
if (!IS_NONE(skipv)) {
skip = Get_Num_Arg(skipv);
if (skip <= 0 || len % skip != 0 || skip > len)
Trap_Arg(skipv);
}
// Use fast quicksort library function:
if (skip > 1) len /= skip, size *= skip;
sfunc = rev ? Compare_Chr_Rev : Compare_Chr;
//!!uni - needs to compare wide chars too
qsort((void *)VAL_DATA(string), len, size * SERIES_WIDE(VAL_SERIES(string)), sfunc);
}
*/ REBVAL *Pick_Block(REBVAL *block, REBVAL *selector)
/*
***********************************************************************/
{
REBINT n = 0;
n = Get_Num_Arg(selector);
n += VAL_INDEX(block) - 1;
if (n < 0 || (REBCNT)n >= VAL_TAIL(block)) return 0;
return VAL_BLK_SKIP(block, n);
}
*/ static void Sort_Block(REBVAL *block, REBFLG ccase, REBVAL *skipv, REBVAL *compv, REBVAL *part, REBFLG all, REBFLG rev)
/*
** series [series!]
** /case {Case sensitive sort}
** /skip {Treat the series as records of fixed size}
** size [integer!] {Size of each record}
** /compare {Comparator offset, block or function}
** comparator [integer! block! function!]
** /part {Sort only part of a series}
** length [number! series!] {Length of series to sort}
** /all {Compare all fields}
** /reverse {Reverse sort order}
**
***********************************************************************/
{
REBCNT len;
REBCNT skip = 1;
REBCNT size = sizeof(REBVAL);
// int (*sfunc)(const void *v1, const void *v2);
sort_flags.cased = ccase;
sort_flags.reverse = rev;
sort_flags.compare = 0;
sort_flags.offset = 0;
if (IS_INTEGER(compv)) sort_flags.offset = Int32(compv)-1;
if (ANY_FUNC(compv)) sort_flags.compare = compv;
// Determine length of sort:
len = Partial1(block, part);
if (len <= 1) return;
// Skip factor:
if (!IS_NONE(skipv)) {
skip = Get_Num_Arg(skipv);
if (skip <= 0 || len % skip != 0 || skip > len)
Trap_Range(skipv);
}
// Use fast quicksort library function:
if (skip > 1) len /= skip, size *= skip;
if (sort_flags.compare)
qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Call);
else
qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Val);
}
*/ REBINT PD_Tuple(REBPVS *pvs)
/*
** Implements PATH and SET_PATH for tuple.
** Sets DS_TOP if found. Always returns 0.
**
***********************************************************************/
{
REBVAL *val;
REBINT n;
REBINT i;
REBYTE *dat;
REBINT len;
dat = VAL_TUPLE(pvs->value);
len = VAL_TUPLE_LEN(pvs->value);
if (len < 3) len = 3;
n = Get_Num_Arg(pvs->select);
if (NZ(val = pvs->setval)) {
if (n <= 0 || n > MAX_TUPLE) return PE_BAD_SELECT;
if (IS_INTEGER(val) || IS_DECIMAL(val)) i = Int32(val);
else if (IS_NONE(val)) {
n--;
CLEAR(dat+n, MAX_TUPLE-n);
VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
}
else return PE_BAD_SET;
if (i < 0) i = 0;
else if (i > 255) i = 255;
dat[n-1] = i;
if (n > len) VAL_TUPLE_LEN(pvs->value) = n;
return PE_OK;
} else {
if (n > 0 && n <= len) {
SET_INTEGER(pvs->store, dat[n-1]);
return PE_USE;
}
else return PE_NONE;
}
}
//
// Transport_Actor: C
//
static REB_R Transport_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action, enum Transport_Types proto)
{
REBREQ *sock; // IO request
REBVAL *spec; // port spec
REBVAL *arg; // action argument value
REBVAL *val; // e.g. port number value
REBINT result; // IO result
REBCNT refs; // refinement argument flags
REBCNT len; // generic length
REBSER *ser; // simplifier
Validate_Port(port, action);
*D_OUT = *D_ARG(1);
arg = DS_ARGC > 1 ? D_ARG(2) : NULL;
sock = cast(REBREQ*, Use_Port_State(port, RDI_NET, sizeof(*sock)));
if (proto == TRANSPORT_UDP) {
SET_FLAG(sock->modes, RST_UDP);
}
//Debug_Fmt("Sock: %x", sock);
spec = OFV(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) fail (Error(RE_INVALID_PORT));
// sock->timeout = 4000; // where does this go? !!!
// HOW TO PREVENT OVERWRITE DURING BUSY OPERATION!!!
// Should it just ignore it or cause an error?
// Actions for an unopened socket:
if (!IS_OPEN(sock)) {
switch (action) { // Ordered by frequency
case A_OPEN:
arg = Obj_Value(spec, STD_PORT_SPEC_NET_HOST);
val = Obj_Value(spec, STD_PORT_SPEC_NET_PORT_ID);
if (OS_DO_DEVICE(sock, RDC_OPEN))
fail (Error_On_Port(RE_CANNOT_OPEN, port, -12));
SET_OPEN(sock);
// Lookup host name (an extra TCP device step):
if (IS_STRING(arg)) {
sock->common.data = VAL_BIN(arg);
sock->special.net.remote_port = IS_INTEGER(val) ? VAL_INT32(val) : 80;
result = OS_DO_DEVICE(sock, RDC_LOOKUP); // sets remote_ip field
if (result < 0)
fail (Error_On_Port(RE_NO_CONNECT, port, sock->error));
return R_OUT;
}
// Host IP specified:
else if (IS_TUPLE(arg)) {
sock->special.net.remote_port = IS_INTEGER(val) ? VAL_INT32(val) : 80;
memcpy(&sock->special.net.remote_ip, VAL_TUPLE(arg), 4);
break;
}
// No host, must be a LISTEN socket:
else if (IS_NONE(arg)) {
SET_FLAG(sock->modes, RST_LISTEN);
sock->common.data = 0; // where ACCEPT requests are queued
sock->special.net.local_port = IS_INTEGER(val) ? VAL_INT32(val) : 8000;
break;
}
else
fail (Error_On_Port(RE_INVALID_SPEC, port, -10));
case A_CLOSE:
return R_OUT;
case A_OPENQ:
return R_FALSE;
case A_UPDATE: // allowed after a close
break;
default:
fail (Error_On_Port(RE_NOT_OPEN, port, -12));
}
}
// Actions for an open socket:
switch (action) { // Ordered by frequency
case A_UPDATE:
// Update the port object after a READ or WRITE operation.
// This is normally called by the WAKE-UP function.
arg = OFV(port, STD_PORT_DATA);
if (sock->command == RDC_READ) {
if (ANY_BINSTR(arg)) VAL_TAIL(arg) += sock->actual;
}
else if (sock->command == RDC_WRITE) {
SET_NONE(arg); // Write is done.
}
return R_NONE;
case A_READ:
// Read data into a buffer, expanding the buffer if needed.
// If no length is given, program must stop it at some point.
refs = Find_Refines(call_, ALL_READ_REFS);
if (
!GET_FLAG(sock->modes, RST_UDP)
&& !GET_FLAG(sock->state, RSM_CONNECT)
) {
fail (Error_On_Port(RE_NOT_CONNECTED, port, -15));
}
// Setup the read buffer (allocate a buffer if needed):
arg = OFV(port, STD_PORT_DATA);
if (!IS_STRING(arg) && !IS_BINARY(arg)) {
Val_Init_Binary(arg, Make_Binary(NET_BUF_SIZE));
}
ser = VAL_SERIES(arg);
sock->length = SERIES_AVAIL(ser); // space available
if (sock->length < NET_BUF_SIZE/2) Extend_Series(ser, NET_BUF_SIZE);
sock->length = SERIES_AVAIL(ser);
sock->common.data = STR_TAIL(ser); // write at tail
//if (SERIES_TAIL(ser) == 0)
sock->actual = 0; // Actual for THIS read, not for total.
//Print("(max read length %d)", sock->length);
result = OS_DO_DEVICE(sock, RDC_READ); // recv can happen immediately
if (result < 0) fail (Error_On_Port(RE_READ_ERROR, port, sock->error));
break;
case A_WRITE:
// Write the entire argument string to the network.
// The lower level write code continues until done.
refs = Find_Refines(call_, ALL_WRITE_REFS);
if (!GET_FLAG(sock->modes, RST_UDP)
&& !GET_FLAG(sock->state, RSM_CONNECT))
fail (Error_On_Port(RE_NOT_CONNECTED, port, -15));
// Determine length. Clip /PART to size of string if needed.
spec = D_ARG(2);
len = VAL_LEN(spec);
if (refs & AM_WRITE_PART) {
REBCNT n = Int32s(D_ARG(ARG_WRITE_LIMIT), 0);
if (n <= len) len = n;
}
// Setup the write:
*OFV(port, STD_PORT_DATA) = *spec; // keep it GC safe
sock->length = len;
sock->common.data = VAL_BIN_DATA(spec);
sock->actual = 0;
//Print("(write length %d)", len);
result = OS_DO_DEVICE(sock, RDC_WRITE); // send can happen immediately
if (result < 0) fail (Error_On_Port(RE_WRITE_ERROR, port, sock->error));
if (result == DR_DONE) SET_NONE(OFV(port, STD_PORT_DATA));
break;
case A_PICK:
// FIRST server-port returns new port connection.
len = Get_Num_Arg(arg); // Position
if (len == 1 && GET_FLAG(sock->modes, RST_LISTEN) && sock->common.data)
Accept_New_Port(D_OUT, port, sock); // sets D_OUT
else
fail (Error_Out_Of_Range(arg));
break;
case A_QUERY:
// Get specific information - the scheme's info object.
// Special notation allows just getting part of the info.
Ret_Query_Net(port, sock, D_OUT);
break;
case A_OPENQ:
// Connect for clients, bind for servers:
if (sock->state & ((1<<RSM_CONNECT) | (1<<RSM_BIND))) return R_TRUE;
return R_FALSE;
case A_CLOSE:
if (IS_OPEN(sock)) {
OS_DO_DEVICE(sock, RDC_CLOSE);
SET_CLOSED(sock);
}
break;
case A_LENGTH:
arg = OFV(port, STD_PORT_DATA);
len = ANY_SERIES(arg) ? VAL_TAIL(arg) : 0;
SET_INTEGER(D_OUT, len);
break;
case A_OPEN:
result = OS_DO_DEVICE(sock, RDC_CONNECT);
if (result < 0)
fail (Error_On_Port(RE_NO_CONNECT, port, sock->error));
break;
case A_DELETE: // Temporary to TEST error handler!
{
REBVAL *event = Append_Event(); // sets signal
VAL_SET(event, REB_EVENT); // (has more space, if we need it)
VAL_EVENT_TYPE(event) = EVT_ERROR;
VAL_EVENT_DATA(event) = 101;
VAL_EVENT_REQ(event) = sock;
}
break;
default:
fail (Error_Illegal_Action(REB_PORT, action));
}
return R_OUT;
}
*/ static REB_R File_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
** Internal port handler for files.
**
***********************************************************************/
{
REBVAL *spec;
REBVAL *path;
REBREQ *file = 0;
REBCNT args = 0;
REBCNT len;
REBOOL opened = FALSE; // had to be opened (shortcut case)
//Print("FILE ACTION: %r", Get_Action_Word(action));
Validate_Port(port, action);
*D_OUT = *D_ARG(1);
// Validate PORT fields:
spec = BLK_SKIP(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) Trap1_DEAD_END(RE_INVALID_SPEC, spec);
path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
if (!path) Trap1_DEAD_END(RE_INVALID_SPEC, spec);
if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
else if (!IS_FILE(path)) Trap1_DEAD_END(RE_INVALID_SPEC, path);
// Get or setup internal state data:
file = (REBREQ*)Use_Port_State(port, RDI_FILE, sizeof(*file));
switch (action) {
case A_READ:
args = Find_Refines(call_, ALL_READ_REFS);
// Handle the READ %file shortcut case:
if (!IS_OPEN(file)) {
REBCNT nargs = AM_OPEN_READ;
if (args & AM_READ_SEEK) nargs |= AM_OPEN_SEEK;
Setup_File(file, nargs, path);
Open_File_Port(port, file, path);
opened = TRUE;
}
if (args & AM_READ_SEEK) Set_Seek(file, D_ARG(ARG_READ_INDEX));
len = Set_Length(
file, D_REF(ARG_READ_PART) ? VAL_INT64(D_ARG(ARG_READ_LENGTH)) : -1
);
Read_File_Port(D_OUT, port, file, path, args, len);
if (opened) {
OS_DO_DEVICE(file, RDC_CLOSE);
Cleanup_File(file);
}
if (file->error) Trap_Port_DEAD_END(RE_READ_ERROR, port, file->error);
break;
case A_APPEND:
if (!(IS_BINARY(D_ARG(2)) || IS_STRING(D_ARG(2)) || IS_BLOCK(D_ARG(2))))
Trap1_DEAD_END(RE_INVALID_ARG, D_ARG(2));
file->special.file.index = file->special.file.size;
SET_FLAG(file->modes, RFM_RESEEK);
case A_WRITE:
args = Find_Refines(call_, ALL_WRITE_REFS);
spec = D_ARG(2); // data (binary, string, or block)
// Handle the READ %file shortcut case:
if (!IS_OPEN(file)) {
REBCNT nargs = AM_OPEN_WRITE;
if (args & AM_WRITE_SEEK || args & AM_WRITE_APPEND) nargs |= AM_OPEN_SEEK;
else nargs |= AM_OPEN_NEW;
Setup_File(file, nargs, path);
Open_File_Port(port, file, path);
opened = TRUE;
}
else {
if (!GET_FLAG(file->modes, RFM_WRITE)) Trap1_DEAD_END(RE_READ_ONLY, path);
}
// Setup for /append or /seek:
if (args & AM_WRITE_APPEND) {
file->special.file.index = -1; // append
SET_FLAG(file->modes, RFM_RESEEK);
}
if (args & AM_WRITE_SEEK) Set_Seek(file, D_ARG(ARG_WRITE_INDEX));
// Determine length. Clip /PART to size of string if needed.
len = VAL_LEN(spec);
if (args & AM_WRITE_PART) {
REBCNT n = Int32s(D_ARG(ARG_WRITE_LENGTH), 0);
if (n <= len) len = n;
}
Write_File_Port(file, spec, len, args);
if (opened) {
OS_DO_DEVICE(file, RDC_CLOSE);
Cleanup_File(file);
}
if (file->error) Trap1_DEAD_END(RE_WRITE_ERROR, path);
break;
case A_OPEN:
args = Find_Refines(call_, ALL_OPEN_REFS);
// Default file modes if not specified:
if (!(args & (AM_OPEN_READ | AM_OPEN_WRITE))) args |= (AM_OPEN_READ | AM_OPEN_WRITE);
Setup_File(file, args, path);
Open_File_Port(port, file, path); // !!! needs to change file modes to R/O if necessary
break;
case A_COPY:
if (!IS_OPEN(file)) Trap1_DEAD_END(RE_NOT_OPEN, path); //!!!! wrong msg
len = Set_Length(file, D_REF(2) ? VAL_INT64(D_ARG(3)) : -1);
Read_File_Port(D_OUT, port, file, path, args, len);
break;
case A_OPENQ:
if (IS_OPEN(file)) return R_TRUE;
return R_FALSE;
case A_CLOSE:
if (IS_OPEN(file)) {
OS_DO_DEVICE(file, RDC_CLOSE);
Cleanup_File(file);
}
break;
case A_DELETE:
if (IS_OPEN(file)) Trap1_DEAD_END(RE_NO_DELETE, path);
Setup_File(file, 0, path);
if (OS_DO_DEVICE(file, RDC_DELETE) < 0 ) Trap1_DEAD_END(RE_NO_DELETE, path);
break;
case A_RENAME:
if (IS_OPEN(file)) Trap1_DEAD_END(RE_NO_RENAME, path);
else {
REBSER *target;
Setup_File(file, 0, path);
// Convert file name to OS format:
if (!(target = Value_To_OS_Path(D_ARG(2), TRUE)))
Trap1_DEAD_END(RE_BAD_FILE_PATH, D_ARG(2));
file->common.data = BIN_DATA(target);
OS_DO_DEVICE(file, RDC_RENAME);
Free_Series(target);
if (file->error) Trap1_DEAD_END(RE_NO_RENAME, path);
}
break;
case A_CREATE:
// !!! should it leave file open???
if (!IS_OPEN(file)) {
Setup_File(file, AM_OPEN_WRITE | AM_OPEN_NEW, path);
if (OS_DO_DEVICE(file, RDC_CREATE) < 0) Trap_Port_DEAD_END(RE_CANNOT_OPEN, port, file->error);
OS_DO_DEVICE(file, RDC_CLOSE);
}
break;
case A_QUERY:
if (!IS_OPEN(file)) {
Setup_File(file, 0, path);
if (OS_DO_DEVICE(file, RDC_QUERY) < 0) return R_NONE;
}
Ret_Query_File(port, file, D_OUT);
// !!! free file path?
break;
case A_MODIFY:
Set_Mode_Value(file, Get_Mode_Id(D_ARG(2)), D_ARG(3));
if (!IS_OPEN(file)) {
Setup_File(file, 0, path);
if (OS_DO_DEVICE(file, RDC_MODIFY) < 0) return R_NONE;
}
return R_TRUE;
break;
case A_INDEXQ:
SET_INTEGER(D_OUT, file->special.file.index + 1);
break;
case A_LENGTHQ:
SET_INTEGER(D_OUT, file->special.file.size - file->special.file.index); // !clip at zero
break;
case A_HEAD:
file->special.file.index = 0;
goto seeked;
case A_TAIL:
file->special.file.index = file->special.file.size;
goto seeked;
case A_NEXT:
file->special.file.index++;
goto seeked;
case A_BACK:
if (file->special.file.index > 0) file->special.file.index--;
goto seeked;
case A_SKIP:
file->special.file.index += Get_Num_Arg(D_ARG(2));
goto seeked;
case A_HEADQ:
DECIDE(file->special.file.index == 0);
case A_TAILQ:
DECIDE(file->special.file.index >= file->special.file.size);
case A_PASTQ:
DECIDE(file->special.file.index > file->special.file.size);
case A_CLEAR:
// !! check for write enabled?
SET_FLAG(file->modes, RFM_RESEEK);
SET_FLAG(file->modes, RFM_TRUNCATE);
file->length = 0;
if (OS_DO_DEVICE(file, RDC_WRITE) < 0) Trap1_DEAD_END(RE_WRITE_ERROR, path);
break;
/* Not yet implemented:
A_AT, // 38
A_PICK, // 41
A_PATH, // 42
A_PATH_SET, // 43
A_FIND, // 44
A_SELECT, // 45
A_TAKE, // 49
A_INSERT, // 50
A_REMOVE, // 52
A_CHANGE, // 53
A_POKE, // 54
A_QUERY, // 64
A_FLUSH, // 65
*/
default:
Trap_Action_DEAD_END(REB_PORT, action);
}
return R_OUT;
seeked:
SET_FLAG(file->modes, RFM_RESEEK);
return R_ARG1;
is_true:
return R_TRUE;
is_false:
return R_FALSE;
}
*/ REBINT Do_Series_Action(REBCNT action, REBVAL *value, REBVAL *arg)
/*
** Common series functions.
**
***********************************************************************/
{
REBINT index;
REBINT tail;
REBINT len = 0;
// Common setup code for all actions:
if (action != A_MAKE && action != A_TO) {
index = (REBINT)VAL_INDEX(value);
tail = (REBINT)VAL_TAIL(value);
} else return -1;
switch (action) {
//-- Navigation:
case A_HEAD:
VAL_INDEX(value) = 0;
break;
case A_TAIL:
VAL_INDEX(value) = (REBCNT)tail;
break;
case A_HEADQ:
DECIDE(index == 0);
case A_TAILQ:
DECIDE(index >= tail);
case A_PASTQ:
DECIDE(index > tail);
case A_NEXT:
if (index < tail) VAL_INDEX(value)++;
break;
case A_BACK:
if (index > 0) VAL_INDEX(value)--;
break;
case A_SKIP:
case A_AT:
len = Get_Num_Arg(arg);
{
REBI64 i = (REBI64)index + (REBI64)len;
if (action == A_SKIP) {
if (IS_LOGIC(arg)) i--;
} else { // A_AT
if (len > 0) i--;
}
if (i > (REBI64)tail) i = (REBI64)tail;
else if (i < 0) i = 0;
VAL_INDEX(value) = (REBCNT)i;
}
break;
/*
case A_ATZ:
len = Get_Num_Arg(arg);
{
REBI64 idx = Add_Max(0, index, len, MAX_I32);
if (idx < 0) idx = 0;
VAL_INDEX(value) = (REBCNT)idx;
}
break;
*/
case A_INDEXQ:
SET_INTEGER(DS_RETURN, ((REBI64)index) + 1);
return R_RET;
case A_LENGTHQ:
SET_INTEGER(DS_RETURN, tail > index ? tail - index : 0);
return R_RET;
case A_REMOVE:
// /PART length
TRAP_PROTECT(VAL_SERIES(value));
len = DS_REF(2) ? Partial(value, 0, DS_ARG(3), 0) : 1;
index = (REBINT)VAL_INDEX(value);
if (index < tail && len != 0)
Remove_Series(VAL_SERIES(value), VAL_INDEX(value), len);
break;
case A_ADD: // Join_Strings(value, arg);
case A_SUBTRACT: // "test this" - 10
case A_MULTIPLY: // "t" * 4 = "tttt"
case A_DIVIDE:
case A_REMAINDER:
case A_POWER:
case A_ODDQ:
case A_EVENQ:
case A_ABSOLUTE:
Trap_Action(VAL_TYPE(value), action);
default:
return -1;
}
DS_RET_VALUE(value);
return R_RET;
is_false:
return R_FALSE;
is_true:
return R_TRUE;
}
