/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* execspeh APL2 V1.0.0 ************************************************ * Called by execspef to perform selective specification, e.g. (Er)#n, * * and recursively by itself. Returns 1 when the assigment is done. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" int execspeh(pleftorig, left, rite, ixp, ixc) Aplcb *pleftorig,/* Variable, elements to which assignment is made, */ /* guaranteed to be permanent. */ left, /* Variable from which indices were selected. Same */ /* shape as leftorig, but with unique indices for */ /* values. */ rite; /* Variable, from which elements are assigned, */ /* guaranteed by execspef to be permanent. */ int *ixp; /* Indices into leftorig to elements to replace with */ /* Successive elements of rite. */ int ixc; /* Count of indices pointed to by ixp. */ { Aplcopy; Aplnest; Dtacopy; Endoper; Execspeh; Getcb; Perm; Temp; extern int aplerr; Aplcb leftorig,leftsave,*lp,*lop,ritenew=NULL,riteprm; int i,*ip,j,k,rinc=0,size,sw=0,type; char *ld, *lo, *rn, *ro, *td, *ud; type = rite->aplflags & (APLMASK | APLAPL); sw = (ixc > 1 && ixc == rite->aplcount); if (sw && type != APLAPL) { rinc = 1; ritenew = riteprm = getcb(NULL,1,type,0,NULL); if (aplerr) return(0); ro = rite->aplptr.aplchar; rn = ritenew->aplptr.aplchar; } else ritenew = riteprm = rite; /* assign rite as a unit */ size = ritenew->aplsize; for (i = 0; i < ixc; i++) { if (sw) /* assign sub-items of rite? */ if (rinc) td = dtacopy(rn, ro + i * size, 1, 1, type); else riteprm = *(rite->aplptr.aplapl + i); j = execspei(pleftorig,left,riteprm,*(ixp+i)); } if (rinc) endoper(temp(ritenew)); return(1); /* assignment complete */ }