*/ REBSER *Make_Error(REBINT code, REBVAL *arg1, REBVAL *arg2, REBVAL *arg3)
/*
** Create and init a new error object.
**
***********************************************************************/
{
REBSER *err; // Error object
ERROR_OBJ *error; // Error object values
if (PG_Boot_Phase < BOOT_ERRORS) Crash(RP_EARLY_ERROR, code); // Not far enough!
// Make a copy of the error object template:
err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
error = ERR_VALUES(err);
// Set error number:
SET_INTEGER(&error->code, (REBINT)code);
Set_Error_Type(error);
// Set error argument values:
if (arg1) error->arg1 = *arg1;
if (arg2) error->arg2 = *arg2;
if (arg3) error->arg3 = *arg3;
// Set backtrace and location information:
if (DSF > 0) {
// Where (what function) is the error:
Set_Block(&error->where, Make_Backtrace(0));
// Nearby location of the error (in block being evaluated):
error->nearest = *DSF_BACK(DSF);
}
return err;
}
*/ static void Read_File_Port(REBVAL *out, REBSER *port, REBREQ *file, REBVAL *path, REBCNT args, REBCNT len)
/*
** Read from a file port.
**
***********************************************************************/
{
REBSER *ser;
// Allocate read result buffer:
ser = Make_Binary(len);
Set_Series(REB_BINARY, out, ser); //??? what if already set?
// Do the read, check for errors:
file->common.data = BIN_HEAD(ser);
file->length = len;
if (OS_DO_DEVICE(file, RDC_READ) < 0)
Trap_Port(RE_READ_ERROR, port, file->error);
SERIES_TAIL(ser) = file->actual;
STR_TERM(ser);
// Convert to string or block of strings.
// NOTE: This code is incorrect for files read in chunks!!!
if (args & (AM_READ_STRING | AM_READ_LINES)) {
REBSER *nser = Decode_UTF_String(BIN_HEAD(ser), file->actual, -1);
if (nser == NULL) {
Trap(RE_BAD_DECODE);
}
Set_String(out, nser);
if (args & AM_READ_LINES) Set_Block(out, Split_Lines(out));
}
}
STOID Mold_Block_Series(REB_MOLD *mold, REBSER *series, REBCNT index, REBYTE *sep)
{
REBSER *out = mold->series;
REBOOL line_flag = FALSE; // newline was part of block
REBOOL had_lines = FALSE;
REBVAL *value = BLK_SKIP(series, index);
if (!sep) sep = "[]";
if (IS_END(value)) {
Append_Bytes(out, sep);
return;
}
// Recursion check: (variation of: Find_Same_Block(MOLD_LOOP, value))
for (value = BLK_HEAD(MOLD_LOOP); NOT_END(value); value++) {
if (VAL_SERIES(value) == series) {
Emit(mold, "C...C", sep[0], sep[1]);
return;
}
}
value = Append_Value(MOLD_LOOP);
Set_Block(value, series);
if (sep[1]) {
Append_Byte(out, sep[0]);
mold->indent++;
}
// else out->tail--; // why?????
value = BLK_SKIP(series, index);
while (NOT_END(value)) {
if (VAL_GET_LINE(value)) {
if (sep[1] || line_flag) New_Indented_Line(mold);
had_lines = TRUE;
}
line_flag = TRUE;
Mold_Value(mold, value, TRUE);
value++;
if (NOT_END(value))
Append_Byte(out, (sep[0] == '/') ? '/' : ' ');
}
if (sep[1]) {
mold->indent--;
if (VAL_GET_LINE(value) || had_lines) New_Indented_Line(mold);
Append_Byte(out, sep[1]);
}
Remove_Last(MOLD_LOOP);
}
x*/ void RXI_To_Block(RXIFRM *frm, REBVAL *out) {
/*
***********************************************************************/
REBCNT n;
REBSER *blk;
REBVAL *val;
REBCNT len;
blk = Make_Block(len = RXA_COUNT(frm));
for (n = 1; n <= len; n++) {
val = Append_Value(blk);
RXI_To_Value(val, frm->args[n], RXA_TYPE(frm, n));
}
Set_Block(out, blk);
}
*/ RL_API void *RL_Extend(REBYTE *source, RXICAL call)
/*
** Appends embedded extension to system/catalog/boot-exts.
**
** Returns:
** A pointer to the REBOL library (see reb-lib.h).
** Arguments:
** source - A pointer to a UTF-8 (or ASCII) string that provides
** extension module header, function definitions, and other
** related functions and data.
** call - A pointer to the extension's command dispatcher.
** Notes:
** This function simply adds the embedded extension to the
** boot-exts list. All other processing and initialization
** happens later during startup. Each embedded extension is
** queried and init using LOAD-EXTENSION system native.
** See c:extensions-embedded
**
***********************************************************************/
{
REBVAL *value;
REBSER *ser;
value = BLK_SKIP(Sys_Context, SYS_CTX_BOOT_EXTS);
if (IS_BLOCK(value)) ser = VAL_SERIES(value);
else {
ser = Make_Block(2);
Set_Block(value, ser);
}
value = Append_Value(ser);
Set_Binary(value, Copy_Bytes(source, -1)); // UTF-8
value = Append_Value(ser);
SET_HANDLE(value, call);
return Extension_Lib();
}
*/ static REBFLG Get_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
switch (VAL_WORD_CANON(word)) {
case SYM_OFFSET:
SET_PAIR(val, GOB_X(gob), GOB_Y(gob));
break;
case SYM_SIZE:
SET_PAIR(val, GOB_W(gob), GOB_H(gob));
break;
case SYM_IMAGE:
if (GOB_TYPE(gob) == GOBT_IMAGE) {
// image
}
else goto is_none;
break;
case SYM_DRAW:
if (GOB_TYPE(gob) == GOBT_DRAW) {
Set_Block(val, GOB_CONTENT(gob)); // Note: compiler optimizes SET_BLOCKs below
}
else goto is_none;
break;
case SYM_TEXT:
if (GOB_TYPE(gob) == GOBT_TEXT) {
Set_Block(val, GOB_CONTENT(gob));
}
else if (GOB_TYPE(gob) == GOBT_STRING) {
Set_String(val, GOB_CONTENT(gob));
}
else goto is_none;
break;
case SYM_EFFECT:
if (GOB_TYPE(gob) == GOBT_EFFECT) {
Set_Block(val, GOB_CONTENT(gob));
}
else goto is_none;
break;
case SYM_COLOR:
if (GOB_TYPE(gob) == GOBT_COLOR) {
Set_Tuple_Pixel((REBYTE*)&GOB_CONTENT(gob), val);
}
else goto is_none;
break;
case SYM_ALPHA:
SET_INTEGER(val, GOB_ALPHA(gob));
break;
case SYM_PANE:
if (GOB_PANE(gob))
Set_Block(val, Pane_To_Block(gob, 0, -1));
else
Set_Block(val, Make_Block(0));
break;
case SYM_PARENT:
if (GOB_PARENT(gob)) {
SET_GOB(val, GOB_PARENT(gob));
}
else
is_none:
SET_NONE(val);
break;
case SYM_DATA:
if (GOB_DTYPE(gob) == GOBD_OBJECT) {
SET_OBJECT(val, GOB_DATA(gob));
}
else if (GOB_DTYPE(gob) == GOBD_BLOCK) {
Set_Block(val, GOB_DATA(gob));
}
else if (GOB_DTYPE(gob) == GOBD_STRING) {
Set_String(val, GOB_DATA(gob));
}
else if (GOB_DTYPE(gob) == GOBD_BINARY) {
SET_BINARY(val, GOB_DATA(gob));
}
else if (GOB_DTYPE(gob) == GOBD_INTEGER) {
SET_INTEGER(val, (REBIPT)GOB_DATA(gob));
}
else goto is_none;
break;
case SYM_FLAGS:
Set_Block(val, Flags_To_Block(gob));
break;
default:
return FALSE;
}
return TRUE;
}
*/ static REBFLG Get_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
REBSER *data;
switch (VAL_WORD_CANON(word)) {
case SYM_OFFSET:
SET_PAIR(val, GOB_X(gob), GOB_Y(gob));
break;
case SYM_SIZE:
SET_PAIR(val, GOB_W(gob), GOB_H(gob));
break;
case SYM_IMAGE:
if (GOB_TYPE(gob) == GOBT_IMAGE) {
// image
}
else goto is_none;
break;
#ifdef HAS_WIDGET_GOB
case SYM_WIDGET:
data = VAL_SERIES(GOB_WIDGET_SPEC(gob));
Init_Word(val, VAL_WORD_CANON(BLK_HEAD(data)));
VAL_SET(val, REB_LIT_WORD);
break;
#endif
case SYM_DRAW:
if (GOB_TYPE(gob) == GOBT_DRAW) {
Set_Block(val, GOB_CONTENT(gob)); // Note: compiler optimizes SET_BLOCKs below
}
else goto is_none;
break;
case SYM_TEXT:
if (GOB_TYPE(gob) == GOBT_TEXT) {
Set_Block(val, GOB_CONTENT(gob));
}
else if (GOB_TYPE(gob) == GOBT_STRING) {
Set_String(val, GOB_CONTENT(gob));
}
else goto is_none;
break;
case SYM_EFFECT:
if (GOB_TYPE(gob) == GOBT_EFFECT) {
Set_Block(val, GOB_CONTENT(gob));
}
else goto is_none;
break;
case SYM_COLOR:
if (GOB_TYPE(gob) == GOBT_COLOR) {
Set_Tuple_Pixel((REBYTE*)&GOB_CONTENT(gob), val);
}
else goto is_none;
break;
case SYM_ALPHA:
SET_INTEGER(val, GOB_ALPHA(gob));
break;
case SYM_PANE:
if (GOB_PANE(gob))
Set_Block(val, Pane_To_Block(gob, 0, -1));
else
Set_Block(val, Make_Block(0));
break;
case SYM_PARENT:
if (GOB_PARENT(gob)) {
SET_GOB(val, GOB_PARENT(gob));
}
else
is_none:
SET_NONE(val);
break;
case SYM_DATA:
#ifdef HAS_WIDGET_GOB
if (GOB_TYPE(gob) == GOBT_WIDGET) {
return OS_GET_WIDGET_DATA(gob, val);
}
#endif
data = GOB_DATA(gob);
if (GOB_DTYPE(gob) == GOBD_OBJECT) {
SET_OBJECT(val, data);
}
else if (GOB_DTYPE(gob) == GOBD_BLOCK) {
Set_Block(val, data);
}
else if (GOB_DTYPE(gob) == GOBD_STRING) {
Set_String(val, data);
}
else if (GOB_DTYPE(gob) == GOBD_BINARY) {
SET_BINARY(val, data);
}
else if (GOB_DTYPE(gob) == GOBD_INTEGER) {
SET_INTEGER(val, (REBIPT)data);
}
else goto is_none;
break;
case SYM_FLAGS:
Set_Block(val, Flags_To_Block(gob));
break;
default:
return FALSE;
}
return TRUE;
}
*/ static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
REBVAL *spec;
REBVAL *hndl;
switch (VAL_WORD_CANON(word)) {
case SYM_OFFSET:
return Set_Pair(&(gob->offset), val);
case SYM_SIZE:
return Set_Pair(&gob->size, val);
case SYM_IMAGE:
CLR_GOB_OPAQUE(gob);
if (IS_IMAGE(val)) {
SET_GOB_TYPE(gob, GOBT_IMAGE);
GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val);
GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val);
GOB_CONTENT(gob) = VAL_SERIES(val);
// if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
#ifdef HAS_WIDGET_GOB
case SYM_WIDGET:
//printf("WIDGET GOB\n");
SET_GOB_TYPE(gob, GOBT_WIDGET);
SET_GOB_OPAQUE(gob);
GOB_CONTENT(gob) = Make_Block(4); // [handle type spec data]
hndl = Append_Value(GOB_CONTENT(gob));
Append_Value(GOB_CONTENT(gob)); // used to cache type on host's side
spec = Append_Value(GOB_CONTENT(gob));
Append_Value(GOB_CONTENT(gob)); // used to cache result data
SET_HANDLE(hndl, 0, SYM_WIDGET, 0);
if (IS_WORD(val) || IS_LIT_WORD(val)) {
Set_Block(spec, Make_Block(1));
Append_Val(VAL_SERIES(spec), val);
}
else if (IS_BLOCK(val)) {
Set_Block(spec, VAL_SERIES(val));
}
else return FALSE;
break;
#endif // HAS_WIDGET_GOB
case SYM_DRAW:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_DRAW);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_TEXT:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_TEXT);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_STRING(val)) {
SET_GOB_TYPE(gob, GOBT_STRING);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_EFFECT:
CLR_GOB_OPAQUE(gob);
if (IS_BLOCK(val)) {
SET_GOB_TYPE(gob, GOBT_EFFECT);
GOB_CONTENT(gob) = VAL_SERIES(val);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
break;
case SYM_COLOR:
CLR_GOB_OPAQUE(gob);
if (IS_TUPLE(val)) {
SET_GOB_TYPE(gob, GOBT_COLOR);
Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val);
if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 255)
SET_GOB_OPAQUE(gob);
}
else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE);
break;
case SYM_PANE:
if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob));
if (IS_BLOCK(val))
Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0);
else if (IS_GOB(val))
Insert_Gobs(gob, val, 0, 1, 0);
else if (IS_NONE(val))
gob->pane = 0;
else
return FALSE;
break;
case SYM_ALPHA:
GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255);
break;
case SYM_DATA:
#ifdef HAS_WIDGET_GOB
if (GOB_TYPE(gob) == GOBT_WIDGET) {
OS_SET_WIDGET_DATA(gob, val);
} else {
#endif
SET_GOB_DTYPE(gob, GOBD_NONE);
if (IS_OBJECT(val)) {
SET_GOB_DTYPE(gob, GOBD_OBJECT);
SET_GOB_DATA(gob, VAL_OBJ_FRAME(val));
}
else if (IS_BLOCK(val)) {
SET_GOB_DTYPE(gob, GOBD_BLOCK);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_STRING(val)) {
SET_GOB_DTYPE(gob, GOBD_STRING);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_BINARY(val)) {
SET_GOB_DTYPE(gob, GOBD_BINARY);
SET_GOB_DATA(gob, VAL_SERIES(val));
}
else if (IS_INTEGER(val)) {
SET_GOB_DTYPE(gob, GOBD_INTEGER);
SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val));
}
else if (IS_NONE(val))
SET_GOB_TYPE(gob, GOBT_NONE);
else return FALSE;
#ifdef HAS_WIDGET_GOB
}
#endif
break;
case SYM_FLAGS:
if (IS_WORD(val)) Set_Gob_Flag(gob, val);
else if (IS_BLOCK(val)) {
gob->flags = 0;
for (val = VAL_BLK(val); NOT_END(val); val++) {
if (IS_WORD(val)) Set_Gob_Flag(gob, val);
}
}
break;
case SYM_OWNER:
if (IS_GOB(val))
GOB_TMP_OWNER(gob) = VAL_GOB(val);
else
return FALSE;
break;
default:
return FALSE;
}
return TRUE;
}
*/ void Make_Block_Type(REBFLG make, REBVAL *value, REBVAL *arg)
/*
** Value can be:
** 1. a datatype (e.g. BLOCK!)
** 2. a value (e.g. [...])
**
** Arg can be:
** 1. integer (length of block)
** 2. block (copy it)
** 3. value (convert to a block)
**
***********************************************************************/
{
REBCNT type;
REBCNT len;
REBSER *ser;
// make block! ...
if (IS_DATATYPE(value))
type = VAL_DATATYPE(value);
else // make [...] ....
type = VAL_TYPE(value);
// make block! [1 2 3]
if (ANY_BLOCK(arg)) {
len = VAL_BLK_LEN(arg);
if (len > 0 && type >= REB_PATH && type <= REB_LIT_PATH)
No_Nones(arg);
ser = Copy_Values(VAL_BLK_DATA(arg), len);
goto done;
}
if (IS_STRING(arg)) {
REBCNT index, len = 0;
VAL_SERIES(arg) = Prep_Bin_Str(arg, &index, &len); // (keeps safe)
ser = Scan_Source(VAL_BIN(arg), VAL_LEN(arg));
goto done;
}
if (IS_BINARY(arg)) {
ser = Scan_Source(VAL_BIN_DATA(arg), VAL_LEN(arg));
goto done;
}
if (IS_MAP(arg)) {
ser = Map_To_Block(VAL_SERIES(arg), 0);
goto done;
}
if (ANY_OBJECT(arg)) {
ser = Make_Object_Block(VAL_OBJ_FRAME(arg), 3);
goto done;
}
if (IS_VECTOR(arg)) {
ser = Make_Vector_Block(arg);
goto done;
}
// if (make && IS_NONE(arg)) {
// ser = Make_Block(0);
// goto done;
// }
// to block! typset
if (!make && IS_TYPESET(arg) && type == REB_BLOCK) {
Set_Block(value, Typeset_To_Block(arg));
return;
}
if (make) {
// make block! 10
if (IS_INTEGER(arg) || IS_DECIMAL(arg)) {
len = Int32s(arg, 0);
Set_Series(type, value, Make_Block(len));
return;
}
Trap_Arg(arg);
}
ser = Copy_Values(arg, 1);
done:
Set_Series(type, value, ser);
return;
}
*/ static REB_R Loop_Each(struct Reb_Call *call_, REBINT mode)
/*
** Supports these natives (modes):
** 0: foreach
** 1: remove-each
** 2: map
**
***********************************************************************/
{
REBSER *body;
REBVAL *vars;
REBVAL *words;
REBSER *frame;
REBVAL *value;
REBSER *series;
REBSER *out; // output block (for MAP, mode = 2)
REBINT index; // !!!! should these be REBCNT?
REBINT tail;
REBINT windex; // write
REBINT rindex; // read
REBINT err;
REBCNT i;
REBCNT j;
REBVAL *ds;
assert(mode >= 0 && mode < 3);
value = D_ARG(2); // series
if (IS_NONE(value)) return R_NONE;
body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body
SET_OBJECT(D_ARG(1), frame); // keep GC safe
Set_Block(D_ARG(3), body); // keep GC safe
SET_NONE(D_OUT); // Default result to NONE if the loop does not run
// If it's MAP, create result block:
if (mode == 2) {
out = Make_Block(VAL_LEN(value));
SAVE_SERIES(out);
}
// Get series info:
if (ANY_OBJECT(value)) {
series = VAL_OBJ_FRAME(value);
out = FRM_WORD_SERIES(series); // words (the out local reused)
index = 1;
//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
}
else if (IS_MAP(value)) {
series = VAL_SERIES(value);
index = 0;
//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
}
else {
series = VAL_SERIES(value);
index = VAL_INDEX(value);
if (index >= cast(REBINT, SERIES_TAIL(series))) {
if (mode == 1) {
SET_INTEGER(D_OUT, 0);
} else if (mode == 2) {
Set_Block(D_OUT, out);
UNSAVE_SERIES(out);
}
return R_OUT;
}
}
windex = index;
// Iterate over each value in the series block:
while (index < (tail = SERIES_TAIL(series))) {
rindex = index; // remember starting spot
j = 0;
// Set the FOREACH loop variables from the series:
for (i = 1; i < frame->tail; i++) {
vars = FRM_VALUE(frame, i);
words = FRM_WORD(frame, i);
// var spec is WORD
if (IS_WORD(words)) {
if (index < tail) {
if (ANY_BLOCK(value)) {
*vars = *BLK_SKIP(series, index);
}
else if (ANY_OBJECT(value)) {
if (!VAL_GET_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) {
// Alternate between word and value parts of object:
if (j == 0) {
Init_Word(vars, REB_WORD, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index);
if (NOT_END(vars+1)) index--; // reset index for the value part
}
else if (j == 1)
*vars = *BLK_SKIP(series, index);
else
Trap_Arg_DEAD_END(words);
j++;
}
else {
// Do not evaluate this iteration
index++;
goto skip_hidden;
}
}
else if (IS_VECTOR(value)) {
Set_Vector_Value(vars, series, index);
}
else if (IS_MAP(value)) {
REBVAL *val = BLK_SKIP(series, index | 1);
if (!IS_NONE(val)) {
if (j == 0) {
*vars = *BLK_SKIP(series, index & ~1);
if (IS_END(vars+1)) index++; // only words
}
else if (j == 1)
*vars = *BLK_SKIP(series, index);
else
Trap_Arg_DEAD_END(words);
j++;
}
else {
index += 2;
goto skip_hidden;
}
}
else { // A string or binary
if (IS_BINARY(value)) {
SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index]));
}
else if (IS_IMAGE(value)) {
Set_Tuple_Pixel(BIN_SKIP(series, index), vars);
}
else {
VAL_SET(vars, REB_CHAR);
VAL_CHAR(vars) = GET_ANY_CHAR(series, index);
}
}
index++;
}
else SET_NONE(vars);
}
// var spec is SET_WORD:
else if (IS_SET_WORD(words)) {
if (ANY_OBJECT(value) || IS_MAP(value)) {
*vars = *value;
} else {
VAL_SET(vars, REB_BLOCK);
VAL_SERIES(vars) = series;
VAL_INDEX(vars) = index;
}
//if (index < tail) index++; // do not increment block.
}
else Trap_Arg_DEAD_END(words);
}
if (index == rindex) index++; //the word block has only set-words: foreach [a:] [1 2 3][]
if (!DO_BLOCK(D_OUT, body, 0)) {
if ((err = Check_Error(D_OUT)) >= 0) {
index = rindex;
break;
}
// else CONTINUE:
if (mode == 1) SET_FALSE(D_OUT); // keep the value (for mode == 1)
} else {
err = 0; // prevent later test against uninitialized value
}
if (mode > 0) {
//if (ANY_OBJECT(value)) Trap_Types_DEAD_END(words, REB_BLOCK, VAL_TYPE(value)); //check not needed
// If FALSE return, copy values to the write location:
if (mode == 1) { // remove-each
if (IS_CONDITIONAL_FALSE(D_OUT)) {
REBCNT wide = SERIES_WIDE(series);
// memory areas may overlap, so use memmove and not memcpy!
memmove(series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide);
windex += index - rindex;
// old: while (rindex < index) *BLK_SKIP(series, windex++) = *BLK_SKIP(series, rindex++);
}
}
else
if (!IS_UNSET(D_OUT)) Append_Value(out, D_OUT); // (mode == 2)
}
skip_hidden: ;
}
// Finish up:
if (mode == 1) {
// Remove hole (updates tail):
if (windex < index) Remove_Series(series, windex, index - windex);
SET_INTEGER(D_OUT, index - windex);
return R_OUT;
}
// If MAP...
if (mode == 2) {
UNSAVE_SERIES(out);
if (err != 2) {
// ...and not BREAK/RETURN:
Set_Block(D_OUT, out);
return R_OUT;
}
}
return R_OUT;
}
*/ static int Dir_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
** Internal port handler for file directories.
**
***********************************************************************/
{
REBVAL *spec;
REBVAL *path;
REBVAL *state;
REBREQ dir;
REBCNT args = 0;
REBINT result;
REBCNT len;
//REBYTE *flags;
Validate_Port(port, action);
*D_RET = *D_ARG(1);
CLEARS(&dir);
// Validate and fetch relevant PORT fields:
spec = BLK_SKIP(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) Trap1(RE_INVALID_SPEC, spec);
path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
if (!path) Trap1(RE_INVALID_SPEC, spec);
if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
else if (!IS_FILE(path)) Trap1(RE_INVALID_SPEC, path);
state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open.
//flags = Security_Policy(SYM_FILE, path);
// Get or setup internal state data:
dir.port = port;
dir.device = RDI_FILE;
switch (action) {
case A_READ:
//Trap_Security(flags[POL_READ], POL_READ, path);
args = Find_Refines(ds, ALL_READ_REFS);
if (!IS_BLOCK(state)) { // !!! ignores /SKIP and /PART, for now
Init_Dir_Path(&dir, path, 1, POL_READ);
Set_Block(state, Make_Block(7)); // initial guess
result = Read_Dir(&dir, VAL_SERIES(state));
///OS_FREE(dir.file.path);
if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
*D_RET = *state;
SET_NONE(state);
} else {
len = VAL_BLK_LEN(state);
// !!? Why does this need to copy the block??
Set_Block(D_RET, Copy_Block_Values(VAL_SERIES(state), 0, len, TS_STRING));
}
break;
case A_CREATE:
//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
create:
Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
result = OS_DO_DEVICE(&dir, RDC_CREATE);
///OS_FREE(dir.file.path);
if (result < 0) Trap1(RE_NO_CREATE, path);
if (action == A_CREATE) return R_ARG2;
SET_NONE(state);
break;
case A_RENAME:
if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
else {
REBSER *target;
Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
// Convert file name to OS format:
if (!(target = Value_To_OS_Path(D_ARG(2)))) Trap1(RE_BAD_FILE_PATH, D_ARG(2));
dir.data = BIN_DATA(target);
OS_DO_DEVICE(&dir, RDC_RENAME);
Free_Series(target);
if (dir.error) Trap1(RE_NO_RENAME, path);
}
break;
case A_DELETE:
//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
SET_NONE(state);
Init_Dir_Path(&dir, path, 0, POL_WRITE);
// !!! add *.r deletion
// !!! add recursive delete (?)
result = OS_DO_DEVICE(&dir, RDC_DELETE);
///OS_FREE(dir.file.path);
if (result < 0) Trap1(RE_NO_DELETE, path);
return R_ARG2;
case A_OPEN:
// !! If open fails, what if user does a READ w/o checking for error?
if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
//Trap_Security(flags[POL_READ], POL_READ, path);
args = Find_Refines(ds, ALL_OPEN_REFS);
if (args & AM_OPEN_NEW) goto create;
//if (args & ~AM_OPEN_READ) Trap1(RE_INVALID_SPEC, path);
Set_Block(state, Make_Block(7));
Init_Dir_Path(&dir, path, 1, POL_READ);
result = Read_Dir(&dir, VAL_SERIES(state));
///OS_FREE(dir.file.path);
if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
break;
case A_OPENQ:
if (IS_BLOCK(state)) return R_TRUE;
return R_FALSE;
case A_CLOSE:
SET_NONE(state);
break;
case A_QUERY:
//Trap_Security(flags[POL_READ], POL_READ, path);
SET_NONE(state);
Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ);
if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE;
Ret_Query_File(port, &dir, D_RET);
///OS_FREE(dir.file.path);
break;
//-- Port Series Actions (only called if opened as a port)
case A_LENGTHQ:
len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0;
SET_INTEGER(D_RET, len);
break;
default:
Trap_Action(REB_PORT, action);
}
return R_RET;
}
*/ static int Event_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
***********************************************************************/
{
REBVAL *spec;
REBVAL *state;
REBCNT result;
REBVAL *arg;
REBVAL save_port;
Validate_Port(port, action);
arg = D_ARG(2);
*D_RET = *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(RE_INVALID_SPEC, spec);
// Get or setup internal state data:
if (!IS_BLOCK(state)) Set_Block(state, Make_Block(127));
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(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(arg);
case A_PICK:
act_blk:
save_port = *D_ARG(1); // save for return
*D_ARG(1) = *state;
result = T_Block(ds, action);
SET_FLAG(Eval_Signals, SIG_EVENT_PORT);
if (action == A_INSERT || action == A_APPEND || action == A_REMOVE) {
*D_RET = save_port;
break;
}
return result; // return condition
case A_CLEAR:
VAL_TAIL(state) = 0;
VAL_BLK_TERM(state);
CLR_FLAG(Eval_Signals, SIG_EVENT_PORT);
break;
case A_LENGTHQ:
SET_INTEGER(D_RET, VAL_TAIL(state));
break;
case A_OPEN:
if (!req) { //!!!
req = OS_MAKE_DEVREQ(RDI_EVENT);
SET_OPEN(req);
OS_DO_DEVICE(req, RDC_CONNECT); // stays queued
}
break;
default:
Trap_Action(REB_PORT, action);
}
return R_RET;
}
*/ 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;
}
