/* Copyright (C) 1996 by Thomas Glen Smith. All Rights Reserved. */ /* disclosh APL2 V1.0.0 ************************************************ * called from disclosg to finish disclose processing. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" void disclosh(riterank,ritedim,cb,outrank,otype,r,op,axescnt,mp,rp,ip,jp) int riterank; /* Rank of input. */ int *ritedim; /* Input dimensions. */ Aplcb *cb; /* Input array. */ int outrank; /* Rank of output. */ int otype; /* Output datatype. */ int r; /* Output count. */ void *op; /* Output array. */ int axescnt; /* Sub dimensions. */ int *mp; /* Axes mapping array. The number of elements in */ /* mp will match the highest rank of an item in */ /* the input array of Aplcb pointers pointed to */ /* by cb, which is the array of input items from */ /* rite. mp maps dimensions from the items of */ /* rite to dimensions in the output. If rite were */ /* of rank 1, and *mp were 1, and indxorg were 1, */ /* then output[1;*] would consist of the first */ /* items in each item of rite. */ int *rp; /* Axes mapping array for rite. If rite were of */ /* rank 3, this would be vector 0, 1, 2, plus the */ /* indxorg. */ int *ip; /* Indices array, of length outrank, initialized */ /* to all indxorg-1. This is passed to indices(), */ /* which increments the index values, and then to */ /* indexno(), which returns the number (relative */ /* 0) of the next output element. */ int *jp; /* Output dimensions. */ { Apltype; Apltypf; Dtacopy; Getcb; Indexno; Indices; Multset; extern int aplerr, indxorg; Aplcb ob, wrk; int i, itype, j=1, k, *np, p; void *v; char *ch; while(r-- && aplerr == 0) { /* once for each output item */ indices(ip,jp,&j,outrank,indxorg); /* bump indices */ wrk = *(cb + indexno(riterank,rp,ip,ritedim,indxorg)); itype = wrk->aplflags & (APLMASK + APLAPL); p = indexno(axescnt,mp,ip,wrk->apldim,indxorg); if (p < 0 || p >= wrk->aplcount) /* fill */ if (otype == itype) if (otype == APLAPL) *((Aplcb *)op)++ = apltype(wrk); else op = apltypf(op,1,otype); else if (otype == APLAPL) { *((Aplcb *)op)++ = ob = getcb(NULL,1,itype,0,NULL); if (ob) v = apltypf(ob->aplptr.aplchar,1,itype); } else op = apltypf(op,1,otype); else { ch = wrk->aplptr.aplchar + (long)p * (long)wrk->aplsize; if (otype == itype) op = dtacopy(op, ch, 1, 1, itype); else switch(otype) { case APLAPL: *((Aplcb *)op)++ = ob = getcb(NULL,1,itype,0,NULL); if (ob) v = dtacopy(ob->aplptr.aplchar,ch,1,1,itype); break; case APLCPLX: if (itype == APLINT) *((double *)op)++ = *(int *)ch; else *((double *)op)++ = *(double *)ch; *((double *)op)++ = 0e0; /* imaginary = 0 */ break; case APLNUMB: *((double *)op)++ = *(int *)ch; break; default: aplerr = 999; /* shouldn't happen */ break; } } } }