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