/*Copyright (C) 1993, 1994 by Thomas Glen Smith.  All Rights Reserved.*/
/* indexm APL2 V1.0.0 **************************************************
* Called by enclosf and squadix.                                       *
* Left points to an APL variable from, and perhaps to, which values    *
* are to be indexed.  Indices identifies the index values to be used,  *
* and determines the shape of the output.  If rite isn't NULL, it      *
* contains values to be stored in the indexed elements of left.        *
* Indexm differs from indexv in that left may be of any shape, and     *
* the output may have rank other than 1.  Indexm is the true           *
* implementation of the APL indexing function.                         *
***********************************************************************/
#define INCLUDES APLCB+APLMEM+INDEXMI
#include "includes.h"
Aplcb indexm(left, indices, rite)
Aplcb left, indices, rite;
{
	Errinit; Errstop; Getcb; Indexma; Indexmb; Intcopy; Ireduce; Itimes;
     Matchok; Perm; Temp;
     extern int aplerr; extern int indxorg;
     int  datacnt,i,*ip,itimesid,j,k,*op,rank,tempsave;
	struct ix p;
	Aplcb dimcb, x, *xcb;

	if (errinit()) return(errstop(0,left,indices,rite));
	if ((rite != NULL ) && (!matchok(&left,&rite,APLMASK+APLAPL)))
			return(errstop(0,NULL,indices,NULL));
	if (left->aplrank != indices->aplcount)
			return(errstop(53,left,indices,rite));
	p.siz = left->aplsize;
	p.l = left; p.r = rite; p.x = indices;
	p.o = (void *) p.z = (void *) p.datarite = p.dataout= NULL;
	dimcb = indexma(&p); /* go get output dimensions */
	if (dimcb != NULL) {
		itimesid = 1; /* identity */
		datacnt = ivalue(ireduce(itimes,&itimesid,perm(dimcb),indxorg));
		p.dtyp = left->aplflags & (APLMASK + APLAPL);
		if (0 == (rank = dimcb->aplcount) && p.dtyp == APLCHAR) 
			rank++; /* character types can't be scalars */
		if (rite != NULL) {
			p.datarite = rite->aplptr.aplchar;
			if (0 != (p.inc = (1 == rite->aplcount) ? 0 : p.siz)
			  && rite->aplcount != datacnt) aplerr = 112;
		}
		if (aplerr == 0)
			p.o = getcb(NULL,datacnt,p.dtyp + APLTEMP,rank,NULL);
		if (aplerr == 0 && rank > 1)
			ip = intcopy(p.o->apldim,dimcb->aplptr.aplint,rank,1);
		endoper(temp(dimcb));
		if (aplerr == 0) {
			p.dataout = p.o->aplptr.aplchar;
			if (p.o->aplcount) {
				x = *(xcb = indices->aplptr.aplapl); /* 1st index */
				ip = indexmb(0,&p,xcb,0,x->aplptr.aplint,
					left->aplptr.aplchar);
	}	}	}
	if (p.z != NULL) free(p.z);
	endoper(indices); return(errstop(0,left,rite,p.o));
}