/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* execdotd APL2 V1.0.0 ************************************************ * Called from execdot when the data types of either of the two * * arguments is character, to perform inner product. * ***********************************************************************/ #define INCLUDES APLCHDEF+APLTOKEN+FUNSTRUC+APLDERIV+APLCB #include "includes.h" Aplcb execdotd(left,rite,ltype,rtype,dp) Aplcb left,rite; /* left and right operands */ int ltype,rtype; /* data types of left and right operands */ Aplderiv dp; /* derived function definition for inner prod. */ { Errstop; Innrprdp; Innrprdx; int i; void (*db)(double*,double*,double*); Scalar_dyadics *sp; Eqne *ep; switch (((Codes *)(dp->deriv_rite.fun))->funky_code) { case EQUAL: i = 0; break; case NOT_EQUAL: i = 1; break; default: return(errstop(75,left,rite,NULL)); } /* end switch */ sp = dp->deriv_left.sdp; if (ltype == rtype) { /* both are character */ if (NULL != (db = sp->procs.ppdbl)) { ep = dp->deriv_rite.fun; return(innrprdp(db,ep->pd,&(sp->identities.did), left,rite)); } } else { /* one argument is character, the other isn't */ if (NULL != (db = sp->procs.ppdbl)) return(innrprdx(db,i,sp->identities.did,left,rite)); } return(errstop(78,left,rite,NULL)); /* no output */ }