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