Metropoli BBS
VIEWER: assign.c MODE: TEXT (ASCII)
/*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);
}
[ RETURN TO DIRECTORY ]