/*Copyright (C) 1992, 1995 by Thomas Glen Smith. All Rights Reserved.*/ /* expane APL2 V1.0.0 ************************************************** * Called by expand when the result is nonempty to copy data to out. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb expane(left,rite,out,datatyp,axicnt,botcnt,topcnt) Aplcb left,rite,out; { Aplfill; Chrcopy; Dtacopy; Endoper; Getcb; Temp; int *dimptr,hit=0,i,incr,j,k,m,n; char *fillptr,*from,*icp,*ocp; Aplcb fillcb=NULL,*fillsave=NULL,fillwk=NULL; if (datatyp == APLAPL) if (rite->aplrank > 1) { hit = 1; /* use subarray fill */ if (NULL == (fillcb = getcb(NULL,botcnt,APLAPL,1,NULL))) return; fillsave = fillcb->aplptr.aplapl; ((Aplcb*)fillptr) = &fillwk; } else { if (NULL == (fillcb = aplfill(rite))) return; ((Aplcb*)fillptr) = &fillcb; } else fillptr = aplfill(rite); k = botcnt * out->aplsize; /* chars copied per axis unit */ if (1 >= rite->aplcount) incr = 0; /* don't bump in ptr */ else incr = k; icp = rite->aplptr.aplchar; /* 1st input location */ ocp = out->aplptr.aplchar; /* 1st output location */ for (i=topcnt; i>0; i--) { /* loop for each unit above axis */ dimptr = left->aplptr.aplint; /* compression vector */ if (hit) { /* use subarray fill */ fillcb->aplptr.aplapl = (Aplcb*)icp; fillwk = aplfill(fillcb); } for (j=axicnt; j>0; j--) /* loop for each axis unit */ if (*dimptr++) { ocp = dtacopy(ocp,icp, botcnt,1,datatyp); if (incr) icp += k; /* bump input pointer */ } else ocp = dtacopy(ocp,fillptr,botcnt,0,datatyp); if (hit) { endoper(temp(fillwk)); fillwk = NULL; } } if (fillcb != NULL) { if (fillsave != NULL) fillcb->aplptr.aplapl = fillsave; endoper(temp(fillcb)); } }