/* 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));
}