#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);
}
syntax highlighted by Code2HTML, v. 0.9.1