/*Copyright (C) 1992, 1996 by Thomas Glen Smith.  All Rights Reserved.*/
/* indexmb APL2 V1.0.0  ************************************************
* Recursively called to index an APL array.  Called first by indexm.   *
***********************************************************************/
#define INCLUDES APLCB+INDEXMI
#include "includes.h"
int *indexmb(level,p,ixcbp,pix,ixdta,leftp)
int level;	/* current left dimension */
struct ix *p;	/* structure described in "indexmi.h" */
Aplcb *ixcbp;	/* current indices aplcb ptr */
int pix;		/* current index into ixcb */
int *ixdta;
char *leftp;	/* current left data ptr */
{
	Aplcopy; Chrcopy; Endoper; Temp;
	extern int aplerr; extern int indxorg;
	Aplcb ixcb,nxtcb,*nxtcbp,wc,wt;
	int currdim,i,*ip,j,k,nxtix,nxtlev;
	char *ch,*curl; /* next left data ptr */

	ixcb = *ixcbp; /* current index aplcb */
	nxtlev = level + 1; /* next level (left dimension) */
	nxtix = pix + 1; /* next indx */
	if (ixcb->aplrank == 0)
		currdim = 1; /* current index dimension */
	else currdim = *(ixcb->apldim + pix); /* can't be 0 */
	for (j = 0; j < currdim; j++) {
		if (nxtix < ixcb->aplrank)
			ixdta = indexmb(level,p,ixcbp,nxtix,ixdta,leftp);
		else {
			k = *ixdta++ - indxorg; /* next index */
			if (k < 0 || k >= *(p->l->apldim + level)) {
				aplerr = 34; /* index out of range */
				return;
			}
			curl = leftp + *(p->z + level) * p->l->aplsize * k;
			if (nxtlev < p->l->aplrank) {
				nxtcbp = ixcbp + 1;
				nxtcb = *nxtcbp; /* next index aplcb */
				ip = indexmb(nxtlev,p,nxtcbp,0,
					nxtcb->aplptr.aplint,curl);
			}
			else { /* copy indexed data */
				if (p->datarite != NULL) {
                    	if (p->dtyp & APLAPL) {
                         	if (NULL != (wt = *(Aplcb *)curl))
	                    		endoper(temp(wt));
                         	*(Aplcb *)curl = aplcopy(*((Aplcb *)(p->datarite)));
                         }
					else ch = chrcopy(curl,p->datarite,p->siz,1);
					p->datarite += p->inc; /* bump input ptr */
				}
                    if (p->dtyp & APLAPL)
                    	*(Aplcb *)(p->dataout) = wc = aplcopy(*(Aplcb *)curl);
				else p->dataout = chrcopy(p->dataout,curl,p->siz,1);
	}	}	}
	return(ixdta);
}