/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* enclose APL2 V1.0.0 ************************************************* * Enclose. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb enclose(rite, axes) Aplcb rite; Aplcb axes; { Aplcopy; Enclose; Enclosf; Errinit; Errstop; Getcb; Getcbi; Perm; Temp; extern int aplerr; Aplcb *icb,out=NULL,*ocb,wrk; int i; for (;;) { /* lets me use break */ if (errinit()) break; if (axes == NULL) { if (rite->aplrank == 0 && !(rite->aplflags & APLAPL)) out = (rite->aplflags & APLTEMP) ? rite : temp(aplcopy(rite)); else { out = getcb(NULL,1,APLAPL+APLTEMP,0,NULL); if (out == NULL) break; wrk = (rite->aplflags & APLTEMP) ? rite : aplcopy(rite); wrk->aplflags &= ~APLTEMP; /* Make it permanent. */ *(out->aplptr.aplapl) = wrk; } rite = NULL; /* don't free later. */ break; } if (0 == axes->aplcount) { if (rite->aplflags & APLAPL) { /* nested */ out = getcbi(NULL,rite->aplcount,APLAPL+APLTEMP, rite->aplrank,rite->apldim); icb = rite->aplptr.aplapl; ocb = out->aplptr.aplapl; for (i = 0; i < out->aplcount; i++) { wrk = perm(enclose(*icb++,NULL)); if (wrk == NULL) *ocb++ = NULL; else if (wrk->aplflags & APLTEMP) *ocb++ = perm(wrk); else *ocb++ = aplcopy(wrk); } } else out = temp(aplcopy(rite)); /* simple array */ break; } return(enclosf(rite,axes)); break; /* get out of for loop */ } return(errstop(0,axes,rite,out)); }