/*Copyright (C) 1992, 1996 by Thomas Glen Smith.  All Rights Reserved.*/
/* execqncs APL2 V1.0.0 ************************************************
* Called by aplerase, execqex and execqnc, this is mainline for expunge*
* and name class.  Callers pass entry to do unique to their function.  *
***********************************************************************/
#define INCLUDES APLCB+APLMEM+APLTOKEN+TREE
#include "includes.h"
Aplcb execqncs(oper,rite)
int (*oper)(); /* Subroutine to do processing unique to function. */
Aplcb rite;
{
	Aplquae; Chrcopy; Errinit; Errstop; Getcb; Intcopy; Namelen; Treenode;
#include "quadext.h"
	char *cp,*s,*t,*wrk;
	int code,datacnt,i,*ip,j,k,nameok,rank;
	Avlnode p;
	Aplcb out;

	if (errinit()) return(errstop(0,NULL,rite,NULL));
	if ((APLCHAR != rite->aplflags & APLMASK || rite->aplrank > 2))
		return(errstop(110,NULL,rite,NULL)); /* bad input */
	if (rite->aplcount) {
		if (rite->aplrank == 2) { /* matrix? */
			datacnt = *(rite->apldim); /* output data count */
			rank = 1; /* vector output */
			j = *(rite->apldim + 1); /* max namelen */
		} else { /* input must be vector or scalar */
			datacnt = 1; /* single name is input */
			rank = 0; /* scalar output */
			j = rite->aplcount; /* max namelen */
		}
		out = getcb(NULL,datacnt,APLTEMP+APLINT,rank,NULL);
	} else out = getcb(NULL,0,APLTEMP+APLINT,0,NULL); /* empty output */
	if (out->aplcount) {
		wrk = malloc(j+1); /* name buffer */
		if (wrk == NULL) return(errstop(0,NULL,rite,out)); /*outofmemory*/
		for (i = 0; i < out->aplcount; i++) {
			if (0 == (k = namelen(rite->aplptr.aplchar,j,i,&s))) {
				nameok = 0; /* invalid name */
				p = NULL;
			} else {
				nameok = 1; /* name is well formed */
				cp = chrcopy(wrk,s,k,1); /* copy name */
				*cp = '\0'; /* delimit */
				t = wrk; /* Point to start of name. */
				switch(aplquae(&t,cp)) {
					case QUAD_AV:	t = quadav; break;
					case QUAD_CT:	t = quadct; break;
					case QUAD_IO:	t = quadio; break;
					case QUAD_LX:	t = quadlx; break;
					default:		t = wrk;
				}
				p = treenode(t);
			}
			*(out->aplptr.aplint+i) = (*oper)(nameok,p); /*result*/
		}
		free(wrk);
	}
	return(errstop(0,NULL,rite,out));
}