/*Copyright (C) 1992, 1996 by Thomas Glen Smith. All Rights Reserved.*/ /* innrcom APL2 V1.0.0 ************************************************* * Called by innrprdx, decodbl, and decode. * * Does initialization for both inner product and decode. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb innrcom(innrprd,left,rite,laxis,laxicnt,lbotcnt,ltopcnt,lincr, raxicnt,rbotcnt,rtopcnt,rincr,parmtyp,odata,ldata,rdata) int innrprd; /* 3 = inner product(innrprdq - +.E for char data, or execdotf for e.g. ,.+. 2 = inner product(innrprdx - parmtyp already set), 1 = inner product(innrprd), 0 = decode(decodbl). */ Aplcb left,rite; int *laxis, /* Dimension of left to be axis (always last) */ *laxicnt,*lbotcnt,*ltopcnt,*lincr, /* See comments in axispre */ *raxicnt,*rbotcnt,*rtopcnt,*rincr, /* See comments in axispre */ *parmtyp; char **odata,**ldata,**rdata; { Axispre; Errstop; Innrprda; extern int aplerr; int i,lax,rax; Aplcb out; if (!( (left->aplrank < 2 && left->aplcount == 1) || (rite->aplrank < 2 && rite->aplcount == 1))) { lax = *(left->apldim + left->aplrank - 1); rax = *rite->apldim; if ((lax != rax) && !(innrprd==0 && lax==1 || rax==1) && !(innrprd==3)) /* +.E inner product */ return(errstop(24,left,rite,NULL)); } i = axispre(left,(*laxis = left->aplrank),laxicnt,lbotcnt,ltopcnt); i = axispre(rite,1,raxicnt,rbotcnt,rtopcnt); if (*laxicnt == 1) { *lincr = 0; *laxicnt = *raxicnt; } else *lincr = *lbotcnt; if (*raxicnt == 1) { *rincr = 0; *raxicnt = *laxicnt; } else *rincr = *rbotcnt; if (innrprd != 3) { /* parmtyp already set for innrprd == 3. */ if (innrprd != 2) /* not inner product mixed type */ *parmtyp = left->aplflags & (APLMASK | APLAPL); if (*parmtyp == APLCHAR) *parmtyp = APLNUMB; } out = innrprda(left,rite,*parmtyp); if (aplerr) return(errstop(0,left,rite,out)); *odata = out->aplptr.aplchar; *ldata = left->aplptr.aplchar; *rdata = rite->aplptr.aplchar; return(out); }