/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* nwised APL2 V1.0.0 ************************************************** * Called from nwise in two cases: * * 1. Rite is nested (type APLAPL). * * 2. LO in "LO / V" is of type FUNCTION_TOKEN, and the function needs * * needs a nested APL variable for an argument. * * Labs is guaranteed to be greater than 1. * ***********************************************************************/ #define INCLUDES APLCHDEF+FUNCODES+FUNSTRUC+APLDERIV+APLCB #include "includes.h" Aplcb nwised(fun,code,lef,labs,rite,axis,axicnt,botcnt,topcnt,naxicnt, datacnt) void *fun; Aplcb rite; int axicnt,axis,botcnt,code,datacnt,lef,labs,naxicnt,topcnt; { Aplnest; Errstop; Execdyan; Intcopy; Real; Scalay; Aplcb nwiseb(Aplcb,int,int,int,int); extern int aplerr; int bump,i,j,k,m,p; Aplcb *icp,*jcp,*kcp,*ocp,out=NULL; for (;;) { /* lets me use break */ if (!(rite->aplflags & APLAPL)) rite = aplnest(rite); out = nwiseb(rite,datacnt,APLAPL,axis,naxicnt); if (out == NULL || out->aplcount == 0) break; bump = (lef < 0) ? -botcnt : botcnt; for (i = 0; i < topcnt; i++) { icp = rite->aplptr.aplapl + i * botcnt * axicnt; jcp = out ->aplptr.aplapl + i * botcnt * naxicnt; for (j = 0; j < botcnt; j++) for (m = naxicnt; m > 0; m--) { kcp = icp + (j + (axicnt - m) * botcnt); ocp = jcp + (j + (naxicnt - m) * botcnt); if (lef < 0) kcp += (labs - 1) * bump; *ocp = *kcp; for (k = 1; k < labs; k++) { kcp -= bump; *ocp = execdyan(code, fun, *kcp, *ocp); } if (*ocp != NULL) (*ocp)->aplflags -= APLTEMP; } } break; } return(errstop(0,NULL,rite,out)); }