/* Copyright (C) 1995 by Thomas Glen Smith. All Rights Reserved. */ /* execsper APL2 V1.0.0 ************************************************ * Called by execspex when the form is not a simple (a b c)#d, but is * * e.g. (Er)#x, after setting nametok to the token for r, and p to the * * avlnode pointer for r. * ***********************************************************************/ #define INCLUDES APLCHDEF+APLDERIV+APLTOKEN+APLCB+TREE #include "includes.h" int execsper(p,cbn,nametok) Avlnode p; /* Avlnode for r in e.g. (Er)#x. */ Aplcb cbn; /* (1,2,3,...), reshaped the same as p->avlleaf. */ Apltoken nametok; /* Token for r in e.g. (Er)#x. */ { Execfree; Execgetp; Execinit; Execnext; Execspef; Execterm; Lifo; extern Treelist treehdr; extern int aplerr; Apltoken axistok,op,tok,wrk; int exec_sw=1,hit=0,i,namecnt,noexit,nwa=0,off=0; Aplcb cb; Treelist treetest; treetest = treehdr; for (;;) { /* lets me use break */ cb = p->avlleaf; /* Save original. */ p->avlleaf = cbn; /* Replace with indices. */ execinit(); /* push a new execstk element on stack */ noexit = execnext(&tok,&axistok,&op,&namecnt); /* op will be set to one of these 4 possibilities: */ /* 1) List of names, in which case namecnt will be nonzero. */ /* 2) OPERAND_TOKEN, in which case further testing must be */ /* done to see if it is selective specification. */ /* 3) Not an OPERAND_TOKEN, e.g. a function, operator, etc. */ /* It may be selective specification. */ /* 4) op == NULL, indicating an error. */ p->avlleaf = cb; /* restore original cb */ if (aplerr || op == NULL) break; off = op->token_offset; /* save offset */ if (!noexit) { /* Evaluation complete: op s/b selected indices. */ /* Example: ((,r)[1 3 14 16])#'acde' */ exec_sw = 0; /* Indicate execterm invoked. */ execterm(); op = execspef(nametok,cb,cbn,execgetp(op),nwa); /* Finish. */ if (op != NULL) { hit = 1; /* Indicate specification handled. */ op = lifo(&(treehdr->avlexec->avloprst),op); op = NULL; /* don't free twice */ } break; /* All done. */ } return(execspet(hit,op,nametok,tok,axistok,cb,cbn)); } if (exec_sw) execterm(); /* Call if appropriate. */ execfree(tok); execfree(axistok); execfree(op); return(hit); /* indicate selective specification handled */ }