*/ 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 *Check_Func_Spec(REBSER *block)
/*
** Check function spec of the form:
**
** ["description" arg "notes" [type! type2! ...] /ref ...]
**
** Throw an error for invalid values.
**
***********************************************************************/
{
REBVAL *blk;
REBSER *words;
REBINT n = 0;
REBVAL *value;
blk = BLK_HEAD(block);
words = Collect_Frame(BIND_ALL | BIND_NO_DUP | BIND_NO_SELF, 0, blk);
// !!! needs more checks
for (; NOT_END(blk); blk++) {
switch (VAL_TYPE(blk)) {
case REB_BLOCK:
// Skip the SPEC block as an arg. Use other blocks as datatypes:
if (n > 0) Make_Typeset(VAL_BLK(blk), BLK_SKIP(words, n), 0);
break;
case REB_STRING:
case REB_INTEGER: // special case used by datatype test actions
break;
case REB_WORD:
case REB_GET_WORD:
case REB_LIT_WORD:
n++;
break;
case REB_REFINEMENT:
// Refinement only allows logic! and none! for its datatype:
n++;
value = BLK_SKIP(words, n);
VAL_TYPESET(value) = (TYPESET(REB_LOGIC) | TYPESET(REB_NONE));
break;
case REB_SET_WORD:
default:
Trap1_DEAD_END(RE_BAD_FUNC_DEF, blk);
}
}
return words; //Create_Frame(words, 0);
}
*/ REBSER *Decompress(const REBYTE *data, REBCNT len, REBCNT limit, REBFLG use_crc)
/*
** Decompress a binary (only).
**
** Rebol's compress/decompress functions store an extra length
** at the tail of the data, to double-check the zlib result
**
***********************************************************************/
{
// NOTE: The use_crc flag is not present in Zlib 1.2.8
// There is no fifth parameter to uncompress matching the fifth to compress
uLongf size;
REBSER *output;
REBINT err;
// Get the size from the end and make the output buffer that size.
if (len <= 4) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed
size = Bytes_To_REBCNT(data + len - sizeof(REBCNT));
// NOTE: You can hit this if you 'make prep' without doing a full rebuild
// (If you 'make clean' and build again and this goes away, it was that)
if (limit && size > limit) Trap_Num(RE_SIZE_LIMIT, size);
output = Make_Binary(size);
//DISABLE_GC;
err = z_uncompress(BIN_HEAD(output), &size, data, len);
if (err) {
REBVAL arg;
if (PG_Boot_Phase < 2) return 0;
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;
//ENABLE_GC;
return output;
}
*/ 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;
}
*/ static REB_R Event_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
** Internal port handler for events.
**
***********************************************************************/
{
REBVAL *spec;
REBVAL *state;
REB_R result;
REBVAL *arg;
REBVAL save_port;
Validate_Port(port, action);
arg = D_ARG(2);
*D_OUT = *D_ARG(1);
// Validate and fetch relevant PORT fields:
state = BLK_SKIP(port, STD_PORT_STATE);
spec = BLK_SKIP(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) Trap1_DEAD_END(RE_INVALID_SPEC, spec);
// Get or setup internal state data:
if (!IS_BLOCK(state)) Set_Block(state, Make_Block(EVENTS_CHUNK - 1));
switch (action) {
case A_UPDATE:
return R_NONE;
// Normal block actions done on events:
case A_POKE:
if (!IS_EVENT(D_ARG(3))) Trap_Arg_DEAD_END(D_ARG(3));
goto act_blk;
case A_INSERT:
case A_APPEND:
//case A_PATH: // not allowed: port/foo is port object field access
//case A_PATH_SET: // not allowed: above
if (!IS_EVENT(arg)) Trap_Arg_DEAD_END(arg);
case A_PICK:
act_blk:
save_port = *D_ARG(1); // save for return
*D_ARG(1) = *state;
result = T_Block(call_, action);
SET_SIGNAL(SIG_EVENT_PORT);
if (action == A_INSERT || action == A_APPEND || action == A_REMOVE) {
*D_OUT = save_port;
break;
}
return result; // return condition
case A_CLEAR:
VAL_TAIL(state) = 0;
VAL_BLK_TERM(state);
CLR_SIGNAL(SIG_EVENT_PORT);
break;
case A_LENGTHQ:
SET_INTEGER(D_OUT, VAL_TAIL(state));
break;
case A_OPEN:
if (!req) { //!!!
req = OS_MAKE_DEVREQ(RDI_EVENT);
if (req) {
SET_OPEN(req);
OS_DO_DEVICE(req, RDC_CONNECT); // stays queued
}
}
break;
case A_CLOSE:
OS_ABORT_DEVICE(req);
OS_DO_DEVICE(req, RDC_CLOSE);
// free req!!!
SET_CLOSED(req);
req = 0;
break;
case A_FIND: // add it
default:
Trap_Action_DEAD_END(REB_PORT, action);
}
return R_OUT;
}