/* Copyright (C) 1994 by Thomas Glen Smith. All Rights Reserved. */ /* funcmain APL2 V1.0.0 ************************************************ * Called by execnila, execdyan, and execmons to execute niladic, * * monadic, and dyadic user functions. * ***********************************************************************/ #define INCLUDES APLMEM+STRING+APLCB+APLTOKEN+APLFUNCI+TREE #include "includes.h" Aplcb funcmain(fp,left,rite) Aplfunc fp; /* Function definition structure. */ Aplcb left,rite; /* Operands, or may be NULL. */ { Aplclsub; Avlsrch; Execterm; Expunge; Funcexec; Funcinit; Funcopy; Pop; Treeroot; extern int aplerr, indxorg; extern double fuzz; extern Treelist treehdr; Treelist root; Avlnode p; Aplcb out=NULL; int flagsave; flagsave = fp->funcflag & APLFUNC_IN_USE; if (flagsave) fp = funcopy(fp); else fp->funcflag |= APLFUNC_IN_USE; root = treeroot(fp); /* add new root for local variables */ if (root == NULL) return(NULL); /* out of memory? */ root->fuzzhold = fuzz; /* save for potential restore */ root->indxhold = indxorg; /* save for potential restore */ funcinit(fp,left,rite); /*init local var tree*/ if (aplerr == 0) funcexec(1); /* commence function execution */ fp = treehdr->avlfun; /* May have been replaced by an edit. */ if (aplerr == 0 && fp->functype & RETVAL) { /* obtain result */ p = avlsrch(treehdr->avlhdr, fp->funcvars->token_ptr.token_string); out = p->avlleaf; p->avlleaf = NULL; if (out == NULL) aplerr = 98; else out->aplflags |= APLTEMP; /* mark temporary */ } while (NULL != treehdr->avlexec) execterm(); /* Go free execstk element. */ root = pop(&treehdr); /* pop treehdr stack */ aplclsub(root->avlhdr); /* free tree */ if (NULL != root->avlfname) free(root->avlfname); /* free function name */ if (root->fuzzsave) fuzz = root->fuzzhold; /* restore */ if (root->indxsave) indxorg = root->indxhold; /* restore */ free(root); /* free root */ if (flagsave) expunge(fp); else fp->funcflag -= APLFUNC_IN_USE; return(out); /* return result, if any */ }