*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
// NOTE: The use_crc flag is not present in Zlib 1.2.8
// Instead, compress's fifth paramter is the compression level
// It can be a value from 1 to 9, or Z_DEFAULT_COMPRESSION if you
// want it to pick what the library author considers the "worth it"
// tradeoff of time to generally suggest.
uLongf size;
REBSER *output;
REBINT err;
REBYTE out_size[sizeof(REBCNT)];
if (len < 0) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = z_compress2(BIN_HEAD(output), &size, BIN_HEAD(input) + index, len, Z_DEFAULT_COMPRESSION);
if (err) {
REBVAL arg;
if (err == Z_MEM_ERROR) Trap_DEAD_END(RE_NO_MEMORY);
SET_INTEGER(&arg, err);
Trap1_DEAD_END(RE_BAD_PRESS, &arg); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
REBCNT_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, sizeof(REBCNT));
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
REBCNT size;
REBSER *output;
REBINT err;
REBYTE out_size[4];
if (len < 0) Trap0(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = Z_compress2(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
if (err) {
if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY);
SET_INTEGER(DS_RETURN, err);
Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
Long_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, 4);
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
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;
}
//
// 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 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;
}