/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* nwisec APL2 V1.0.0 ************************************************** * Called from nwise when LO in "LO / V" is of type FUNCTION_TOKEN, * * and the input is not nested. * ***********************************************************************/ #define INCLUDES APLCHDEF+FUNCODES+FUNSTRUC+APLDERIV+APLCB #include "includes.h" Aplcb nwisec(fun,lef,labs,rite,axis,axicnt,botcnt,topcnt,naxicnt,datacnt) void *fun; Aplcb rite; int axicnt,axis,botcnt,datacnt,lef,labs,naxicnt,topcnt; { Dblcopy; Errstop; Intcopy; Real; Scalay; typedef void (*Pep)(void*,void*,void*); Aplcb nwisea(Pep,Aplcb,int,int,int,int,int,int,int,int,int); Aplcb nwiseb(Aplcb,int,int,int,int); Pep pep=NULL; extern int aplerr; Aplcb out=NULL; int code,datatyp,i,intype,*ip,outype; double *np; for (;;) { /* lets me use break */ if (lef == 0) { /* use identity function */ out = nwiseb(rite,datacnt,APLNUMB,axis,naxicnt); np = dblcopy(out->aplptr.apldata, &(((Scalars *)fun)->dyad.identities.did), out->aplcount,0); break; } code = ((Codes *)fun)->funky_flags; intype = rite->aplflags & APLMASK; if (intype == APLCHAR) { /* special case */ if (code != EQNE) { aplerr = 75; break; } if (labs == 2) outype = APLINT; else { out = nwiseb(rite,datacnt,APLINT,axis,naxicnt); i = ((Codes *)fun)->funky_code == NOT_EQUAL; ip = intcopy(out->aplptr.aplint,&i,out->aplcount,0); break; } } else if (intype == APLINT && (code == EQNE || code == SCDO)) outype = APLINT; else { rite = real(rite); if (rite == NULL) break; intype = outype = APLNUMB; } pep = scalay(fun,code,intype,outype); if (pep == NULL) { aplerr = 79; break; } out = nwisea(pep, rite, lef, labs, datacnt, outype, axis, axicnt, naxicnt, botcnt, topcnt); break; } return(errstop(0,NULL,rite,out)); }