NODE *memberp_help(NODE *args, BOOLEAN notp, BOOLEAN substr) {
NODE *obj1, *obj2, *val;
int leng;
int caseig = varTrue(Caseignoredp);
val = FalseName();
obj1 = car(args);
obj2 = cadr(args);
if (is_list(obj2)) {
if (substr) return FalseName();
while (obj2 != NIL && NOT_THROWING) {
if (equalp_help(obj1, car(obj2), caseig))
return (notp ? obj2 : TrueName());
obj2 = cdr(obj2);
if (check_throwing) break;
}
return (notp ? NIL : FalseName());
}
else if (nodetype(obj2) == ARRAY) {
int len = getarrdim(obj2);
NODE **data = getarrptr(obj2);
if (notp)
err_logo(BAD_DATA_UNREC,obj2);
if (substr) return FalseName();
while (--len >= 0 && NOT_THROWING) {
if (equalp_help(obj1, *data++, caseig)) return TrueName();
}
return FalseName();
} else {
NODE *tmp;
int i;
if (aggregate(obj1)) return (notp ? Null_Word : FalseName());
setcar (cdr(args), cnv_node_to_strnode(obj2));
obj2 = cadr(args);
setcar (args, cnv_node_to_strnode(obj1));
obj1 = car(args);
tmp = NIL;
if (obj1 != UNBOUND && obj2 != UNBOUND &&
getstrlen(obj1) <= getstrlen(obj2) &&
(substr || (getstrlen(obj1) == 1))) {
leng = getstrlen(obj2) - getstrlen(obj1);
setcar(cdr(args),make_strnode(getstrptr(obj2), getstrhead(obj2),
getstrlen(obj1), nodetype(obj2),
strnzcpy));
tmp = cadr(args);
for (i = 0; i <= leng; i++) {
if (equalp_help(obj1, tmp, caseig)) {
if (notp) {
setstrlen(tmp,leng+getstrlen(obj1)-i);
return tmp;
} else return TrueName();
}
setstrptr(tmp, getstrptr(tmp) + 1);
}
}
return (notp ? Null_Word : FalseName());
}
}
NODE *litem(NODE *args) {
int i;
NODE *obj, *val;
val = integer_arg(args);
obj = cadr(args);
while ((obj == NIL || obj == Null_Word) && NOT_THROWING) {
setcar(cdr(args), err_logo(BAD_DATA, obj));
obj = cadr(args);
}
if (NOT_THROWING) {
i = getint(val);
if (is_list(obj)) {
if (i <= 0) {
err_logo(BAD_DATA_UNREC, val);
return UNBOUND;
}
while (--i > 0) {
obj = cdr(obj);
if (obj == NIL) {
err_logo(BAD_DATA_UNREC, val);
return UNBOUND;
}
}
return car(obj);
}
else if (nodetype(obj) == ARRAY) {
i -= getarrorg(obj);
if (i < 0 || i >= getarrdim(obj)) {
err_logo(BAD_DATA_UNREC, val);
return UNBOUND;
}
return (getarrptr(obj))[i];
}
else {
if (i <= 0) {
err_logo(BAD_DATA_UNREC, val);
return UNBOUND;
}
setcar (cdr(args), cnv_node_to_strnode(obj));
obj = cadr(args);
if (i > getstrlen(obj)) {
err_logo(BAD_DATA_UNREC, val);
return UNBOUND;
}
return make_strnode(getstrptr(obj) + i - 1, getstrhead(obj),
1, nodetype(obj), strnzcpy);
}
}
return(UNBOUND);
}
NODE *lcount(NODE *args) {
int cnt = 0;
NODE *arg;
arg = car(args);
if (arg != NIL && arg != Null_Word) {
if (is_list(arg)) {
args = arg;
for (; args != NIL; cnt++) {
args = cdr(args);
if (check_throwing) break;
}
} else if (nodetype(arg) == ARRAY) {
cnt = getarrdim(arg);
} else {
setcar(args, cnv_node_to_strnode(arg));
cnt = getstrlen(car(args));
}
}
return(make_intnode((FIXNUM)cnt));
}
void gc(NODE *nd)
{
NODE *tcar, *tcdr, *tobj;
int i;
NODE **pp;
for (;;) {
switch (nodetype(nd)) {
case PUNBOUND:
setrefcnt(nd,10000); /* save some time */
case PNIL:
if (gctop == gcstack) return;
nd = *--gctop;
continue;
case LINE:
nd->n_obj = NIL;
case CONS:
case CASEOBJ:
case RUN_PARSE:
case QUOTE:
case COLON:
case TREE:
case CONT:
tcdr = cdr(nd);
tcar = car(nd);
tobj = getobject(nd);
break;
case ARRAY:
pp = getarrptr(nd);
i = getarrdim(nd);
while (--i >= 0) {
tobj = *pp++;
deref(tobj);
}
free((char *)getarrptr(nd));
tcar = tcdr = tobj = NIL;
break;
case STRING:
case BACKSLASH_STRING:
case VBAR_STRING:
if (getstrhead(nd) != NULL && decstrrefcnt(getstrhead(nd)) == 0)
free(getstrhead(nd));
default:
tcar = tcdr = tobj = NIL;
}
nd->n_cdr = free_list;
free_list = nd;
#ifdef MEM_DEBUG
mem_freed++;
#endif
if (tcdr != NIL && decrefcnt(tcdr) == 0)
if (gctop < &gcstack[GCMAX])
*gctop++ = tcdr;
if (tcar != NIL && decrefcnt(tcar) == 0)
if (gctop < &gcstack[GCMAX])
*gctop++ = tcar;
if (tobj != NIL && decrefcnt(tobj) == 0)
if (gctop < &gcstack[GCMAX])
*gctop++ = tobj;
if (gctop == gcstack) return;
nd = *--gctop;
}
}
