/* Copyright (C) 1996 by Thomas Glen Smith. All Rights Reserved. */ /* execspee APL2 V1.0.0 ************************************************ * Called by execspex to complete assignment to a list of names. * ***********************************************************************/ #define INCLUDES APLCHDEF+APLTOKEN+APLCB+TREE #include "includes.h" int execspee(tok, axistok, op, namecnt) Apltoken tok, axistok; /* s/b NULL */ Apltoken op; /* lifo stack of names in (a b c ...)#n */ int namecnt; /* count of names in op stack */ { Aplcopy; Aplnest; Assign; Endoper; Errstop; Execfree; Execgetp; Execpop; Exectok; Lifo; Pop; extern int aplerr; extern Treelist treehdr; int err=0,off,tempsave; Aplcb incb,out=NULL,*tmp,wrk; Apltoken nametok; Treelist treetest=treehdr; for (;;) { /* Lets me use break. */ if (tok != NULL || axistok != NULL) { execfree(tok); execfree(axistok); aplerr = 127; /* item out of place */ break; } tok = pop(&(treehdr->avlexec->avloprst)); off = tok->token_offset; /* save offset */ incb = out = execgetp(tok); if (tempsave = out->aplflags & APLTEMP) out->aplflags-=APLTEMP; if (namecnt == 1) { nametok = pop(&op); wrk = assign(nametok->token_ptr.token_string,out); execfree(nametok); break; } if (out->aplrank > 1) { aplerr = 128; break; }/* rank error */ else if (out->aplrank == 1) if (out->aplcount != namecnt) { aplerr = 127; break; } else if (!(out->aplflags & APLAPL)) incb = aplnest(out); while(namecnt--) { nametok = pop(&op); if (incb->aplrank) { wrk = *(tmp = incb->aplptr.aplapl + incb->aplcount-namecnt-1); if (incb != out) *tmp = NULL; else wrk = aplcopy(wrk); } else wrk = aplcopy(incb); wrk->aplflags |= APLTEMP; /* lets assign use */ wrk = assign(nametok->token_ptr.token_string,wrk); execfree(nametok); } if (incb != out) endoper(incb); break; } if (out != NULL) { out->aplflags += tempsave; tok = exectok(out,off); tok = lifo(&(treehdr->avlexec->avloprst),tok); } if (op != NULL) execpop(&op); return(1); /* indicate specification handled */ }