//
// Int32s: C
//
// Get integer as positive, negative 32 bit value.
// Sign field can be
// 0: >= 0
// 1: > 0
// -1: < 0
//
REBINT Int32s(const REBVAL *val, REBINT sign)
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
fail (Error_Out_Of_Range(val));
}
//
// Int8u: C
//
REBINT Int8u(const REBVAL *val)
{
if (VAL_INT64(val) > cast(i64, 255) || VAL_INT64(val) < cast(i64, 0))
fail (Error_Out_Of_Range(val));
return VAL_INT32(val);
}
//
// Int32: C
//
REBINT Int32(const REBVAL *val)
{
REBINT n = 0;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
} else {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
return n;
}
//
// Error_Bad_Path_Range: C
//
REBCTX *Error_Bad_Path_Range(REBPVS *pvs)
{
REBVAL item;
COPY_VALUE(&item, pvs->item, pvs->item_specifier);
return Error_Out_Of_Range(&item);
}
//
// Float_Int16: C
//
REBINT Float_Int16(REBD32 f)
{
if (fabs(f) > (REBD32)(0x7FFF)) {
DS_PUSH_DECIMAL(f);
fail (Error_Out_Of_Range(DS_TOP));
}
return (REBINT)f;
}
//
// Get_Num_From_Arg: C
//
// Get the amount to skip or pick.
// Allow multiple types. Throw error if not valid.
// Note that the result is one-based.
//
REBINT Get_Num_From_Arg(const REBVAL *val)
{
REBINT n;
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32)
fail (Error_Out_Of_Range(val));
n = VAL_INT32(val);
}
else if (IS_DECIMAL(val) || IS_PERCENT(val)) {
if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32)
fail (Error_Out_Of_Range(val));
n = (REBINT)VAL_DECIMAL(val);
}
else if (IS_LOGIC(val))
n = (VAL_LOGIC(val) ? 1 : 2);
else
fail (Error_Invalid_Arg(val));
return n;
}
//
// Int64s: C
//
// Get integer as positive, negative 64 bit value.
// Sign field can be
// 0: >= 0
// 1: > 0
// -1: < 0
//
REBI64 Int64s(const REBVAL *val, REBINT sign)
{
REBI64 n;
if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64)
fail (Error_Out_Of_Range(val));
n = (REBI64)VAL_DECIMAL(val);
} else {
n = VAL_INT64(val);
}
// More efficient to use positive sense:
if (
(sign == 0 && n >= 0) ||
(sign > 0 && n > 0) ||
(sign < 0 && n < 0)
)
return n;
fail (Error_Out_Of_Range(val));
}
//
// Poke_Vector_Fail_If_Locked: C
//
void Poke_Vector_Fail_If_Locked(
REBVAL *value,
const REBVAL *picker,
const REBVAL *poke
) {
REBSER *vect = VAL_SERIES(value);
FAIL_IF_LOCKED_SERIES(vect);
REBINT n;
if (IS_INTEGER(picker) || IS_DECIMAL(picker))
n = Int32(picker);
else
fail (Error_Invalid_Arg(picker));
n += VAL_INDEX(value);
if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect))
fail (Error_Out_Of_Range(picker));
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
REBI64 i;
REBDEC f;
if (IS_INTEGER(poke)) {
i = VAL_INT64(poke);
if (bits > VTUI64)
f = cast(REBDEC, i);
else {
// !!! REVIEW: f was not set in this case; compiler caught the
// unused parameter. So fill with distinctive garbage to make it
// easier to search for if it ever is.
f = -646.699;
}
}
else if (IS_DECIMAL(poke)) {
f = VAL_DECIMAL(poke);
if (bits <= VTUI64)
i = cast(REBINT, f);
}
else fail (Error_Invalid_Arg(poke));
set_vect(bits, vp, n - 1, i, f);
}
//
// Poke_Tuple_Immediate: C
//
// !!! Note: In the current implementation, tuples are immediate values.
// So a POKE only changes the `value` in your hand.
//
void Poke_Tuple_Immediate(
REBVAL *value,
const REBVAL *picker,
const REBVAL *poke
) {
REBYTE *dat = VAL_TUPLE(value);
REBINT len = VAL_TUPLE_LEN(value);
if (len < 3)
len = 3;
REBINT n = Get_Num_From_Arg(picker);
if (n <= 0 || n > cast(REBINT, MAX_TUPLE))
fail (Error_Out_Of_Range(picker));
REBINT i;
if (IS_INTEGER(poke) || IS_DECIMAL(poke))
i = Int32(poke);
else if (IS_BLANK(poke)) {
n--;
CLEAR(dat + n, MAX_TUPLE - n);
VAL_TUPLE_LEN(value) = n;
return;
}
else
fail (poke);
if (i < 0)
i = 0;
else if (i > 255)
i = 255;
dat[n - 1] = i;
if (n > len)
VAL_TUPLE_LEN(value) = n;
}
//
// 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;
}
//
// Error_Bad_Path_Range: C
//
REBCTX *Error_Bad_Path_Range(REBPVS *pvs)
{
return Error_Out_Of_Range(pvs->item);
}
//
// PD_Time: C
//
REBINT PD_Time(REBPVS *pvs)
{
REBVAL *val;
REBINT i;
REBINT n;
REBDEC f;
REB_TIMEF tf;
if (IS_WORD(pvs->select)) {
switch (VAL_WORD_CANON(pvs->select)) {
case SYM_HOUR: i = 0; break;
case SYM_MINUTE: i = 1; break;
case SYM_SECOND: i = 2; break;
default: return PE_BAD_SELECT;
}
}
else if (IS_INTEGER(pvs->select))
i = VAL_INT32(pvs->select) - 1;
else
return PE_BAD_SELECT;
Split_Time(VAL_TIME(pvs->value), &tf); // loses sign
if (!(val = pvs->setval)) {
val = pvs->store;
switch(i) {
case 0: // hours
SET_INTEGER(val, tf.h);
break;
case 1:
SET_INTEGER(val, tf.m);
break;
case 2:
if (tf.n == 0)
SET_INTEGER(val, tf.s);
else
SET_DECIMAL(val, (REBDEC)tf.s + (tf.n * NANO));
break;
default:
return PE_NONE;
}
return PE_USE;
} else {
if (IS_INTEGER(val) || IS_DECIMAL(val)) n = Int32s(val, 0);
else if (IS_NONE(val)) n = 0;
else return PE_BAD_SET;
switch(i) {
case 0:
tf.h = n;
break;
case 1:
tf.m = n;
break;
case 2:
if (IS_DECIMAL(val)) {
f = VAL_DECIMAL(val);
if (f < 0.0) fail (Error_Out_Of_Range(val));
tf.s = (REBINT)f;
tf.n = (REBINT)((f - tf.s) * SEC_SEC);
}
else {
tf.s = n;
tf.n = 0;
}
break;
default:
return PE_BAD_SELECT;
}
VAL_TIME(pvs->value) = Join_Time(&tf, FALSE);
return PE_OK;
}
}
//
// Make_Time: C
//
// Returns NO_TIME if error.
//
REBI64 Make_Time(REBVAL *val)
{
REBI64 secs = 0;
if (IS_TIME(val)) {
secs = VAL_TIME(val);
}
else if (IS_STRING(val)) {
REBYTE *bp;
REBCNT len;
bp = Temp_Byte_Chars_May_Fail(val, MAX_SCAN_TIME, &len, FALSE);
if (!Scan_Time(bp, len, val)) goto no_time;
secs = VAL_TIME(val);
}
else if (IS_INTEGER(val)) {
if (VAL_INT64(val) < -MAX_SECONDS || VAL_INT64(val) > MAX_SECONDS)
fail (Error_Out_Of_Range(val));
secs = VAL_INT64(val) * SEC_SEC;
}
else if (IS_DECIMAL(val)) {
if (VAL_DECIMAL(val) < (REBDEC)(-MAX_SECONDS) || VAL_DECIMAL(val) > (REBDEC)MAX_SECONDS)
fail (Error_Out_Of_Range(val));
secs = DEC_TO_SECS(VAL_DECIMAL(val));
}
else if (ANY_ARRAY(val) && VAL_BLK_LEN(val) <= 3) {
REBFLG neg = FALSE;
REBI64 i;
val = VAL_BLK_DATA(val);
if (!IS_INTEGER(val)) goto no_time;
i = Int32(val);
if (i < 0) i = -i, neg = TRUE;
secs = i * 3600;
if (secs > MAX_SECONDS) goto no_time;
if (NOT_END(++val)) {
if (!IS_INTEGER(val)) goto no_time;
if ((i = Int32(val)) < 0) goto no_time;
secs += i * 60;
if (secs > MAX_SECONDS) goto no_time;
if (NOT_END(++val)) {
if (IS_INTEGER(val)) {
if ((i = Int32(val)) < 0) goto no_time;
secs += i;
if (secs > MAX_SECONDS) goto no_time;
}
else if (IS_DECIMAL(val)) {
if (secs + (REBI64)VAL_DECIMAL(val) + 1 > MAX_SECONDS) goto no_time;
// added in below
}
else goto no_time;
}
}
secs *= SEC_SEC;
if (IS_DECIMAL(val)) secs += DEC_TO_SECS(VAL_DECIMAL(val));
if (neg) secs = -secs;
}
else
no_time: return NO_TIME;
return secs;
}
