/* Copyright (C) 1994 by Thomas Glen Smith. All Rights Reserved. */ /* scalax APL2 V1.0.0 ************************************************** * Called from execdyaj to perform a builtin APL dyadic scalar function * * when axes were speciied. * ***********************************************************************/ #define INCLUDES APLCB+APLCHDEF+FUNCODES+FUNSTRUC #include "includes.h" Aplcb scalax(fun,left,rite,axcb) void *fun; /* function structure - see funstruc.h */ Aplcb left,rite,axcb; /* function arguments */ { Axesok; Dyadset; Endoper; Errstop; Genint; Iorder; Real; Scalaz; extern int aplerr; Aplcb *big,*lit,out; int *bigx,code,outype,i,*ip,ltype,lx,*litx,rtype,rx; SCALAR_PROC oper=NULL; for (;;) { oper = dyadset(fun, &left, &rite, &outype); if (oper == NULL) return(errstop(1,left,rite,NULL)); if (left->aplrank < rite->aplrank) {big = &rite; bigx = ℞ lit = &left; litx = &lx;} else {big = &left; bigx = &lx; lit = &rite; litx = ℞} if (NULL==(axesok(axcb, (*lit)->aplrank, (*big)->aplrank))) break; ltype = left->aplflags & APLMASK; rtype = rite->aplflags & APLMASK; if ((ltype != rtype) && ((ltype | rtype) & APLCHAR) && (((Codes *)fun)->funky_flags == EQNE)) { endoper(axcb); return(errstop(0,left,rite,genint(*big, ((Codes *)fun)->funky_code == NOT_EQUAL))); } iorder(axcb); /* collate the axes */ out = scalaz(oper, left, rite, axcb, big, lit, bigx, litx, &lx, &rx, outype); endoper(axcb); return(errstop(0,left,rite,out)); } return(errstop(123,left,rite,axcb)); /* axis out of place */ }