/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* nwise APL2 V1.0.0 *************************************************** * Called from reducef to handle N-Wise Reduce. * ***********************************************************************/ #define INCLUDES APLCHDEF+FUNCODES+FUNSTRUC+APLDERIV+APLCB #include "includes.h" Aplcb nwise(dp,left,rite,axis) Aplderiv dp; /* function describing derived function */ Aplcb left,rite; /* arguments */ int axis; { Aplcopy; Axispre; Errinit; Errstop; Getcb; Intcopy; Integer; Real; typedef void (*Pep)(void*,void*,void*); Aplcb nwisec(void *, int, int, Aplcb, int, int, int, int, int, int); Aplcb nwised(void *, int, int, int, Aplcb, int, int, int, int, int, int); Pep pep=NULL; extern int aplerr, indxorg; Aplcb out=NULL; int axicnt,botcnt,code,datacnt,datatyp,err=0,i,intype,*ip,j,lef,labs, naxicnt,outype,topcnt; void *fun; for (;;) { /* lets me use break */ if (errinit()) break; if (!(left->aplflags & APLINT)) left = integer(left); if (left == NULL) break; if (left->aplcount != 1) { err = 126; break; } lef = *(left->aplptr.aplint); axis += (indxorg == 0); /* force to relative 1 */ if (OK != axispre(rite,axis,&axicnt,&botcnt,&topcnt)) break; labs = (lef > 0) ? lef : -lef; if (labs > axicnt) { err = 126; break; } if (labs == 1) { /* special case */ out = aplcopy(rite); out->aplflags |= APLTEMP; break; } naxicnt = 1 + axicnt - labs; datacnt = topcnt * naxicnt * botcnt; fun = dp->deriv_left.fun; i = ((Codes *)fun)->funky_flags; j = dp->deriv_left.funcode; if ((rite->aplflags & APLAPL) || !(j == FUNCTION_TOKEN && (i==SCMD || i==SCDO || i==EQNE))) out = nwised(fun,j,lef,labs,rite,axis, axicnt,botcnt,topcnt,naxicnt,datacnt); else out = nwisec(fun,lef,labs,rite,axis, axicnt,botcnt,topcnt,naxicnt,datacnt); rite = NULL; break; } return(errstop(err,left,rite,out)); }