/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* squadix APL2 V1.0.0 *************************************************
* Index function of APL2.									 *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb squadix(left,rite,axcb,new)
Aplcb left,rite,axcb,new;
{
	Aplcopy; Aplnest; Dtacopy; Endoper; Errinit; Errstop; Getcb;
     Indexm; Integer; Temp;
	extern int aplerr, indxorg;
	Aplcb *cb,indices=NULL;
     int i,*ip,j;

	for(;;) {
		if (errinit()) break;
		if (aplerr) break;
		if (axcb == NULL) {
			if (left->aplcount != rite->aplrank)
				return(errstop(125,left,rite,NULL));
			if (rite->aplrank == 0)
				return(errstop(0,left,rite,temp(aplcopy(rite))));
			if (!(left->aplflags & APLAPL)) left = aplnest(left);
			return(indexm(rite,left,NULL));
		}
		if (!(axcb->aplflags & APLINT)) axcb = integer(axcb);
		indices = getcb(NULL,rite->aplrank,APLTEMP+APLAPL,1,NULL);
		if (indices == NULL) break;
		if (!(left->aplflags & APLAPL)) left = aplnest(left);
		for (i = 0, ip = axcb->aplptr.aplint; i < axcb->aplcount; i++)
          	if ((0 > (j = *(ip + i) - indxorg)) || j >= rite->aplrank)
               	aplerr = 34; /* index out of range */
               else cb = dtacopy(indices->aplptr.aplapl+j,
               	left->aplptr.aplapl+i,1,1,APLAPL);
		if (aplerr) break;
          return(errstop(0,left,axcb,indexm(rite,indices,NULL)));
		break;
	}
	if (indices != NULL) endoper(indices);
	return(errstop(0,left,rite,axcb));
}