//
// Resolve_Path: C
//
// Given a path, determine if it is ultimately specifying a selection out
// of a context...and if it is, return that context. So `a/obj/key` would
// return the object assocated with obj, while `a/str/1` would return
// NULL if `str` were a string as it's not an object selection.
//
// !!! This routine overlaps the logic of Do_Path, and should potentially
// be a mode of that instead. It is not very complete, considering that it
// does not execute GROUP! (and perhaps shouldn't?) and only supports a
// path that picks contexts out of other contexts, via word selection.
//
REBCTX *Resolve_Path(const REBVAL *path, REBCNT *index_out)
{
RELVAL *selector;
const REBVAL *var;
REBARR *array;
REBCNT i;
array = VAL_ARRAY(path);
selector = ARR_HEAD(array);
if (IS_END(selector) || !ANY_WORD(selector))
return NULL; // !!! only handles heads of paths that are ANY-WORD!
var = GET_OPT_VAR_MAY_FAIL(selector, VAL_SPECIFIER(path));
++selector;
if (IS_END(selector))
return NULL; // !!! does not handle single-element paths
while (ANY_CONTEXT(var) && IS_WORD(selector)) {
i = Find_Canon_In_Context(
VAL_CONTEXT(var), VAL_WORD_CANON(selector), FALSE
);
++selector;
if (IS_END(selector)) {
*index_out = i;
return VAL_CONTEXT(var);
}
var = CTX_VAR(VAL_CONTEXT(var), i);
}
DEAD_END;
}
*/ REBFLG Copy_Function(REBVAL *value, REBVAL *args)
/*
***********************************************************************/
{
REBVAL *spec = VAL_BLK(args);
REBVAL *body = VAL_BLK_SKIP(args, 1);
if (IS_END(spec)) body = 0;
else {
// Spec given, must be block or *
if (IS_BLOCK(spec)) {
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
} else
if (!IS_STAR(spec)) return FALSE;
}
if (body && !IS_END(body)) {
if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE;
// Body must be block:
if (!IS_BLOCK(body)) return FALSE;
VAL_FUNC_BODY(value) = VAL_SERIES(body);
}
// No body, use protytpe:
else if (IS_FUNCTION(value) || IS_CLOSURE(value))
VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value));
// Rebind function words:
if (IS_FUNCTION(value))
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));
return TRUE;
}
/*
* cmp_str:
* Compare two strings in the file
*/
int cmp_str(const void *v1, const void *v2)
{
register int c1, c2;
register int n1, n2;
register STR *p1, *p2;
#define SET_N(nf,ch) (nf = (ch == '\n'))
#define IS_END(ch,nf) (ch == Delimch && nf)
p1 = (STR *) v1;
p2 = (STR *) v2;
c1 = p1->first;
c2 = p2->first;
if (c1 != c2)
return c1 - c2;
fseek(Sort_1, p1->pos, 0);
fseek(Sort_2, p2->pos, 0);
n1 = FALSE;
n2 = FALSE;
while (!isalnum(c1 = getc(Sort_1)) && c1 != '\0')
SET_N(n1, c1);
while (!isalnum(c2 = getc(Sort_2)) && c2 != '\0')
SET_N(n2, c2);
while (!IS_END(c1, n1) && !IS_END(c2, n2))
{
if (Iflag)
{
if (isupper(c1))
c1 = tolower(c1);
if (isupper(c2))
c2 = tolower(c2);
}
if (c1 != c2)
return c1 - c2;
SET_N(n1, c1);
SET_N(n2, c2);
c1 = getc(Sort_1);
c2 = getc(Sort_2);
}
if (IS_END(c1, n1))
c1 = 0;
if (IS_END(c2, n2))
c2 = 0;
return c1 - c2;
}
/*
* cmp_str:
* Compare two strings in the file
*/
int
cmp_str(const void *s1, const void *s2)
{
const STR *p1, *p2;
int c1, c2, n1, n2, r;
#define SET_N(nf,ch) (nf = (ch == '\n'))
#define IS_END(ch,nf) (ch == EOF || (ch == (unsigned char)Delimch && nf))
p1 = (const STR *)s1;
p2 = (const STR *)s2;
c1 = (unsigned char)p1->first;
c2 = (unsigned char)p2->first;
if ((r = stable_collate_range_cmp(c1, c2)) != 0)
return (r);
fseeko(Sort_1, p1->pos, SEEK_SET);
fseeko(Sort_2, p2->pos, SEEK_SET);
n1 = false;
n2 = false;
while (!isalnum(c1 = getc(Sort_1)) && c1 != '\0' && c1 != EOF)
SET_N(n1, c1);
while (!isalnum(c2 = getc(Sort_2)) && c2 != '\0' && c2 != EOF)
SET_N(n2, c2);
while (!IS_END(c1, n1) && !IS_END(c2, n2)) {
if (Iflag) {
if (isupper(c1))
c1 = tolower(c1);
if (isupper(c2))
c2 = tolower(c2);
}
if ((r = stable_collate_range_cmp(c1, c2)) != 0)
return (r);
SET_N(n1, c1);
SET_N(n2, c2);
c1 = getc(Sort_1);
c2 = getc(Sort_2);
}
if (IS_END(c1, n1))
c1 = 0;
if (IS_END(c2, n2))
c2 = 0;
return (stable_collate_range_cmp(c1, c2));
}
//
// Resolve_Path: C
//
// Given a path, return a context and index for its terminal.
//
REBCTX *Resolve_Path(REBVAL *path, REBCNT *index)
{
REBVAL *sel; // selector
const REBVAL *val;
REBARR *blk;
REBCNT i;
if (VAL_LEN_HEAD(path) < 2) return 0;
blk = VAL_ARRAY(path);
sel = ARR_HEAD(blk);
if (!ANY_WORD(sel)) return 0;
val = GET_OPT_VAR_MAY_FAIL(sel);
sel = ARR_AT(blk, 1);
while (TRUE) {
if (!ANY_CONTEXT(val) || !IS_WORD(sel)) return 0;
i = Find_Word_In_Context(VAL_CONTEXT(val), VAL_WORD_SYM(sel), FALSE);
sel++;
if (IS_END(sel)) {
*index = i;
return VAL_CONTEXT(val);
}
}
return 0; // never happens
}
*/ static REBFLG Get_Index_Var(REBVAL *item, REBSER *series, REBINT *index)
/*
** Get the series index from a word or path or integer.
**
** Returns: TRUE if value was a series. FALSE if integer.
**
***********************************************************************/
{
REBVAL *hold = item;
if (IS_END(item)) Trap1(RE_PARSE_END, item);
if (IS_WORD(item)) {
if (!VAL_CMD(item)) item = Get_Var(item);
}
else if (IS_PATH(item)) {
REBVAL *path = item;
Do_Path(&path, 0); //!!! function!
item = DS_TOP;
}
else if (!IS_INTEGER(item))
Trap1(RE_PARSE_VARIABLE, hold);
if (IS_INTEGER(item)) {
*index = Int32(item);
return FALSE;
}
if (!ANY_SERIES(item) || VAL_SERIES(item) != series)
Trap1(RE_PARSE_SERIES, hold);
*index = VAL_INDEX(item);
return TRUE;
}
//
// MT_Pair: C
//
REBFLG MT_Pair(REBVAL *out, REBVAL *data, enum Reb_Kind type)
{
REBD32 x;
REBD32 y;
if (IS_PAIR(data)) {
*out = *data;
return TRUE;
}
if (!IS_BLOCK(data)) return FALSE;
data = VAL_ARRAY_AT(data);
if (IS_INTEGER(data)) x = (REBD32)VAL_INT64(data);
else if (IS_DECIMAL(data)) x = (REBD32)VAL_DECIMAL(data);
else return FALSE;
data++;
if (IS_END(data))
return FALSE;
if (IS_INTEGER(data)) y = (REBD32)VAL_INT64(data);
else if (IS_DECIMAL(data)) y = (REBD32)VAL_DECIMAL(data);
else return FALSE;
VAL_RESET_HEADER(out, REB_PAIR);
VAL_PAIR_X(out) = x;
VAL_PAIR_Y(out) = y;
return TRUE;
}
*/ REBINT Cmp_Block(REBVAL *sval, REBVAL *tval, REBFLG is_case)
/*
** Compare two blocks and return the difference of the first
** non-matching value.
**
***********************************************************************/
{
REBVAL *s = VAL_BLK_DATA(sval);
REBVAL *t = VAL_BLK_DATA(tval);
REBINT diff;
CHECK_STACK(&s);
if ((VAL_SERIES(sval)==VAL_SERIES(tval))&&
(VAL_INDEX(sval)==VAL_INDEX(tval)))
return 0;
while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
(IS_NUMBER(s) && IS_NUMBER(t)))) {
if ((diff = Cmp_Value(s, t, is_case)) != 0)
return diff;
s++, t++;
}
return VAL_TYPE(s) - VAL_TYPE(t);
}
*/ REBSER *Make_Object(REBSER *parent, REBVAL *block)
/*
** Create an object from a parent object and a spec block.
** The words within the resultant object are not bound.
**
***********************************************************************/
{
REBSER *words;
REBSER *object;
PG_Reb_Stats->Objects++;
if (!block || IS_END(block)) {
object = parent ? Copy_Block_Values(parent, 0, SERIES_TAIL(parent), TS_CLONE) : Make_Frame(0);
} else {
words = Collect_Frame(BIND_ONLY, parent, block); // GC safe
object = Create_Frame(words, 0); // GC safe
if (parent) {
if (Reb_Opts->watch_obj_copy)
Debug_Fmt(BOOT_STR(RS_WATCH, 2), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
// Copy parent values and deep copy blocks and strings:
COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(object)+1, SERIES_TAIL(parent) - 1);
Copy_Deep_Values(object, 1, SERIES_TAIL(object), TS_CLONE);
}
}
//Dump_Frame(object);
return object;
}
//
// Do_Array_At_Core: C
//
// Most common case of evaluator invocation in Rebol: the data lives in an
// array series. Generic routine takes flags and may act as either a DO
// or a DO/NEXT at the position given. Option to provide an element that
// may not be resident in the array to kick off the execution.
//
REBIXO Do_Array_At_Core(
REBVAL *out,
const REBVAL *opt_first,
REBARR *array,
REBCNT index,
REBFLGS flags
) {
struct Reb_Frame f;
if (opt_first) {
f.value = opt_first;
f.indexor = index;
}
else {
// Do_Core() requires caller pre-seed first value, always
//
f.value = ARR_AT(array, index);
f.indexor = index + 1;
}
if (IS_END(f.value)) {
SET_UNSET(out);
return END_FLAG;
}
f.out = out;
f.source.array = array;
f.flags = flags;
f.mode = CALL_MODE_GUARD_ARRAY_ONLY;
Do_Core(&f);
return f.indexor;
}
void
delete_server(server_t *serverp)
{
service_t *servicep;
service_t *next;
info("Deleting server %s", serverp->cmd);
ASSERT(serverp->prev->next == serverp);
ASSERT(serverp->next->prev == serverp);
serverp->prev->next = serverp->next;
serverp->next->prev = serverp->prev;
for ( servicep = FIRST(services)
; !IS_END(servicep, services)
; servicep = next)
{
next = NEXT(servicep);
if (serverp == servicep->server)
delete_service(servicep);
}
deallocate_bootstrap(serverp->bootstrap);
if (serverp->port)
mach_port_mod_refs(mach_task_self(), serverp->port,
MACH_PORT_RIGHT_RECEIVE, -1);
free(serverp);
}
*/ REBINT PD_Object(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
if (!VAL_OBJ_FRAME(pvs->value)) {
return PE_NONE; // Error objects may not have a frame.
}
if (IS_WORD(pvs->select)) {
n = Find_Word_Index(VAL_OBJ_FRAME(pvs->value), VAL_WORD_SYM(pvs->select), FALSE);
}
// else if (IS_INTEGER(pvs->select)) {
// n = Int32s(pvs->select, 1);
// }
else return PE_BAD_SELECT;
if (n <= 0 || (REBCNT)n >= SERIES_TAIL(VAL_OBJ_FRAME(pvs->value)))
return PE_BAD_SELECT;
if (pvs->setval && IS_END(pvs->path+1) && VAL_PROTECTED(VAL_FRM_WORD(pvs->value, n)))
Trap1(RE_LOCKED_WORD, pvs->select);
pvs->value = VAL_OBJ_VALUES(pvs->value) + n;
return PE_SET;
// if setval, check PROTECT mode!!!
// VAL_FLAGS((VAL_OBJ_VALUES(value) + n)) &= ~FLAGS_CLEAN;
}
void
delete_bootstrap_services(bootstrap_info_t *bootstrap)
{
server_t *serverp;
service_t *servicep;
service_t *next;
for ( servicep = FIRST(services)
; !IS_END(servicep, services)
; servicep = next)
{
next = NEXT(servicep);
if (bootstrap != servicep->bootstrap)
continue;
if (!servicep->isActive || !servicep->server) {
delete_service(servicep);
continue;
}
serverp = servicep->server;
delete_service(servicep);
serverp->active_services--;
if (!active_server(serverp))
delete_server(serverp);
}
}
//
// COPY_VALUE_Debug: C
//
// The implementation of COPY_VALUE_CORE is designed to be fairly optimal
// (since it is being called in lieu of what would have been a memcpy() or
// plain assignment). It is left in its raw form as an inline function to
// to help convey that it is nearly as efficient as an assignment.
//
// This adds some verbose checking in the debug build to help debug cases
// where the relative information bits are incorrect.
//
void COPY_VALUE_Debug(
REBVAL *dest,
const RELVAL *src,
REBCTX *specifier
) {
assert(!IS_END(src));
assert(!IS_TRASH_DEBUG(src));
#ifdef __cplusplus
Assert_Cell_Writable(dest, __FILE__, __LINE__);
#endif
if (IS_RELATIVE(src)) {
assert(ANY_WORD(src) || ANY_ARRAY(src));
if (specifier == SPECIFIED) {
Debug_Fmt("Internal Error: Relative item used with SPECIFIED");
PROBE_MSG(src, "word or array");
PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "func");
assert(FALSE);
}
else if (
VAL_RELATIVE(src)
!= VAL_FUNC(CTX_FRAME_FUNC_VALUE(specifier))
) {
Debug_Fmt("Internal Error: Function mismatch in specific binding");
PROBE_MSG(src, "word or array");
PROBE_MSG(FUNC_VALUE(VAL_RELATIVE(src)), "expected func");
PROBE_MSG(CTX_FRAME_FUNC_VALUE(specifier), "actual func");
assert(FALSE);
}
}
COPY_VALUE_CORE(dest, src, specifier);
}
//
// Next_Path_Throws: C
//
// Evaluate next part of a path.
//
REBOOL Next_Path_Throws(REBPVS *pvs)
{
REBPEF dispatcher;
REBVAL temp;
VAL_INIT_WRITABLE_DEBUG(&temp);
// Path must have dispatcher, else return:
dispatcher = Path_Dispatch[VAL_TYPE_0(pvs->value)];
if (!dispatcher) return FALSE; // unwind, then check for errors
pvs->item++;
//Debug_Fmt("Next_Path: %r/%r", pvs->path-1, pvs->path);
// object/:field case:
if (IS_GET_WORD(pvs->item)) {
pvs->selector = GET_MUTABLE_VAR_MAY_FAIL(pvs->item);
if (IS_UNSET(pvs->selector))
fail (Error(RE_NO_VALUE, pvs->item));
}
// object/(expr) case:
else if (IS_GROUP(pvs->item)) {
if (DO_VAL_ARRAY_AT_THROWS(&temp, pvs->item)) {
*pvs->value = temp;
return TRUE;
}
pvs->selector = &temp;
}
else // object/word and object/value case:
pvs->selector = pvs->item;
switch (dispatcher(pvs)) {
case PE_OK:
break;
case PE_SET_IF_END:
if (pvs->opt_setval && IS_END(pvs->item + 1)) {
*pvs->value = *pvs->opt_setval;
pvs->opt_setval = NULL;
}
break;
case PE_NONE:
SET_NONE(pvs->store);
case PE_USE_STORE:
pvs->value = pvs->store;
break;
default:
assert(FALSE);
}
if (NOT_END(pvs->item + 1)) return Next_Path_Throws(pvs);
return FALSE;
}
*/ void Check_Frame(REBSER *frame)
/*
***********************************************************************/
{
REBINT n;
REBVAL *values = FRM_VALUES(frame);
REBVAL *words = FRM_WORDS(frame);
REBINT tail = SERIES_TAIL(frame);
for (n = 0; n < tail; n++, values++, words++) {
if (IS_END(words) || IS_END(values)) {
Debug_Fmt("** Early %s end at index: %d", IS_END(words) ? "words" : "values", n);
}
}
if (NOT_END(words) || NOT_END(values))
Debug_Fmt("** Missing %s end at index: %d type: %d", NOT_END(words) ? "words" : "values", n, VAL_TYPE(words));
}
int
cmp_str(const void *p1, const void *p2)
{
int c1, c2;
int n1, n2;
# define SET_N(nf,ch) (nf = (ch == '\n'))
# define IS_END(ch,nf) (ch == Delimch && nf)
c1 = ((STR *)p1)->first;
c2 = ((STR *)p2)->first;
if (c1 != c2)
return c1 - c2;
(void) fseek(Sort_1, ((STR *)p1)->pos, SEEK_SET);
(void) fseek(Sort_2, ((STR *)p2)->pos, SEEK_SET);
n1 = FALSE;
n2 = FALSE;
while (!isalnum(c1 = getc(Sort_1)) && c1 != '\0')
SET_N(n1, c1);
while (!isalnum(c2 = getc(Sort_2)) && c2 != '\0')
SET_N(n2, c2);
while (!IS_END(c1, n1) && !IS_END(c2, n2)) {
if (Iflag) {
if (isupper(c1))
c1 = tolower(c1);
if (isupper(c2))
c2 = tolower(c2);
}
if (c1 != c2)
return c1 - c2;
SET_N(n1, c1);
SET_N(n2, c2);
c1 = getc(Sort_1);
c2 = getc(Sort_2);
}
if (IS_END(c1, n1))
c1 = 0;
if (IS_END(c2, n2))
c2 = 0;
return c1 - c2;
}
*/ void Set_Object_Values(REBSER *obj, REBVAL *vals)
/*
***********************************************************************/
{
REBVAL *value;
for (value = FRM_VALUES(obj) + 1; NOT_END(value); value++) { // skip self
if (IS_END(vals)) SET_NONE(value);
else *value = *vals++;
}
}
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);
}
server_t *
lookup_server_by_port(mach_port_t port)
{
server_t *serverp;
for ( serverp = FIRST(servers)
; !IS_END(serverp, servers)
; serverp = NEXT(serverp))
{
if (port == serverp->port)
return serverp;
}
return NULL;
}
service_t *
lookup_service_by_server(server_t *serverp)
{
service_t *servicep;
for ( servicep = FIRST(services)
; !IS_END(servicep, services)
; servicep = NEXT(servicep))
{
if (serverp == servicep->server)
return servicep;
}
return NULL;
}
static inline int get_dir(const char* path ,char* buf ,int* pi ,int* bi)
{
const char* head = NULL;
const char* tail = NULL;
int len = 0;
int path_len = 0;
int ret = 0;
if(IS_END(path))
return END;
path += *pi;
buf += *bi;
path_len = strlen(path);
head = path;
tail = (path_len-1) >= 0 ? memchr(path+1 ,'/' ,path_len-1) : NULL;
if(!tail) // so it must be the last dir
{
len = path_len;
if(IS_RELATIVE(head))
{
buf -= drop_last_dir(buf);
buf[0] = '\0';
return END;
}
buf[len] = '\0'; // end fixed string
ret = LAST;
}
else if(IS_RELATIVE(head))
{
*bi -= drop_last_dir(buf);
*pi += 3; // length of "/.."
return RELATIVE;
}
else // not relative path
{
len = tail - head;
ret = NORMAL;
}
memcpy(buf ,head ,len);
*bi += len;
*pi += len;
return ret;
}
service_t *
lookup_service_by_port(mach_port_t port)
{
service_t *servicep;
for ( servicep = FIRST(services)
; !IS_END(servicep, services)
; servicep = NEXT(servicep))
{
if (port == servicep->port)
return servicep;
}
return NULL;
}
bootstrap_info_t *
lookup_bootstrap_by_req_port(mach_port_t port)
{
bootstrap_info_t *bootstrap;
for ( bootstrap = FIRST(bootstraps)
; !IS_END(bootstrap, bootstraps)
; bootstrap = NEXT(bootstrap))
{
if (bootstrap->requestor_port == port)
return bootstrap;
}
return NULL;
}
*/ REBFLG MT_Decimal(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
if (!IS_END(data+1)) return FALSE;
if (IS_DECIMAL(data))
*out = *data;
else if (IS_INTEGER(data)) {
SET_DECIMAL(out, (REBDEC)VAL_INT64(data));
}
else return FALSE;
SET_TYPE(out, type);
return TRUE;
}
*/ static void Set_GOB_Vars(REBGOB *gob, REBVAL *blk)
/*
***********************************************************************/
{
REBVAL *var;
REBVAL *val;
while (NOT_END(blk)) {
var = blk++;
val = blk++;
if (!IS_SET_WORD(var)) Trap2(RE_EXPECT_VAL, Get_Type(REB_SET_WORD), Of_Type(var));
if (IS_END(val) || IS_UNSET(val) || IS_SET_WORD(val))
Trap1(RE_NEED_VALUE, var);
val = Get_Simple_Value(val);
if (!Set_GOB_Var(gob, var, val)) Trap2(RE_BAD_FIELD_SET, var, Of_Type(val));
}
}
*/ static REBINT Do_Dia(REBDIA *dia)
/*
** Process the next command in the dialect.
** Returns the length of command processed.
** Zero indicates end of block.
** Negative indicate error.
** The args holds resulting args.
**
***********************************************************************/
{
REBVAL *next = BLK_SKIP(dia->args, dia->argi);
REBVAL *head;
REBINT err;
if (IS_END(next)) return 0;
// Find the command if a word is provided:
if (IS_WORD(next) || IS_LIT_WORD(next)) {
if (IS_LIT_WORD(next)) SET_FLAG(dia->flags, RDIA_LIT_CMD);
dia->cmd = Find_Command(dia->dialect, next);
}
// Handle defaults - process values before a command is reached:
if (dia->cmd <= 1) {
dia->cmd = 1;
dia->len = 1;
err = Do_Cmd(dia); // DEFAULT cmd
// It must be processed, else it is not in the dialect.
// Check for noop result:
if (err > 0) err = -REB_DIALECT_BAD_ARG;
return err;
}
// Delimit the command - search for next command or end:
for (head = ++next; NOT_END(next); next++) {
if ((IS_WORD(next) || IS_LIT_WORD(next)) && Find_Command(dia->dialect, next) > 1) break;
}
// Note: command may be shorter than length provided here (defaults):
dia->len = next - head; // length of args, not including command
err = Do_Cmd(dia);
if (GET_FLAG(dia->flags, RDIA_LIT_CMD)) dia->cmd += DIALECT_LIT_CMD;
return err;
}
service_t *
lookup_service_by_name(bootstrap_info_t *bootstrap, name_t name)
{
service_t *servicep;
if (bootstrap)
do {
for ( servicep = FIRST(services)
; !IS_END(servicep, services)
; servicep = NEXT(servicep))
{
if (!STREQ(name, servicep->name))
continue;
if (bootstrap && servicep->bootstrap != bootstrap)
continue;
return servicep;
}
} while (bootstrap != &bootstraps &&
(bootstrap = bootstrap->parent));
return NULL;
}
//
// PD_Map: C
//
REBINT PD_Map(REBPVS *pvs)
{
REBVAL *data = pvs->value;
REBVAL *val = 0;
REBINT n = 0;
if (IS_END(pvs->path+1)) val = pvs->setval;
if (IS_NONE(pvs->select)) return PE_NONE;
if (!ANY_WORD(pvs->select) && !ANY_BINSTR(pvs->select) &&
!IS_INTEGER(pvs->select) && !IS_CHAR(pvs->select))
return PE_BAD_SELECT;
n = Find_Entry(VAL_SERIES(data), pvs->select, val);
if (!n) return PE_NONE;
TRAP_PROTECT(VAL_SERIES(data));
pvs->value = VAL_BLK_SKIP(data, ((n-1)*2)+1);
return PE_OK;
}
*/ void Assert_Series_Term_Core(REBSER *series)
/*
***********************************************************************/
{
if (Is_Array_Series(series)) {
// REB_END values may not be canonized to zero bytes, check type only
if (!IS_END(BLK_SKIP(series, series->tail))) {
Debug_Fmt("Unterminated blocklike series detected");
Panic_Series(series);
}
}
else {
// Non-REBVAL-bearing series must have their terminal as all 0 bytes
int n;
for (n = 0; n < SERIES_WIDE(series); n++) {
if (0 != series->data[series->tail * SERIES_WIDE(series) + n]) {
Debug_Fmt("Non-zero byte in terminator of non-block series");
Panic_Series(series);
}
}
}
}
