/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* drop2 APL2 V1.0.0 *************************************************** * APL2 drop. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb drop2(left, rite, axes) Aplcb left, rite, axes; { Drop; Endoper; Errinit; Errstop; Getcb; Intcopy; Integer; Iscalar; Ravel; Reshape; Shape; Vectin; extern int aplerr, indxorg; Aplcb newleft=NULL,out=NULL; int i,*ip,j,k,rank; static int izero=0; if (axes == NULL) return(drop(left,rite)); for(;;) { if (errinit()) break; if (left->aplrank > 1) {aplerr = 15; break;} if (!(APLINT & left->aplflags)) if (NULL == (left = integer(left))) break; if (!(APLINT & axes->aplflags)) if (NULL == (axes = integer(axes))) break; if (left->aplcount != axes->aplcount || left->aplcount > rite->aplrank) {aplerr = 16; break;} newleft = getcb(NULL,rite->aplrank,APLINT+APLTEMP,1,NULL); if (newleft == NULL) break; ip = intcopy(newleft->aplptr.aplint,&izero,newleft->aplcount,0); for(i = 0; i < axes->aplcount; i++) { j = *(axes->aplptr.aplint + i) - indxorg; /* axis, rel 0 */ if (j < 0 || j >= rite->aplrank) aplerr = 9; /* bad axis */ else if (0 != *(ip = newleft->aplptr.aplint + j)) aplerr = 9; else *ip = *(left->aplptr.aplint + i); } if (aplerr) break; endoper(left); endoper(axes); return(drop(newleft,rite)); } endoper(newleft); endoper(axes); return(errstop(0,left,rite,NULL)); }