#include <stdio.h>
#include <string.h>
#include <ctype.h>

#include "sysdep.h"
#include "stack.h"
#include "output.h"
#include "command.h"
#include "input.h"
#include "express.h"
#include "builtin.h"
#include "mainloop.h"
#include "udf.h"

static char *argname[] = {
	"arg1","arg2","arg3","arg4","arg5","arg6","arg7","arg8","arg9","arg10",
	"arg11","arg12","arg13","arg14","arg15","arg16","arg17","arg18","arg19",
	"arg20"
};

static int xors[20];

static header *running;

void make_xors (void)
{	int i;
	for (i=0; i<20; i++) xors[i]=xor(argname[i]);
}

static char *type_udfline (char *start)
{	char outline[1024],*p=start,*q;
	double x;
	int comn;
	q=outline;
	while (*p)
	{	if (*p==2)
		{	p++; memmove((char *)(&x),p,sizeof(double));
			p+=sizeof(double);
			sprintf(q,"%g",x);
			q+=strlen(q);
		}
		else if (*p==3)
		{	p++;
			memmove((char *)(&comn),p,sizeof(int));
			p+=sizeof(int);
			sprintf(q,"%s",command_list[comn].name);
			q+=strlen(q);
		}
		else *q++=*p++;
		if (q>outline+1022)
		{	q=outline+1023;
			break;
		}
	}
	*q=0;
	output(outline); output("\n");
	return p+1;
}

void minput (header *);

void trace_udfline (char *next)
{	int scan,oldtrace;
	extern header *running;
	header *hd,*res;
	output1("%s: ",running->name); type_udfline(next);
	again: wait_key(&scan);
	switch (scan)
	{	case fk1 :
		case cursor_down :
			break;
		case fk2 :
		case cursor_up :
			trace=2; break;
		case fk3 :
		case cursor_right :
			trace=0; break;
		case fk4 :
		case help :
			hd=(header *)newram;
			oldtrace=trace; trace=0;
			new_string("Expression",12,""); if (error) goto cont;
			minput(hd); if (error) goto cont;
			res=getvalue(hd); if (error) goto cont;
			give_out(res);
			cont : newram=(char *)hd;
			trace=oldtrace;
			goto again;
		case fk9 :
		case escape :
			output("Trace interrupted\n"); error=11010; break;
		case fk10 :
		case cursor_left :
			trace=-1; break;
		default :
			output(
				"\nKeys :\n"
				"cursor_down   Single step\n"
				"cursor_up     Step over subroutines\n"
				"cursor_right  Go until return\n"
				"insert        Evaluate expression\n"
				"escape        Abort execution\n"
				"cursor_left   End trace\n\n");
			goto again;
	}
}

void do_trace(void)
/**** do_trace
	toggles tracing or sets the trace bit of a udf.
****/
{	header *f;
	char name[64];
	scan_space();
	if (!strncmp(next,"off",3))
	{	trace=0; next+=3;
	}
	else if (!strncmp(next,"alloff",6))
	{	next+=6;
		f=(header *)ramstart;
		while ((char *)f<udfend && f->type==s_udf)
		{	f->flags&=~1;
			f=nextof(f);
		}
		trace=0;
	}	
	else if (!strncmp(next,"on",2))
	{	trace=1; next+=2;
	}
	else if (*next==';' || *next==',' || *next==0) trace=!trace;
	else
	{	if (*next=='"') next++;
		scan_name(name); if (error) return;
		if (*next=='"') next++;
		f=searchudf(name);
		if (!f || f->type!=s_udf)
		{	output("Function not found!\n");
			error=11021; return;
		}
		f->flags^=1;
		if (f->flags&1) output1("Tracing %s\n",name);
		else output1("No longer tracing %s\n",name);
		scan_space();
	}
	if (*next==';' || *next==',') next++;
}

header *searchudf (char *name)
/***** searchudf
	search a udf, named "name".
	return 0, if not found.
*****/
{	header *hd;
	int r;
	r=xor(name);
	hd=(header *)ramstart;
	while ((char *)hd<udfend && hd->type==s_udf)
	{	if (r==hd->xor && !strcmp(hd->name,name)) return hd;
		hd=nextof(hd);
	}
	return 0;
}

commandtyp *preview_command (unsigned long *l);

char ystring[256];

void get_udf (void)
/***** get_udf
	define a user defined function.
*****/
{	char name[16],argu[16],*p,*firstchar,*startp;
	int *ph,*phh,count=0,n;
	unsigned long l;
	header *var,*result,*hd;
	FILE *actfile=infile;
	commandtyp *com;
	int comn;
	double x;
	if (udfon==1)
	{	output("Cannot define a function in a function!\n");
		error=60; return;
	}
	scan_space(); scan_name(name); if (error) return;
	kill_udf(name);
	var=new_reference(0,name); if (error) return;
	result=new_udf(""); if (error) return;
	p=udfof(result); udf=1; /* udf is for the prompt! */
	scan_space();
	ph=(int *)p; p+=sizeof(inttyp);
	if (*next=='(')
	{	while(1)
		{	next++;
			scan_space();
			if (*next==')') break;
			phh=(int *)p; *phh=0; p+=sizeof(inttyp);
			scan_name(argu); if (error) goto aborted;
			count++;
			strcpy(p,argu); p+=16;
			*((int *)p)=xor(argu); p+=sizeof(inttyp);
			test: scan_space();
			if (*next==')') break;
			else if (*next=='=')
			{	next++;
				*phh=1;
				newram=p;
				hd=(header *)p;
				scan_value(); if (error) goto aborted;
				strcpy(hd->name,argu);
				hd->xor=xor(argu);
				p=newram;
				goto test;
			}
			else if (*next==',') continue;
			else
			{	output("Syntax error in parameter list!\n"); error=701;
				goto aborted;
			}
		}
		next++;
	}
	*ph=count;
	if (*next==0) { next_line(); }
	while (1) /* help section of the udf */
	{	if (*next=='#' && *(next+1)=='#')
		{	while (*next)
			{	*p++=*next++;
				if (!freeramfrom(p,16))
				{	output("Memory overflow while defining a function!\n");
					error=210; goto stop;
				}
			}
			*p++=0; next_line();
		}
		else break;
		if (actfile!=infile)
		{	output("End of file reached in function definition!\n");
			error=2200; goto stop;
		}
	}
	*udfstartof(result)=(p-(char *)result);
	startp=p;
	firstchar=next;
	while (1)
	{	if (error) goto stop;
		if (!strncmp(next,"endfunction",strlen("endfunction")))
		{	if (p==startp || *(p-1)) *p++=0;
			*p++=1; next+=strlen("endfunction"); break;
		}
		if (actfile!=infile)
		{	output("End of file reached in function definition!\n");
			error=2200; goto stop;
		}
		if (*next=='#' && *(next+1)=='#')
		{	*p++=0; next_line(); firstchar=next;
		}
		else
		if (*next)
		{	if (*next=='"')
			{	*p++=*next++;
				while (*next!='"' && *next) *p++=*next++;
				if (*next=='"') *p++=*next++;
				else { output("\" missing.\n"); error=2200; goto stop; }
			}
			else if (*next=='\'' && *(next+1)=='\'')
			{	*p++=*next++; *p++=*next++;
				while (*next && (*next!='\'' || *(next+1)!='\''))
					*p++=*next++;				
				if (*next=='\'') { *p++=*next++; *p++=*next++; }
				else { output("\'\' missing.\n"); error=2200; goto stop; }
			}
			else if (isdigit(*next) ||				     	
				(*next=='.' && isdigit(*(next+1))) )
			{	if (next!=firstchar && isalpha(*(next-1)))
				{	*p++=*next++;
					while (isdigit(*next)) *p++=*next++;
				}
				else
				{
					if ((p-(char *)result)%2==0) *p++=' ';
					*p++=2;
					sscanf(next,"%lg%n",&x,&n);
					next+=n;
					memmove(p,(char *)(&x),sizeof(double));
					p+=sizeof(double);
				}
			}
			else if (isalpha(*next) &&
				(next==firstchar || !isalpha(*(next-1))) &&
				(com=preview_command(&l))!=0)
			/* Try to find a builtin command */
			{
				if ((p-(char *)result)%2==0) *p++=' ';
				*p++=3;
				comn=com-command_list;
				memmove(p,(char *)(&comn),sizeof(int));
				p+=sizeof(int);
				next+=l;
			}
			else if (*next=='.' && *(next+1)=='.')
			{	*p++=' '; next_line(); firstchar=next;
			}
#ifdef YACAS
			else if (*next=='@' && *(next+1)=='"')
			{	next+=2;
				char *q=ystring;
				while (*next!='"' && *next && (q-ystring)<255) *q++=*next++;
				if (*next=='"') next++;
				else { output("\" missing.\n"); error=2200; goto stop; }
				*q++=0;
				q=call_yacas(ystring);
				strcpy(p,q);
				p+=strlen(p);
			}
#endif
			else *p++=*next++;
		}
		else { *p++=0; next_line(); firstchar=next; }
		if (!freeramfrom(p,80))
		{	output("Memory overflow while defining a function!\n");
			error=210; goto stop;
		}
	}
	stop:
	udf=0; if (error) return;
	result->size=(((p-(char *)result)-1)/ALIGNMENT+1)*ALIGNMENT;
	newram=(char *)result+result->size;
	assign(var,result);
	aborted:
	udf=0;
}

void do_type (void)
{	char name[16];
	header *hd;
	char *p,*pnote;
	int i,count,defaults;
	builtintyp *b;
	scan_space();
	scan_name(name); hd=searchudf(name);
	b=find_builtin(name);
	if (b)
	{   if (b->nargs>=0)
			output1(
				"%s is a builtin function with %d argument(s).\n"
				,name,b->nargs);
		else
			output1(
				"%s is a builtin function.\n"
				,name);
	}
	if (hd && hd->type==s_udf)
	{   if (b) output1("%s is also a user defined function.\n",name);
		output1("function %s (",name);
		p=helpof(hd);
		memmove(&count,p,sizeof(inttyp));
		p+=sizeof(inttyp);
		pnote=p;
		for (i=0; i<count; i++)
		{	memmove(&defaults,p,sizeof(inttyp)); p+=sizeof(inttyp);
			output1("%s",p);
			p+=16+sizeof(inttyp);
			if (defaults)
			{	output("=...");
				p=(char *)(nextof((header *)p));
			}
			if (i!=count-1) output(",");
		}
		output(")\n");
		p=pnote;
		for (i=0; i<count; i++)
		{	memmove(&defaults,p,sizeof(inttyp)); p+=sizeof(inttyp);
			if (defaults) output1("## Default for %s :\n",p);
			p+=16+sizeof(inttyp);
			if (defaults)
			{	give_out((header *)p);
				p=(char *)nextof((header *)p);
			}
		}
		p=udfof(hd);
		while (*p!=1 && p<(char *)nextof(hd))
			p=type_udfline(p);
		output("endfunction\n");
	}
	else
	{	output("No such function!\n"); error=173;
	}
}

/*
static int printudf (char *name, char *buffer, long maxbuf)
{	header *hd;
	char *p,*pnote,*end;
	int i,count,defaults;
	outputbuffer=buffer; outputbufferend=buffer+maxbuf;
	outputbuffererror=0;
	hd=searchudf(name);
	if (hd && hd->type==s_udf)
	{   output1("function %s (",name);
		p=helpof(hd);
		memmove(&count,p,sizeof(inttyp));
		p+=sizeof(inttyp);
		pnote=p;
		for (i=0; i<count; i++)
		{	memmove(&defaults,p,sizeof(inttyp)); p+=sizeof(inttyp);
			output1("%s",p);
			p+=16+sizeof(inttyp);
			if (defaults)
			{	output("=...");
				p=(char *)(nextof((header *)p));
			}
			if (i!=count-1) output(",");
		}
		output(")\n");
		p=pnote;
		for (i=0; i<count; i++)
		{	memmove(&defaults,p,sizeof(inttyp)); p+=sizeof(inttyp);
			if (defaults) output1("## Default for %s :\n",p);
			p+=16+sizeof(inttyp);
			if (defaults)
			{	give_out((header *)p);
				p=(char *)nextof((header *)p);
			}
		}
		end=udfof(hd);
		while (*p!=1 && p<end)
		{	output(p); output("\n");
			p+=strlen(p); p++;
		}
		p=udfof(hd);
		while (*p!=1 && p<(char *)nextof(hd))
			p=type_udfline(p);
		output("endfunction\n");
	}
	else return 0;
	*outputbuffer=0; outputbuffer=0;
	if (outputbuffererror) return 0;
	else return 1;
}
*/

/*****************************************************************************
 *	programming language commands
 *
 *****************************************************************************/

static void scan_end (void)
/***** scan_end
	scan for "end".
*****/
{	int comn;
	commandtyp *com;
	char *oldline=udfline;
	while (1)
	{	switch (*next)
		{	case 1 :
				output("End missing!\n");
				error=110; udfline=oldline; return;
			case 0 : udfline=next+1; next++; break;
			case 2 : next+=1+sizeof(double); break;
			case 3 : next++;
				memmove((char *)(&comn),next,sizeof(int));
				next+=sizeof(int);
				com=command_list+comn;
				if (com->f==do_end)
				{	if (trace>0) trace_udfline(udfline);
					return;
				}
				else if (com->f==do_repeat || com->f==do_loop ||
					com->f==do_for)
				{	scan_end(); if (error) return; }
				break;
			default : next++;
		}
	}
}

static void scan_endif (void)
/***** scan_endif
	scan for "endif".
*****/
{	commandtyp *com;
	int comn;
	char *oldline=udfline;
	while (1)
	{	switch (*next)
		{	case 1 :
				output("Endif missing, searching for endif!\n");
				error=110; udfline=oldline; return;
			case 0 : udfline=next+1; next++; break;
			case 2 : next+=1+sizeof(double); break;
			case 3 : next++;
				memmove((char *)(&comn),next,sizeof(int));
				next+=sizeof(int);
				com=command_list+comn;
				if (com->f==do_endif)
				{	if (trace>0) trace_udfline(udfline);
					return;
				}
				else if (com->f==do_if)
				{	scan_endif(); if (error) return; }
				break;
			default : next++;
		}
	}
}

static int scan_else (void)
/***** scan_else
	scan for "else".
	return 1, if elseif was found.
*****/
{	commandtyp *com;
	int comn;
	char *oldline=udfline;
	while (1)
	{	switch (*next)
		{	case 1 :
				output("Endif missing, searching for else!\n");
				error=110; udfline=oldline; return 0;
			case 0 : udfline=next+1; next++; break;
			case 2 : next+=1+sizeof(double); break;
			case 3 : next++;
				memmove((char *)(&comn),next,sizeof(int));
				next+=sizeof(int);
				com=command_list+comn;
				if (com->f==do_endif || com->f==do_else)
				{	if (trace>0) trace_udfline(udfline);
					return 0;
				}
				else if (com->f==do_elseif)
				{	return 1;
				}
				else if (com->f==do_if)
				{	scan_endif(); if (error) return 0; }
				break;
			default : next++;
		}
	}
}

void do_global (void)
{	char name[16];
	int r;
	header *hd;
	while (1)
	{	scan_space(); scan_name(name); r=xor(name);
#ifdef SPLIT_MEM
		hd=(header *)varstart;
#else
		hd=(header *)udfend;
#endif
		if (hd==(header *)startlocal) break;
		while ((char *)hd<startlocal)
		{	if (r==hd->xor && !strcmp(hd->name,name)) break;
			hd=nextof(hd);
		}
		if ((char *)hd>=startlocal)
		{	output1("Variable %s not found!\n",name);
			error=160; return;
		}
		newram=endlocal;
		hd=new_reference(hd,name);
		newram=endlocal=(char *)nextof(hd);
		scan_space();
		if (*next!=',') break;
		else next++;
	}
}

void do_useglobal (void)
{   searchglobal=1;
}

void do_return (void)
{	if (!udfon)
	{	output("Use return only in functions!\n");
		error=56; return;
	}
	else udfon=2;
}

void do_break (void)
{	if (!udfon)
	{	output("End only allowed in functions!\n"); error=57;
	}
}

void do_for (void)
/***** do_for
	do a for command in a UDF.
	for i=value to value step value; .... ; end
*****/
{	int h,signum;
	char name[16],*jump;
	header *hd,*init,*end,*step;
	double vend,vstep;
	struct { header hd; double value; } rv;
	if (!udfon)
	{	output("For only allowed in functions!\n"); error=57; return;
	}
	rv.hd.type=s_real; *rv.hd.name=0;
	rv.hd.size=sizeof(header)+sizeof(double); rv.value=0.0;
	scan_space(); scan_name(name); if (error) return;
	kill_local(name);
	newram=endlocal;
	hd=new_reference(&rv.hd,name); if (error) return;
	endlocal=newram=(char *)hd+hd->size;
	scan_space(); if (*next!='=')
	{	output("Syntax error in for.\n"); error=71; goto end;
	}
	next++; init=scan(); if (error) goto end;
	init=getvalue(init); if (error) goto end;
	if (init->type!=s_real)
	{	output("Startvalue must be real!\n"); error=72; goto end;
	}
	rv.value=*realof(init);
	scan_space(); if (strncmp(next,"to",2))
	{	output("Endvalue missing in for!\n"); error=73; goto end;
	}
	next+=2;
	end=scan(); if (error) goto end;
	end=getvalue(end); if (error) goto end;
	if (end->type!=s_real)
	{	output("Endvalue must be real!\n"); error=73; goto end;
	}
	vend=*realof(end);
	scan_space();
	if (!strncmp(next,"step",4))
	{	next+=4;
		step=scan(); if (error) goto end;
		step=getvalue(step); if (error) goto end;
		if (step->type!=s_real)
		{	output("Stepvalue must be real!\n"); error=73; goto end;
		}
		vstep=*realof(step);
	}
	else vstep=1.0;
	signum=(vstep>=0)?1:-1;
	vend=vend+signum*epsilon;
	if (signum>0 && rv.value>vend) { scan_end(); goto end; }
	else if (signum<0 && rv.value<vend) { scan_end(); goto end; }
	newram=endlocal;
	scan_space(); if (*next==';' || *next==',') next++;
	jump=next;
	while (!error)
	{	if (*next==1)
		{	output("End missing!\n");
			error=401; goto end;
		}
		h=command();
		if (udfon!=1 || h==c_return) break;
		if (h==c_break) { scan_end(); break; }
		if (h==c_end)
		{	rv.value+=vstep;
			if (signum>0 && rv.value>vend) break;
			else if (signum<0 && rv.value<vend) break;
			else next=jump;
			if (test_key()==escape)
			{   output("User interrupted!\n");
				error=1; break;
			}
		}
	}
	end : kill_local(name);
}

static long loopindex=0;

void do_loop (void)
/***** do_loop
	do a loop command in a UDF.
	loop value to value; .... ; end
*****/
{	int h;
	char *jump;
	header *init,*end;
	long vend,oldindex;
	if (!udfon)
	{	output("Loop only allowed in functions!\n");
		error=57; return;
	}
	init=scan(); if (error) return;
	init=getvalue(init); if (error) return;
	if (init->type!=s_real)
	{	output("Startvalue must be real!\n"); error=72; return;
	}
	oldindex=loopindex;
	loopindex=(long)*realof(init);
	scan_space(); if (strncmp(next,"to",2))
	{	output("Endvalue missing in loop!\n"); error=73; goto end;
	}
	next+=2;
	end=scan(); if (error) goto end;
	end=getvalue(end); if (error) goto end;
	if (end->type!=s_real)
	{	output("Endvalue must be real!\n"); error=73; goto end;
	}
	vend=(long)*realof(end);
	if (loopindex>vend) { scan_end(); goto end; }
	newram=endlocal;
	scan_space(); if (*next==';' || *next==',') next++;
	jump=next;
	while (!error)
	{	if (*next==1)
		{	output("End missing in loop!\n");
			error=401; goto end;
		}
		h=command();
		if (udfon!=1 || h==c_return) break;
		if (h==c_break) { scan_end(); break; }
		if (h==c_end)
		{	loopindex++;
			if (loopindex>vend) break;
			else next=jump;
			if (test_key()==escape)
			{	output("User interrupted!\n");
				error=1; break;
			}
		}
	}
	end : loopindex=oldindex;
}

void do_repeat (void)
/***** do_loop
	do a loop command in a UDF.
	for value to value; .... ; endfor
*****/
{	int h;
	char *jump;
	if (!udfon)
	{	output("Repeat only allowed in functions!\n");
		error=57; return;
	}
	newram=endlocal;
	scan_space(); if (*next==';' || *next==',') next++;
	jump=next;
	while (!error)
	{	if (*next==1)
		{	output("End missing in repeat statement!\n");
			error=401; break;
		}
		h=command();
		if (udfon!=1 || h==c_return) break;
		if (h==c_break) { scan_end(); break; }
		if (h==c_end)
		{	next=jump;
			if (test_key()==escape)
			{   output1("User interrupted\n");
				error=1; break;
			}
		}
	}
}

void do_end (void)
{	if (!udfon)
	{	output("End only allowed in functions!\n"); error=57;
	}
}

static int ctest (header *hd)
/**** ctest
	test, if a matrix contains nonzero elements.
****/
{	double *m;
	long n,i;
	hd=getvalue(hd); if (error) return 0;
	if (hd->type==s_string) return (*stringof(hd)!=0);
	if (hd->type==s_real) return (*realof(hd)!=0.0);
	if (hd->type==s_complex) return (*realof(hd)!=0.0 &&
		*imagof(hd)!=0.0);
	if (hd->type==s_matrix)
	{	n=(long)(dimsof(hd)->r)*dimsof(hd)->c;
		m=matrixof(hd);
		for (i=0; i<n; i++) if (*m++==0.0) return 0;
		return 1;
	}
	if (hd->type==s_cmatrix)
	{	n=(long)(dimsof(hd)->r)*dimsof(hd)->c;
		m=matrixof(hd);
		for (i=0; i<n; i++) 
		{	if (*m==0.0 && *m==0.0) return 0; m+=2; }
		return 1;
	}
	return 0;
}

void do_if (void)
{	header *cond;
	int flag;
	if (!udfon)
	{	output("If only allowed in functions!\n"); error=111; return;
	}
	another : cond=scan(); if (error) return;
	flag=ctest(cond); if (error) return;
	if (!flag)
		if (scan_else()) goto another;
}

void do_else (void)
{	if (!udfon)
	{	output("Else only allowed in functions!\n"); error=57; return;
	}
	scan_endif();
}

void do_elseif (void)
{	if (!udfon)
	{	output("Elseif only allowed in functions!\n"); error=57; return;
	}
	scan_endif();
}

void do_endif (void)
{	if (!udfon)
	{	output("Endif only allowed in functions!\n"); error=57;
	}
}


/****************************************************************************
 *	builtin functions related to udf
 *
 ****************************************************************************/
void mindex (header *hd)
{	new_real((double)loopindex,"");
}


/****************** udf ************************/

static int udfcount=0;

#ifndef MAXUDF
#define MAXUDF 400
#endif

void interpret_udf (header *var, header *args, int argn, int sp)
/**** interpret_udf
	interpret a user defined function.
****/
{	int udfold,nargu,i,oldargn,defaults,oldtrace,oldindex,
		oldsearchglobal,oldsp,n;
	char *oldnext=next,*oldstartlocal,*oldendlocal,*udflineold,
		*p,*name;
	header *result,*st=args,*hd=args,*hd1,*oldrunning;
	double oldepsilon,oldchanged;
	p=helpof(var);
	nargu=*((int *)p); p+=sizeof(inttyp);
	if (sp!=0) n=sp;
	else n=argn;
	for (i=0; i<n; i++)
	{	if (hd->type==s_reference && !referenceof(hd))
		{	if (i<nargu && hd->name[0]==0 && *(int *)p)
			{	p+=16+2*sizeof(inttyp);
				moveresult((header *)newram,(header *)p);
				p=(char *)nextof((header *)p);
				hd=nextof(hd);
				continue;
			}
			else
			{	hd1=getvalue(hd); if (error) return;
			}
		}
		else hd1=hd;
		if (i<nargu)
		{	defaults=*(int *)p; p+=sizeof(inttyp);
			strcpy(hd1->name,p); hd1->xor=*((int *)(p+16));
			p+=16+sizeof(inttyp);
			if (defaults) p=(char *)nextof((header *)p);
		}
		else
		{	strcpy(hd1->name,argname[i]);
			hd1->xor=xors[i];
		}
		hd=nextof(hd);
	}
	for (i=n; i<nargu; i++)
	{	defaults=*(int *)p;
		name=p+sizeof(inttyp);
		p+=16+2*sizeof(inttyp);
		if (defaults)
		{	moveresult((header *)newram,(header *)p);
			p=(char *)nextof((header *)p);
		}
		else
		{	output1("Argument %s undefined.\n",name);
			error=1; return;
		}
	}
	for (i=n; i<argn; i++)
	{   strcpy(hd->name,""); hd->xor=0;
		hd=nextof(hd);
	}
	if (sp==0 && argn>nargu) sp=nargu;
	udflineold=udfline;
	oldargn=actargn; oldsp=actsp;
	actargn=argn; actsp=sp;
	udfline=next=udfof(var); udfold=udfon; udfon=1;
	oldstartlocal=startlocal; oldendlocal=endlocal;
	startlocal=(char *)args; endlocal=newram;
	oldrunning=running; running=var;
	oldindex=loopindex;
	oldsearchglobal=searchglobal; searchglobal=0;
	oldepsilon=epsilon; oldchanged=epsilon=changedepsilon;
	if ((oldtrace=trace)>0)
	{	if (trace==2) trace=0;
		if (trace>0) trace_udfline(next);
	}
	else if (var->flags&1)
	{	trace=1;
		if (trace>0) trace_udfline(next);
	}
	udfcount++;
	if (udfcount>MAXUDF)
	{	output("To many recursions!\n");
		error=1;
	}
	while (!error && udfon==1)
	{	command();
		if (udfon==2)
		{	result=scan_value();
			if (error)
			{	output1("Error in function %s\n",var->name);
				print_error(udfline);
				break;
			}
			moveresult1(st,result);
			break;
		}
		if (test_key()==escape)
		{	output("User interrupted!\n"); error=58; break;
		}
	}
	udfcount--;
	endlocal=oldendlocal; startlocal=oldstartlocal;
	running=oldrunning;
	loopindex=oldindex;
	if (oldchanged==changedepsilon) epsilon=oldepsilon;
	else epsilon=changedepsilon;
	if (trace>=0) trace=oldtrace;
	if (error) output1("Error in function %s\n",var->name);
	if (udfon==0)
	{	output1("Return missing in %s!\n",var->name); error=55; }
	udfon=udfold; next=oldnext; udfline=udflineold;
	actargn=oldargn; actsp=oldsp;
	searchglobal=oldsearchglobal;
}

void mdo (header *hd)
{	header *st=hd,*hd1,*result;
	int count=0;
	unsigned long size;
	if (!hd) wrong_arg_in("do");
	hd=getvalue(hd);
	result=hd1=next_param(st);
	if (hd->type!=s_string) wrong_arg_in("do");
	if (error) return;
	hd=searchudf(stringof(hd));
	if (!hd || hd->type!=s_udf) wrong_arg_in("do");
	while (hd1)
	{	strcpy(hd1->name,argname[count]);
		hd1->xor=xors[count];
		hd1=next_param(hd1); count++;
	}
	if (result)
	{	size=(char *)result-(char *)st;
		if (size>0 && newram!=(char *)result)
			memmove((char *)st,(char *)result,newram-(char *)result);
		newram-=size;
	}
	interpret_udf(hd,st,count,0);
}