/* 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;
} } } }