/*Copyright (C) 1992, 1994 by Thomas Glen Smith. All Rights Reserved.*/ /* assign APL2 V1.0.0 ************************************************** * The APL assignment operator. Called by both execasgn and execqfx. * ***********************************************************************/ #define INCLUDES APLCB+APLMEM+STRING+TREE #include "includes.h" Aplcb assign(nameptr,rite) char *nameptr; /* Name of variable to assign to */ Aplcb rite; /* APLCB ptr to assign */ { Aplcopy; Avladd; Codechar; Errstop; Ivalue; Leafdel; Perm; Treenode; Value; #include "quadext.h" extern int indxorg; /* current index origin */ extern double fuzz; /* current comparison tolerance */ extern double pp; /* current print precision */ extern Treelist treehdr; extern int aplerr; Aplcb wrk; Treelist symp; Avlnode p; if (!(rite->aplflags & (APLTEMP+APLFUNC))) rite = aplcopy(rite); /* copy a permanent variable */ p = treenode(nameptr); /* find node, if it exists */ if (p != NULL) { /* found */ if (NULL != (wrk = p->avlleaf)) { if ((wrk->aplflags & APLLABEL) || (wrk->aplflags & APLFUNC && (0 == rite->aplflags & APLFUNC))) return(errstop(91,NULL,rite,NULL)); /* not allowed */ leafdel(p->avlleaf); } p->avlleaf = perm(rite); } else { for(symp = (Treelist) treehdr; symp->treenext != NULL; symp = symp->treenext); /* find tree root */ p = avladd(&(symp->avlhdr),nameptr,perm(rite)); if (p == NULL) return(errstop(55,NULL,rite,NULL)); /* shouldn't occur */ } if (0 == strcmp(nameptr,quadio)) indxorg = ivalue(rite); /* change global indxorg */ else if (0 == strcmp(nameptr,quadct)) fuzz = value(rite); /* change global comparison tolerance */ else if (0 == strcmp(nameptr,quadpp)) pp = value(rite); /* change global print precision */ return(rite); }