Metropoli BBS
VIEWER: disclosh.c MODE: TEXT (ASCII)
/* 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;
}	}	}	}
[ RETURN TO DIRECTORY ]