/* Copyright (C) 1994 by Thomas Glen Smith. All Rights Reserved. */ /* execspej APL2 V1.0.0 ************************************************ * Called by execspei to do selective assignment when it has found the * * aplcb (*pleft) in which indexed replacement is to take place. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" int execspej(pleft, rite, ix) Aplcb *pleft, /* Variable, elements to which assignment is made. */ rite; /* Variable to be assigned from. */ int ix; /* Index into left to element to replace with */ /* rite. Index is relative to 0. */ { Aplcopy; Aplnest; Dtacopy; Endoper; Matchok; Matchoks; Perm; Temp; extern int aplerr; Aplcb *lop,riteorig; int i,ltype,rtype,size; char *ld, *lo, *td, *ud; riteorig = rite; ltype = (*pleft)->aplflags & (APLMASK + APLAPL); rtype = rite->aplflags & (APLMASK + APLAPL); if (rite->aplcount > 1 & ltype != APLAPL) { *pleft = perm(aplnest(*pleft)); ltype = APLAPL; } else if (ltype != APLAPL) { i = (ltype == rtype) ? 0 : 0 == matchoks(pleft,&rite,(APLMASK - APLCHAR)); if (i) *pleft = perm(aplnest(*pleft)); else if ((*pleft)->aplflags & APLTEMP) (*pleft)->aplflags -= APLTEMP; } if ((*pleft)->aplflags & APLAPL) { lop = (*pleft)->aplptr.aplapl + ix; endoper(temp(*lop)); *lop = aplcopy(rite); return(1); /* indicate assignment done */ } size = (*pleft)->aplsize; ltype = (*pleft)->aplflags & (APLMASK | APLAPL); lo = (*pleft)->aplptr.aplchar; ud = lo + ix * size; if (ltype & APLAPL) endoper(temp(*(Aplcb *)ud)); td = dtacopy(ud, rite->aplptr.aplchar, 1, 1, ltype); if (rite != riteorig) endoper(rite); return(1); /* assignment complete */ }