Metropoli BBS
VIEWER: execspee.c MODE: TEXT (ASCII)
/* Copyright (C) 1996 by Thomas Glen Smith.	All Rights Reserved. */
/* execspee APL2 V1.0.0 ************************************************
* Called by execspex to complete assignment to a list of names.		 *
***********************************************************************/
#define INCLUDES APLCHDEF+APLTOKEN+APLCB+TREE
#include "includes.h"
int execspee(tok, axistok, op, namecnt)
Apltoken tok, axistok; /* s/b NULL */
Apltoken op; /* lifo stack of names in (a b c ...)#n */
int namecnt; /* count of names in op stack */
{
	Aplcopy; Aplnest; Assign; Endoper; Errstop; Execfree; Execgetp;
	Execpop; Exectok; Lifo; Pop;
	extern int aplerr;			extern Treelist treehdr;
	int err=0,off,tempsave;		Aplcb incb,out=NULL,*tmp,wrk;
	Apltoken nametok;			Treelist treetest=treehdr;

	for (;;) { /* Lets me use break. */
		if (tok != NULL || axistok != NULL) {
			execfree(tok); execfree(axistok);
			aplerr = 127; /* item out of place */
			break; }
		tok = pop(&(treehdr->avlexec->avloprst));
		off = tok->token_offset; /* save offset */
		incb = out = execgetp(tok);
		if (tempsave = out->aplflags & APLTEMP) out->aplflags-=APLTEMP;
          if (namecnt == 1) {
			nametok = pop(&op);
			wrk = assign(nametok->token_ptr.token_string,out);
			execfree(nametok);
               break; }
		if (out->aplrank > 1) { aplerr = 128; break; }/* rank error */
		else if (out->aplrank == 1)
			if (out->aplcount != namecnt) { aplerr = 127; break; }
			else if (!(out->aplflags & APLAPL)) incb = aplnest(out);
		while(namecnt--) {
			nametok = pop(&op);
			if (incb->aplrank) {
				wrk = *(tmp = incb->aplptr.aplapl + incb->aplcount-namecnt-1);
				if (incb != out)
					*tmp = NULL;
				else wrk = aplcopy(wrk);
			}
			else wrk = aplcopy(incb);
			wrk->aplflags |= APLTEMP; /* lets assign use */
			wrk = assign(nametok->token_ptr.token_string,wrk);
			execfree(nametok);
		}
		if (incb != out) endoper(incb);
		break; }
	if (out != NULL) {
		out->aplflags += tempsave;
		tok = exectok(out,off);
		tok = lifo(&(treehdr->avlexec->avloprst),tok);
	}
	if (op != NULL) execpop(&op);
	return(1); /* indicate specification handled */
}
[ RETURN TO DIRECTORY ]