/*Copyright (C) 1992, 1995 by Thomas Glen Smith. All Rights Reserved.*/ /* takeck APL2 V1.0.0 ************************************************** * Called by both take and drop to do initial error checks. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" int takeck(pleft,prite) Aplcb *pleft,*prite; { Endoper; Errinit; Errstop; Imax; Iscalar; Ravel; Reshape; Shape; Vectin; extern int aplerr; Aplcb dimcb; if (errinit()) return(NOTOK); if ((*pleft)->aplrank > 1) { aplerr = 15; /* rank too large */ return(NOTOK); } if (NULL == (*pleft = vectin(*pleft))) /* perm. int. vector */ return(NOTOK); if ((*prite)->aplrank == 0) /* convert scalar to array */ *prite = reshape( /* reshape eliminates take recursion */ ravel(reshape(shape(*pleft),iscalar(1))), *prite); else if ((*pleft)->aplcount != (*prite)->aplrank) { aplerr = 16; return(NOTOK); } return(OK); }