/* 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 */
}