Metropoli BBS
VIEWER: nwisec.c MODE: TEXT (ASCII)
/* 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));
}
[ RETURN TO DIRECTORY ]