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