/*Copyright (C) 1992, 1994 by Thomas Glen Smith. All Rights Reserved.*/ /* outrprd APL2 V1.0.0 ************************************************* * This is the outer product function. Arguments are pointers, LEFT * * and RIGHT, and an entry point which performs some dyadic primitive * * scalar operation. For each possible combination of elements in the * * APL variables pointed to by LEFT and RIGHT, outrprd calls the entry * * point passed as argument. The results are stored in a new APL * * variable, and a pointer to its APLCB is returned. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb outrprd(oper,left,rite) double (*oper)(); Aplcb left,rite; { Errstop; Getcb; Intcopy; Matchok; Outrprdb; Outrprdc; Outrprdd; int datacnt,datatyp,i,*ip,j,*jp,rank; Aplcb out=NULL; double f,*lp,*rp,*ap; if (!matchok(&left,&rite,APLMASK)) return(NULL); datacnt=left->aplcount*rite->aplcount; if (APLCHAR == (datatyp=left->aplflags & APLMASK)) i=APLINT; else i=datatyp; rank=left->aplrank+rite->aplrank; out=getcb(NULL,datacnt,i+APLTEMP,rank,NULL); if (rank>1) { /* set dimensions */ ip=intcopy(out->apldim,left->apldim,left->aplrank,1); ip=intcopy(ip,rite->apldim,rite->aplrank,1); } if (datacnt) switch(datatyp) { case APLNUMB: outrprdb(left->aplptr.apldata,rite->aplptr.apldata, out->aplptr.apldata,left->aplcount,rite->aplcount, (double (*)())oper); break; case APLINT: outrprdc(left->aplptr.aplint,rite->aplptr.aplint, out->aplptr.aplint,left->aplcount,rite->aplcount, (int (*)())oper); break; case APLCHAR: outrprdd(left->aplptr.aplchar,rite->aplptr.aplchar, out->aplptr.aplchar,left->aplcount,rite->aplcount, (int (*)())oper); break; } /* end switch */ return(errstop(0,left,rite,out)); }