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