/* Copyright (C) 1994 by Thomas Glen Smith. All Rights Reserved. */ /* dyadrun APL2 V1.0.0 ************************************************* * Called by dyadicp and execdote to do dyadic scalar processing. The * * subroutine passed as argument oper is applied to each pair of data * * items fron left and rite, with the results stored in out. If the * * count of either left or rite is 1, that single item will be paired * * with each item of the other to produce out. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb dyadrun(subrtne, left, rite, out) void (*subrtne)(char*, char*, char*); Aplcb left,rite,out; /* Operands and result. */ { Dyadrup; char *dataout,*leftptr,*riteptr; int cnt,linc,otype,rinc,tempsave; double dblout,wrkd[2]; Aplcb hold; if (out->aplcount) { dataout = out->aplptr.aplchar; leftptr = left->aplptr.aplchar; riteptr = rite->aplptr.aplchar; linc = !(left->aplcount==1) * left->aplsize; rinc = !(rite->aplcount==1) * rite->aplsize; otype = out->aplflags & (APLMASK + APLAPL); if (otype == APLNUMB) /* Real may be converted to complex. */ for (cnt = 0; cnt < out->aplcount; cnt++) { *(wrkd+1) = 0e0; /* Initialize. */ (*subrtne)(leftptr,riteptr,(char*)wrkd); leftptr += linc; riteptr += rinc; if (*(wrkd+1) != 0e0 && otype != APLCPLX) { otype = APLCPLX; out = dyadrup(out,cnt); /* Convert to complex. */ dataout = out->aplptr.aplchar + cnt * out->aplsize; } *((double*)dataout) = *wrkd; if (otype == APLCPLX) *(((double*)dataout)+1) = *(wrkd+1); dataout += out->aplsize; } else for (cnt = 0; cnt < out->aplcount; cnt++) { (*subrtne)(leftptr,riteptr,dataout); leftptr += linc; riteptr += rinc; dataout += out->aplsize; } } return(out); }