Metropoli BBS
VIEWER: funcopy.c MODE: TEXT (ASCII)
/* Copyright (C) 1994 by Thomas Glen Smith.	All Rights Reserved. */
/* funcopy APL2 V1.0.0 *************************************************
* Called by funcmain.                                                  *
* Called to execute niladic, monadic, and dyadic user functions.		 *
***********************************************************************/
#define INCLUDES APLMEM+APLCB+APLTOKEN+APLFUNCI+STRING
#include "includes.h"
Aplfunc funcopy(fp)
Aplfunc fp; /* Function definition structure. */
{
	Execqfxa; Execqfxj; Intcopy; Tokcopy;
	extern int aplerr;
	Aplfunc np;
	int i,*ip,stmtno;
	Apltoken newtok,oldtok;

	for (;;) { /* lets me use break */
		np = execqfxa(fp->functext); /* get new function structure,
          	and copy fp->functext. */
		if (np == NULL) break;
		np->functype = fp->functype; /* e.g. monadic, niladic, etc. */
		np->functotl = fp->functotl; /* Count of tokens in functary. */
		np->funcstmt = fp->funcstmt; /* Count of stmts in function. */
		np->funcname = fp->funcname; /* Ptr to function name token. */
		np->funcvars = fp->funcvars; /* List of local vars. */
		execqfxj(np); /* initialize arrays dependent on stmtcnt */
		ip = intcopy(np->functokc,fp->functokc,np->funcstmt,1);
			/* Copy array of token counters, 1 per stmt. */
		np->functary = malloc(np->functotl * sizeof(struct apltoken));
			/* Memory for new array of tokens. */
		if (np->functary == NULL) break;
		for (i = 0; i < np->functotl; i++)
			tokcopy(np->functary+i, fp->functary+i); /* copy token */
		if (aplerr) break;
		for (stmtno = 0; stmtno < np->funcstmt; stmtno++)
			*(np->functokp + stmtno) = np->functary +
				(*(fp->functokp + stmtno) - fp->functary);
				/* Relative offsets are the same, new vs. old. */
		oldtok = fp->funclabs;
		if (oldtok == NULL)
			np->funclabs = NULL;
		else {
			newtok = np->funclabs =
				oldtok - fp->functary + np->functary;
			while (oldtok) {
				newtok->token_offset = oldtok->token_offset;
				oldtok = oldtok->token_queue.token_next_ptr;
				if (NULL == oldtok)
					newtok->token_queue.token_next_ptr = NULL;
				else newtok->token_queue.token_next_ptr =
					oldtok - fp->functary + np->functary;
				newtok = newtok->token_queue.token_next_ptr;
			}
		}
		break; /* final break out of for loop */
	}
	return(np);
}
[ RETURN TO DIRECTORY ]