#include <stdio.h>
#include <string.h>
#ifndef NOSTDLIB_H
#include <stdlib.h>
#endif
#ifndef NOUNISTD_H
#include <unistd.h>
#endif
#include "symbol.h"
#include "code.h"
#ifdef VMS
#include "math_tab.h"
#else
#include "math.tab.h"
#endif
#include "fudgit.h"
#include "head.h"

extern char Ft_Format[];
extern char Ft_TFormat[];
extern FILE *Ft_Outprint;

#ifdef DEBUG
# define CODE(a) fprintf(stderr, "Run: %s\n", a)
# define PNUM(a) fprintf(stderr, "Run: %g\n ", (double)a)
#else
# define CODE(a)
# define PNUM(a)
#endif

#ifdef DALIGN
# ifdef MEMMOVE
#  define bcopy(a, b, n) memmove(b, a, n)
# endif
#endif

typedef struct Frame {
	Symbol  *sp;
	Inst	*retpc;
	Datum   *argn;
	int	 nargs;
} Frame;

int Ft_Indef = 0;
int Ft_Inproto = 0;
int Ft_Inauto = 0;
int Ft_Inbrace = 0;
Inst *Ft_Progp;
Inst *Ft_Progbase;

static int Index = ERRR;
#ifdef DEBUG
#define static
#endif
static Inst *prog;
static Inst *pc;
#undef static
static int Returning = 0;
static int Break = 0;
static Datum *stack;
static Datum *stackp;
static Frame *frame;
static Frame *frp;

static void cleanfrp(int num), ret(void);
static double *getarg(void);
static Inst *checkargs(Inst *start, Frame *frpp);
static char *makename(Symbol *sp);

void Ft_cleanframe(void), Ft_matherror(char *s1, char *s2, int lino);
Code Ft_vecexec(int size);

extern char *strcat (char *, const char *);
extern void Ft_free_dvector (double *v, int nl, int nh);

void Ft_resetprog(void)
{
	Ft_Progbase = prog;
}

void Ft_resetindex(void)
{
	Index = ERRR;
}

void Ft_initstacks(void)
{
	stack = (Datum *)malloc((unsigned)((NSTACK+2) * sizeof(Datum)));
	if (stack == (Datum *)NULL) {
		fputs("Math error: Fatal error on stack allocation.\n", stderr);
		exit(1);
	}
	prog = (Inst *)malloc((unsigned)((NPROG+2) * sizeof(Inst)));
	if (prog == (Inst *)NULL) {
		fputs("Math error: Fatal error on stack allocation.\n", stderr);
		exit(1);
	}
	frame = (Frame *)malloc((unsigned)((NFRAME+2) * sizeof(Frame)));
	if (frame == (Frame *)NULL) {
		fputs("Math error: Fatal error on stack allocation.\n", stderr);
		exit(1);
	}
	frame[0].argn = stack;
	frame[0].nargs = 0;
	frame[0].sp = 0;
	frp = ++frame;
	Ft_Progbase = prog;
}

int Ft_funcprocnotdef(void)
{
	if (Ft_Progbase == prog)
		return(1);
	return(0);
}

void Ft_initcode(void)
{
	CODE("initcode");
	Ft_Progp = Ft_Progbase;
	Ft_cleanframe();
	stackp = stack;
	Returning = 0;
	Break = 0;
}

#ifdef DONTMACROPOP
Code Ft_push(Datum d)
{
	CODE("push");
	if (stackp >= &stack[NSTACK]) {
		Ft_matherror("Stack overflow.", NULL, 0);
	}
	*stackp = d;
	stackp++;
}
#else
#define Ft_push(a)	(*stackp++ = a)
#endif

/* solving the problem for returning function on execute */
Code Ft_nullpop(void)
{
	CODE("nullpop");
	if (stackp <= stack)  {
		Ft_matherror("Stack underflow.", NULL, 0);
	}
	stackp--;
}

#ifdef DONTMACROPOP
Datum Ft_pop(void)
{
	CODE("pop");
	if (stackp <= stack)  {
		Ft_matherror("Stack underflow.", NULL, 0);
	}
	stackp--;
	return(*stackp);
}
#else
#define Ft_pop()	(*(--stackp))
#endif

Inst *Ft_code(Inst f)
{
	Inst *oProgp = Ft_Progp;

	if (Ft_Progp >= &prog[NPROG]) {
		Ft_matherror("Instruction code overflow.", NULL, 0);
	}
	*Ft_Progp = f;
	Ft_Progp++;
	return(oProgp);
}

Inst *Ft_dblcode(double d)
{
	Inst *oProgp = Ft_Progp;
#ifndef DALIGN
	double *dp = (double *)Ft_Progp;
#endif
	if (Ft_Progp >= &prog[NPROG]) {
		Ft_matherror("Instruction code overflow.", NULL, 0);
	}
#ifndef DALIGN
	*dp = d;
#else
	bcopy((void *)&d, (void *)Ft_Progp, sizeof(double));
#endif
	Ft_Progp += (sizeof(double)/sizeof(Inst *));
	return(oProgp);
}

Code Ft_parloop(void)
{
	extern double *Ft_Param;

	Ft_vecexec((int)(*Ft_Param));
}

Code Ft_vecloop(void)
{
	extern double *Ft_Data;

	Ft_vecexec((int)(*Ft_Data));
}

/* called by loops */
Code Ft_vecexec(int size)
{
	register Inst *pp;
	Inst *basepc;
	extern int Index;

	CODE("vexecute at");
	PNUM((int)(pc-prog));
	if (size == 0) {
		Ft_matherror("Null size vector!", NULL, 0);
	}
	basepc = pc;

	/* !Returning and !Break do not have to be checked for */
	/* since there is no statement in vexec */
	for (Index = 1;Index <= size; Index++) {
		pc = basepc;
		while (*pc) {
			pp = pc++;
			(void) (*(*pp))();
		}
	}
	/* Park Index variable */
	Index = ERRR;
	/* place pc after loop STOP */
	pc++;
}

void Ft_execute(Inst *p)
{
	register Inst *pp;

	CODE("execute at");
	PNUM((int)(p-prog));
	for (pc = p; *pc != STOP && !Returning && !Break; ) {
		pp = pc++;
		(void) (*(*pp))();
	}
}

Code Ft_varpush(void)
{
	Datum d;

	CODE("varpush");
	d.sym = (Symbol *)(*pc);
	pc++;
	CODE(d.sym->name);
	Ft_push(d);
}

Code Ft_strpush(void)
{
	Datum d;

	CODE("strpush");
	d.str = ((Symbol *)*pc)->u.str;
	pc++;
	CODE(d.str);
	Ft_push(d);
}

Code Ft_constpush(void)
{
	Datum d;
#ifndef DALIGN
	double *dp = (double *)pc;

	CODE("constpush");
	d.val = *dp;
#else

	CODE("constpush");
	bcopy((void *)pc, (void *)&d.val, sizeof(double));
#endif
	pc += (sizeof(double)/sizeof(Inst *));
	PNUM(d.val);
	PNUM(d.val);
	Ft_push(d);
}

Code Ft_negate(void)
{
	Datum d;

	CODE("negate");
	d  = Ft_pop();
	d.val = -d.val;
	Ft_push(d);
}

Code Ft_strsub(void)
{
	static char diff[TOKENSIZE+4];
	Datum d1, d2;
	register char *cp1, *cp2;

	CODE("strsub");
	d2  = Ft_pop();
	d1  = Ft_pop();
	strcpy(diff, d1.str);
	d1.str = cp1 = diff;
	cp2 = d2.str;
	while (*cp1)
		cp1++;
	while (*cp2)
		cp2++;
	while (*cp1 == *cp2 || *cp2 == '?') {
		*cp1 = '\0';
		cp1--; cp2--;
		if (cp1 < diff || cp2 < d2.str)
			break;
	}
	Ft_push(d1);
}

Code Ft_stradd(void)
{
	static char total[TOKENSIZE+4];
	Datum d1, d2;

	CODE("stradd");
	d2  = Ft_pop();
	d1  = Ft_pop();
	if (strlen(d1.str) + strlen(d2.str) > TOKENSIZE) {
		Ft_matherror("String addition: Result too long.", NULL, 0);
	}
	if (d2.str != total) {
		strcpy(total, d1.str);
		strcat(total, d2.str);
	}
	else {
		char tmp[TOKENSIZE+4];

		strcpy(tmp, d2.str);
		strcpy(total, d1.str);
		strcat(total, tmp);
	}
	d1.str = total;
	Ft_push(d1);
}

Code Ft_add(void)
{
	Datum d1, d2;

	CODE("add");
	d2  = Ft_pop();
	d1  = Ft_pop();
	d1.val += d2.val;
	Ft_push(d1);
}

Code Ft_sub(void)
{
	Datum d1, d2;

	CODE("sub");
	d2  = Ft_pop();
	d1  = Ft_pop();
	d1.val -= d2.val;
	Ft_push(d1);
}

Code Ft_mul(void)
{
	Datum d1, d2;

	CODE("mul");
	d2  = Ft_pop();
	d1  = Ft_pop();
	d1.val *= d2.val;
	Ft_push(d1);
}

Code Ft_div(void)
{
	Datum d1, d2;
	extern int Ft_Check;

	CODE("div");
	d2  = Ft_pop();
	if (d2.val == 0.0 && Ft_Check & INF_CHK) {
		Ft_matherror("Division by zero.", NULL, 0);
	}
	d1 = Ft_pop();
	d1.val /= d2.val;
	Ft_push(d1);
}

Code Ft_modulo(void)
{
	Datum d1, d2;
	int tmp1, tmp2;
	extern int Ft_Check;

	CODE("modulo");
	d2  = Ft_pop();
	d1  = Ft_pop();
	if (d2.val == 0.0 && Ft_Check & INF_CHK) {
		Ft_matherror("Modulo division by zero.", NULL, 0);
	}
	tmp1 = d1.val;
	tmp2 = d2.val;
	d1.val = tmp1%tmp2;
	Ft_push(d1);
}

Code Ft_extcall(void)
{
	Datum d;
	Symbol *sym;
	double dblvec[MATHMAXARG];
	void *ptrvec[MATHMAXARG];
	int ino, argno, type;
	char *tvec;

	CODE("pointer");
	sym = (Symbol *) *pc;
	pc++;
	CODE("number");
	argno = (int) *pc;
	pc++;
	if (argno >= MATHMAXARG)
		Ft_matherror("%s: Too many arguments (%d).", sym->name, argno);
	tvec = sym->size.vals;  /* types stored there */
	for (ino=argno;ino > 0;ino--) {
		d = Ft_pop();
		type = (int) d.val;
		d = Ft_pop();
		if (!tvec[0])
			Ft_matherror("%s: Too many arguments (%d required).",
			sym->name, (argno-ino));
		switch(*tvec) {
		case PROTO_VAL:
			if (type != NUMBER)
				Ft_matherror("%s: Argument %d not an expr.",
				sym->name, ino);
			dblvec[ino-1] = d.val;
			ptrvec[ino-1] = (void *) (dblvec+ino-1);
			break;
		case PROTO_VEC:
			if (type != VEC)
				Ft_matherror("%s: Argument %d not a VEC.", sym->name, ino);
			ptrvec[ino-1] = (void *) (d.sym->u.vec + 1);
			break;
		case PROTO_PAR:
			if (type != PARAM)
				Ft_matherror("%s: Argument %d not a PARAM.", sym->name, ino);
			ptrvec[ino-1] = (void *)(d.sym->u.vec + 1);
			break;
		case PROTO_STR:
			if (type != STRVAR)
				Ft_matherror("%s: Argument %d not a String.",
				sym->name, ino);
			ptrvec[ino-1] = (void *)d.sym->u.str;
			break;
		default:
			Ft_matherror("%s: Unknown type in definition.", sym->name, 0);
		}
		tvec++;
	}
	if (tvec[0])
		Ft_matherror("%s: Not enough arguments (%d).", sym->name, argno);
	if (sym->type == EFUNCSYM) {
		d.val = ( *(double (*)(double *, ...)) sym->u.ptr) (
		ptrvec[0],  ptrvec[1],  ptrvec[2],  ptrvec[3],  ptrvec[4],
		ptrvec[5],  ptrvec[6],  ptrvec[7],  ptrvec[8],  ptrvec[9],
		ptrvec[10], ptrvec[11], ptrvec[12], ptrvec[13], ptrvec[14],
		ptrvec[15], ptrvec[16], ptrvec[17], ptrvec[18], ptrvec[19],
		ptrvec[20], ptrvec[21], ptrvec[22], ptrvec[23], ptrvec[24],
		ptrvec[25], ptrvec[26], ptrvec[27], ptrvec[28], ptrvec[29],
		ptrvec[30], ptrvec[31], ptrvec[32], ptrvec[33], ptrvec[34]);
		Ft_push(d);
	} else {
		(void) ( *(double (*)(double *, ...))sym->u.ptr) (
		ptrvec[0],  ptrvec[1],  ptrvec[2],  ptrvec[3],  ptrvec[4],
		ptrvec[5],  ptrvec[6],  ptrvec[7],  ptrvec[8],  ptrvec[9],
		ptrvec[10], ptrvec[11], ptrvec[12], ptrvec[13], ptrvec[14],
		ptrvec[15], ptrvec[16], ptrvec[17], ptrvec[18], ptrvec[19],
		ptrvec[20], ptrvec[21], ptrvec[22], ptrvec[23], ptrvec[24],
		ptrvec[25], ptrvec[26], ptrvec[27], ptrvec[28], ptrvec[29],
		ptrvec[30], ptrvec[31], ptrvec[32], ptrvec[33], ptrvec[34]);
	}
}

Code Ft_bltin0str(void)
{
	Datum d;

	CODE("builtin0str");
	CODE("pointer");
	d.str = (*(char *(*)(void))(*pc))();
	pc++;
	Ft_push(d);
}

Code Ft_bltin0(void)
{
	Datum d;

	CODE("builtin0");
	CODE("pointer");
	d.val = (*(double (*)(void))(*pc))();
	pc++;
	Ft_push(d);
}

Code Ft_bltin1(void)
{
	Datum d;

	CODE("builtin1");
	d = Ft_pop();
	CODE("pointer");
	d.val = (*(double (*)(double))(*pc))(d.val);
	pc++;
	Ft_push(d);
}

Code Ft_bltin1vec(void)
{
	Datum d;

	CODE("builtin1vec");
	d = Ft_pop();
	CODE("pointer");
	d.val = (*(double (*)(double *))(*pc))(d.sym->u.vec);
	pc++;
	Ft_push(d);
}

Code Ft_bltin2(void)
{
	Datum d1, d2;

	CODE("bltin2");
	d2 = Ft_pop();
	d1 = Ft_pop();
	CODE("pointer");
	d1.val = (*(double (*)(double, double))(*pc))(d1.val, d2.val);
	pc++;
	Ft_push(d1);
}

Code Ft_bltin1str(void)
{
	Datum d;

	CODE("bltin1str");
	d = Ft_pop();
	CODE("pointer");
	d.str = (*(char *(*)(char *))(*pc))(d.str);
	pc++;
	Ft_push(d);
}

Code Ft_bltin2str(void)
{
	Datum d1, d2;

	CODE("bltin2str");
	d2 = Ft_pop();
	d1 = Ft_pop();
	CODE("pointer");
	d1.str = (*(char *(*)(char *, char *))(*pc))(d1.str, d2.str);
	pc++;
	Ft_push(d1);
}

Code Ft_strbltin2(void)
{
	Datum d1, d2;

	CODE("strbltin2");
	d2 = Ft_pop();
	d1 = Ft_pop();
	CODE("pointer");
	d1.val = (*(double (*)(char *, char *))(*pc))(d1.str, d2.str);
	pc++;
	Ft_push(d1);
}

Code Ft_power(void)
{
	Datum d1, d2;
	extern double Ft_Pow(double x, double y);

	CODE("power");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = Ft_Pow(d1.val, d2.val);
	Ft_push(d1);
}

Code Ft_eeval(void)
{
	Datum d1, d2;
	register int index;

	CODE("eeval");
	d1 = Ft_pop();
	/*********************
	if (d1.sym->type != VEC && d1.sym->type != PARAM) {
		Ft_matherror("%s: Not a vector or parameter.", d1.sym->name, 0);
	}
	**********************/
	d2 = Ft_pop();
	index = (int) d2.val;
	if (index < 1 || index > d1.sym->size.val) {
		Ft_matherror("%s: Index %d out of range.", d1.sym->name, index);
	}
	d2.val = d1.sym->u.vec[index];
	Ft_push(d2);
}

Code Ft_postieval(void)
{
	Datum d1, d2;

	CODE("postieval");
	d1 = Ft_pop();
	if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		d2.val = d1.sym->u.val;
		d1.sym->u.val += 1.0;
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == UNDEFVAR) {
		Ft_matherror("%s: Unassigned variable.", d1.sym->name, 0);
	}
	Ft_matherror("%s: Not a regular variable.", d1.sym->name, 0);
}

Code Ft_postdeval(void)
{
	Datum d1, d2;

	CODE("postdeval");
	d1 = Ft_pop();
	if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		d2.val = d1.sym->u.val;
		d1.sym->u.val -= 1.0;
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == UNDEFVAR) {
		Ft_matherror("%s: Unassigned variable.", d1.sym->name, 0);
	}
	Ft_matherror("%s: Not a regular variable.", d1.sym->name, 0);
}

Code Ft_preieval(void)
{
	Datum d;

	CODE("preieval");
	d = Ft_pop();
	if (d.sym->type == VAR || d.sym->type == BLTINVAR) {
		d.sym->u.val += 1.0;
		d.val = d.sym->u.val;
		Ft_push(d);
		return;
	}
	if (d.sym->type == UNDEFVAR) {
		Ft_matherror("%s: Unassigned variable.", d.sym->name, 0);
	}
	Ft_matherror("%s: Not a regular variable.", d.sym->name, 0);
}

Code Ft_predeval(void)
{
	Datum d;

	CODE("predeval");
	d = Ft_pop();
	if (d.sym->type == VAR || d.sym->type == BLTINVAR) {
		d.sym->u.val -= 1.0;
		d.val = d.sym->u.val;
		Ft_push(d);
		return;
	}
	if (d.sym->type == UNDEFVAR) {
		Ft_matherror("%s: Unassigned variable.", d.sym->name, 0);
	}
	Ft_matherror("%s: Not a regular variable.", d.sym->name, 0);
}

Code Ft_eval(void)
{
	extern int Index;
	register int type;
	Datum d;

	CODE("eval");
	d = Ft_pop();
	type = d.sym->type;
	if (type == VEC || type == PARAM) {
		if (Index == ERRR) {
			Ft_matherror("%s: Illegal vector assignment.", d.sym->name, 0);
		}
		d.val = d.sym->u.vec[Index];
		Ft_push(d);
		return;
	}
	if (type >= VAR && type <= BLTINCONST) {
		d.val = d.sym->u.val;
		Ft_push(d);
		return;
	}
	if (type == UNDEFVEC) {
		Ft_matherror("%s: Unassigned vector.", d.sym->name, 0);
	}
	if (type == UNDEFVAR) {
		Ft_matherror("%s: Unassigned variable.", d.sym->name, 0);
	}
	Ft_matherror("%s: Not a regular variable.", d.sym->name, 0);
}

Code Ft_streval(void)
{
	Datum d;

	CODE("streval");
	d = Ft_pop();
	if (d.sym->type >= STRVAR && d.sym->type <= BLTINSTRCONST) {
		d.str = d.sym->u.str;
		Ft_push(d);
		return;
	}
	if (d.sym->type == UNDEFSTRVAR) {
		Ft_matherror("%s: Unassigned string variable.", d.sym->name, 0);
	}
	Ft_matherror("%s: Not a regular string variable.", d.sym->name, 0);
}

Code Ft_eassign(void)
{
	Datum d1, d2, d3;
	int index;

	CODE("eassign");
	d1 = Ft_pop();
	if (d1.sym->type != VEC && d1.sym->type != PARAM
	&& d1.sym->type != UNDEFVEC) {
		Ft_matherror("%s: Illegal element assignment.", d1.sym->name, 0);
	}
	d2 = Ft_pop();
	d3 = Ft_pop();
	index = (int)d3.val;
	if (index < 1 || index > d1.sym->size.val) {
		Ft_matherror("%s: Index %d out of range.", d1.sym->name, index);
	}
	d1.sym->u.vec[index] = d2.val;
	if (d1.sym->type == UNDEFVEC) {
		d1.sym->type = VEC;
	}
	Ft_push(d2);
}

Code Ft_assign(void)
{
	Datum d1, d2;

	CODE("assign");
	d1 = Ft_pop();
	d2 = Ft_pop();
	if (d1.sym->type == VEC || d1.sym->type == PARAM
	|| d1.sym->type == UNDEFVEC) {
		if (Index == ERRR) { /* assignment from vexecute() only */
			Ft_matherror("%s: Illegal vector assignment.", d1.sym->name, 0);
		}
		d1.sym->u.vec[Index] = d2.val;
		if (d1.sym->type == UNDEFVEC) {
			d1.sym->type = VEC;
		}
	}
	else if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		d1.sym->u.val = d2.val;
	}
	else if (d1.sym->type == UNDEFVAR) {
		d1.sym->u.val = d2.val;
		d1.sym->type = VAR;
	}
	else {
		Ft_matherror("%s: Assignment to non-variable.", d1.sym->name, 0);
	}
	Ft_push(d2);
}

Code Ft_strassign(void)
{
	Datum d1, d2;

	CODE("strassign");
	d1 = Ft_pop();
	d2 = Ft_pop();
	if (d1.sym->type != STRVAR && d1.sym->type != UNDEFSTRVAR &&
	d1.sym->type != BLTINSTRVAR) {
		Ft_matherror("%s: Assignment to non-string variable.", d1.sym->name, 0);
	}
	if (d1.sym->type != UNDEFSTRVAR) {
		free(d1.sym->u.str);
	}
	else {
		d1.sym->type = STRVAR;
	}
	if ((d1.sym->u.str = (char *)malloc(strlen(d2.str) + 1)) == (char *)NULL) {
		Ft_matherror("Allocation error in string assignment.", NULL, 0);
	}
	strcpy(d1.sym->u.str, d2.str);
	Ft_push(d2);
}

Code Ft_le(void)
{
	Datum d1, d2;

	CODE("le");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (d1.val <= d2.val);
	Ft_push(d1);
}

Code Ft_lt(void)
{
	Datum d1, d2;

	CODE("lt");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (d1.val < d2.val);
	Ft_push(d1);
}


Code Ft_ge(void)
{
	Datum d1, d2;

	CODE("ge");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (d1.val >= d2.val);
	Ft_push(d1);
}

Code Ft_gt(void)
{
	Datum d1, d2;

	CODE("gt");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (d1.val > d2.val);
	Ft_push(d1);
}

Code Ft_ne(void)
{
	Datum d1, d2;

	CODE("ne");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (d1.val != d2.val);
	Ft_push(d1);
}

Code Ft_eq(void)
{
	Datum d1, d2;

	CODE("eq");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (d1.val == d2.val);
	Ft_push(d1);
}

Code Ft_streq(void)
{
	Datum d1, d2;

	CODE("eq");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (strcmp(d1.str, d2.str) == 0);
	Ft_push(d1);
}

Code Ft_strne(void)
{
	Datum d1, d2;

	CODE("eq");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) (strcmp(d1.str, d2.str) != 0);
	Ft_push(d1);
}

Code Ft_and(void)
{
	Datum d1, d2;

	CODE("and");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) ((d1.val != 0.0) && (d2.val != 0.0));
	Ft_push(d1);
}

Code Ft_or(void)
{
	Datum d1, d2;

	CODE("or");
	d2 = Ft_pop();
	d1 = Ft_pop();
	d1.val = (double) ((d1.val != 0.0) || (d2.val != 0.0));
	Ft_push(d1);
}

Code Ft_not(void)
{
	Datum d;

	CODE("not");
	d = Ft_pop();
	d.val = (double) (d.val == 0.0);
	Ft_push(d);
}

Code Ft_whilecode(void)
{
	Datum d;
	Inst *savepc = pc;  /* pc is the next instruction */

	CODE("whilecode");
	Break = 0;
	Ft_execute(savepc+2);   /* the condition */
	d = Ft_pop();
	while (d.val) {
		  Ft_execute(*((Inst **)(savepc))); /* the body */
		  if (Break || Returning)
			break;
		  Ft_execute(savepc + 2);
		  d = Ft_pop();
	}
	if (!Returning)
		pc = *((Inst **)(savepc+1));
}

Code Ft_forcode(void)
{
	Datum d;
	Inst *savepc = pc;  /* pc is the next to for itself  */

	CODE("forcode");
	Break = 0;
	Ft_execute(savepc+4);  /* assignments */
	Ft_execute(*((Inst **)savepc));   /* the condition */
	d = Ft_pop();
	while (d.val) {
		  Ft_execute(*((Inst **)(savepc+2))); /* the body-statement */
		  if (Break || Returning)
			break;
		  Ft_execute(*(Inst **)(savepc+1));  /* the expression list */
		  Ft_execute(*(Inst **)savepc);  /* the conditional expression */
		  d = Ft_pop();
	}
	if (!Returning)
		pc = *((Inst **)(savepc+3));
}

Code Ft_ifcode(void)
{
	Datum d;
	Inst *savepc = pc;

	CODE("ifcode");
	Ft_execute(savepc+3);
	d = Ft_pop();
	if (d.val)
		 Ft_execute(*((Inst **) (savepc)));
	else if (*((Inst **)(savepc+1)))
		 Ft_execute(*((Inst **) (savepc+1)));
	if (!Returning)
		pc = *((Inst**)(savepc+2));
}

Code Ft_linprnl(void)
{
	CODE("linprnl");
	fputc('\n', stdout);
	fflush(stdout);
}

Code Ft_linprexpr(void)
{
	Datum d;

	CODE("linprexpr");
	d = Ft_pop();
	fprintf(stdout, Ft_Format, d.val);
	fputc('\t', stdout);
	fflush(stdout);
}

Code Ft_linprstr(void)
{
	Datum d;

	CODE("linprstr");
	d = Ft_pop();
	fputs(d.str, stdout);
	fflush(stdout);
}

Code Ft_prstr(void)
{
	Datum d;

	CODE("prstr");
	d = Ft_pop();
	fputs(d.str, Ft_Outprint);
	fflush(Ft_Outprint);
}

Code Ft_prexpr(void)
{
	Datum d;

	CODE("prexpr");
	d = Ft_pop();
	fprintf(Ft_Outprint, Ft_Format, d.val);
	fputc('\t', Ft_Outprint);
	fflush(Ft_Outprint);
}

Code Ft_addassign(void)
{
	Datum d1, d2;

	CODE("addassign");
	d1 = Ft_pop();
	d2 = Ft_pop();
	if (d1.sym->type == VEC || d1.sym->type == PARAM) {
		if (Index == ERRR) { /* assignment from vexecute() only */
			Ft_matherror("%s: Illegal vector assignment.", d1.sym->name, 0);
		}
		d2.val = (d1.sym->u.vec[Index] += d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		d2.val = (d1.sym->u.val += d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC) {
		Ft_matherror("%s: Unassigned variable.", d1.sym->name, 0);
	}
	Ft_matherror("%s: Assignment to non-variable.", d1.sym->name, 0);
}

Code Ft_mulassign(void)
{
	Datum d1, d2;

	CODE("mulassign");
	d1 = Ft_pop();
	d2 = Ft_pop();
	if (d1.sym->type == VEC || d1.sym->type == PARAM) {
		if (Index == ERRR) { /* assignment from vexecute() only */
			Ft_matherror("%s: Illegal vector assignment.", d1.sym->name, 0);
		}
		d2.val = (d1.sym->u.vec[Index] *= d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		d2.val = (d1.sym->u.val *= d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC) {
		Ft_matherror("%s: Unassigned variable.", d1.sym->name, 0);
	}
	Ft_matherror("%s: Assignment to non-variable.", d1.sym->name, 0);
}

Code Ft_divassign(void)
{
	Datum d1, d2;
	extern int Ft_Check;

	CODE("divassign");
	d1 = Ft_pop();
	d2 = Ft_pop();
	if (d1.sym->type == VEC || d1.sym->type == PARAM) {
		if (Index == ERRR) { /* assignment from vexecute() only */
			Ft_matherror("%s: Illegal vector assignment.", d1.sym->name, 0);
		}
		if (d2.val == 0.0 && Ft_Check & INF_CHK) {
			Ft_matherror("%s: Division by zero.", d1.sym->name, 0);
		}
		d2.val = (d1.sym->u.vec[Index] /= d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		if (d2.val == 0.0 && Ft_Check & INF_CHK) {
			Ft_matherror("%s: Division by zero.", d1.sym->name, 0);
		}
		d2.val = (d1.sym->u.val /= d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC) {
		Ft_matherror("%s: Unassigned variable.", d1.sym->name, 0);
	}
	Ft_matherror("%s: Assignment to non-variable.", d1.sym->name, 0);
}

Code Ft_subassign(void)
{
	Datum d1, d2;

	CODE("subassign");
	d1 = Ft_pop();
	d2 = Ft_pop();
	if (d1.sym->type == VEC || d1.sym->type == PARAM) {
		if (Index == ERRR) { /* assignment from vexecute() only */
			Ft_matherror("%s: Illegal vector assignment.", d1.sym->name, 0);
		}
		d2.val = (d1.sym->u.vec[Index] -= d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == VAR || d1.sym->type == BLTINVAR) {
		d2.val = (d1.sym->u.val -= d2.val);
		Ft_push(d2);
		return;
	}
	if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC) {
		Ft_matherror("%s: Unassigned variable.", d1.sym->name, 0);
	}
	Ft_matherror("%s: Assignment to non-variable.", d1.sym->name, 0);
}

Code Ft_eaddassign(void)
{
	Datum d1, d2, d3;
	int index;

	CODE("eaddassign");
	d1 = Ft_pop();
	if (d1.sym->type != VEC && d1.sym->type != PARAM) {
		if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC)
			Ft_matherror("%s: Unassigned vector.", d1.sym->name, 0);
		else
			Ft_matherror("%s: Illegal element assignment.", d1.sym->name, 0);
	}
	d2 = Ft_pop();
	d3 = Ft_pop();
	index = (int)d3.val;
	if (index < 1 || index > d1.sym->size.val) {
		Ft_matherror("%s: Index %d out of range.", d1.sym->name, index);
	}
	d2.val = (d1.sym->u.vec[index] += d2.val);
	Ft_push(d2);
}

Code Ft_emulassign(void)
{
	Datum d1, d2, d3;
	int index;

	CODE("emulassign");
	d1 = Ft_pop();
	if (d1.sym->type != VEC && d1.sym->type != PARAM) {
		if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC)
			Ft_matherror("%s: Unassigned vector.", d1.sym->name, 0);
		else
			Ft_matherror("%s: Illegal element assignment.", d1.sym->name, 0);
	}
	d2 = Ft_pop();
	d3 = Ft_pop();
	index = (int)d3.val;
	if (index < 1 || index > d1.sym->size.val) {
		Ft_matherror("%s: Index %d out of range.", d1.sym->name, index);
	}
	d2.val = (d1.sym->u.vec[index] *= d2.val);
	Ft_push(d2);
}

Code Ft_edivassign(void)
{
	Datum d1, d2, d3;
	int index;
	extern int Ft_Check;

	CODE("edivassign");
	d1 = Ft_pop();
	if (d1.sym->type != VEC && d1.sym->type != PARAM) {
		if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC)
			Ft_matherror("%s: Unassigned vector.", d1.sym->name, 0);
		else
			Ft_matherror("%s: Illegal element assignment.", d1.sym->name, 0);
	}
	d2 = Ft_pop();
	if (d2.val == 0.0 && Ft_Check & INF_CHK) {
		Ft_matherror("%s: Division by zero.", d1.sym->name, 0);
	}
	d3 = Ft_pop();
	index = (int)d3.val;
	if (index < 1 || index > d1.sym->size.val) {
		Ft_matherror("%s: Index %d out of range.", d1.sym->name, index);
	}
	d2.val = (d1.sym->u.vec[index] /= d2.val);
	Ft_push(d2);
}

Code Ft_esubassign(void)
{
	Datum d1, d2, d3;
	int index;

	CODE("esubassign");
	d1 = Ft_pop();
	if (d1.sym->type != VEC && d1.sym->type != PARAM) {
		if (d1.sym->type == UNDEFVAR || d1.sym->type == UNDEFVEC)
			Ft_matherror("%s: Unassigned vector.", d1.sym->name, 0);
		else
			Ft_matherror("%s: Illegal element assignment.", d1.sym->name, 0);
	}
	d2 = Ft_pop();
	d3 = Ft_pop();
	index = (int)d3.val;
	if (index < 1 || index > d1.sym->size.val) {
		Ft_matherror("%s: Index %d out of range.", d1.sym->name, index);
	}
	d2.val = (d1.sym->u.vec[index] -= d2.val);
	Ft_push(d2);
}

Code Ft_breakit(void)
{
	CODE("breakit");
	Break = 1;
}

Code Ft_chkfunc(int type, Symbol *sp)
{
	if (sp->type == UNDEFVAR || sp->type == FUNCSYM || sp->type == PROCSYM) {
		sp->type = type;
	}
	else {
		Ft_matherror("%s: Symbol already defined and protected.", sp->name, 0);
	}
}

Code Ft_define(Symbol *sp)
{
	sp->u.defn = Ft_Progbase;
	Ft_Progbase = Ft_Progp;
}

Code Ft_call(void)
{
	Symbol *sp = (Symbol *)pc[0];
	Inst *pp;

	CODE("call");
	CODE(sp->name);
	if (frp++ >= &frame[NFRAME-1]) {
		 frp--;
		 Ft_matherror("%s: Call too deeply nested.", sp->name, 0);
	}
	frp->sp = sp;
	frp->nargs = (int)pc[1];
	PNUM(frp->nargs);
	frp->retpc = pc+2; /* return at second next address */
	frp->argn = stackp - 1;
	pp = checkargs(sp->u.defn, frp);
	Ft_execute(pp);
	Returning = 0;
}

Code Ft_boost(void)   /* a lot of self-consistency implied... */
{
	CODE("boost");
	PNUM((int)pc[0]);
	frp->nargs += (int) *pc++;
	frp->argn = stackp-1;
}

Code Ft_restore(void)
{
	CODE("restore");
	PNUM((int)pc[0]);
	cleanfrp((int)*pc++);
}

void Ft_cleanframe(void)
{
	while (frp != frame) {
		cleanfrp(ALL);
		frp--;
	}
}

static void cleanfrp(int num)
{
	Symbol *sp;

	if (num == ALL) {
		num = frp->nargs;
	}
	else if (num > frp->nargs) {
		Ft_matherror("Impossible condition in clean frame.", NULL, 0);
	}
	/******
	if (dp + 1 != stackp) {
		fprintf(stderr, "Inconsistent difference: %d\n", stackp-1-dp);
	}
	*******/
	while (num--) {
		frp->nargs--;
		frp->argn -= 2;
		switch ((int)frp->argn[2].val) {
		case NUMBER:
		case VEC:
		case PARAM:
		case STRVAR:
			break;
		case AUTOVEC:
			sp = (Symbol *) (int) frp->argn[1].val;
			free(sp->name);
			Ft_free_dvector(sp->u.vec, 1, sp->size.val);
			free((char *)sp);
			break;
		case AUTOSTRVAR:
			sp = (Symbol *) (int) frp->argn[1].val;
			free(sp->name);
			free(sp->u.str);
			free((char *)sp);
			break;
		default:
			Ft_matherror("Impossible case in cleanfrp.", NULL, 0);
		}
	}
}

Code Ft_pushnull(void)
{
	Datum d;

	CODE("pushnull");
	d.val = 0.0;
	Ft_push(d);
}

static void ret(void)
{
	CODE("ret");

	cleanfrp(ALL); /* clean stack of all auto variables, arguments...*/
	pc = (Inst *)frp->retpc;
	stackp = frp->argn + 1;
	frp--;
	Returning = 1;
}

Code Ft_funcret(void)
{
	Datum d;

	CODE("funcret");
	if (frp->sp->type == PROCSYM) {
		 Ft_matherror("%s: Procedure returning value!", frp->sp->name, 0);
	}
	d = Ft_pop();
	ret();
	Ft_push(d);
}

Code Ft_procret(void)
{
	CODE("procret");
	if (frp->sp->type == FUNCSYM) {
		Ft_matherror("%s: Function not returning value!", frp->sp->name, 0);
	}
	ret();
}

static double *getarg(void)
{
	int which;

	CODE("getarg");
	which = (int)*pc++;
	PNUM(which);
	if (which > frp->nargs) {
		Ft_matherror("%s: Not enough arguments.", frp->sp->name, 0);
	}
	return(&frp->argn[2*(which - frp->nargs) - 1].val);
}

Code Ft_argpush(void)
{
	Datum d;

	CODE("argpush");
	d.val = *getarg();
	Ft_push(d);
}

Code Ft_predargpush(void)
{
	Datum d;

	CODE("predargpush");
	d.val = (*getarg() -= 1.0);
	Ft_push(d);
}

Code Ft_preiargpush(void)
{
	Datum d;

	CODE("preiargpush");
	d.val = (*getarg() += 1.0);
	Ft_push(d);
}

Code Ft_postiargpush(void)
{
	Datum d;
	double *dp;

	CODE("postiargpush");
	dp = getarg();
	d.val = *dp;
	*dp += 1.0;
	Ft_push(d);
}

Code Ft_postdargpush(void)
{
	Datum d;
	double *dp;

	CODE("postiargpush");
	dp = getarg();
	d.val = *dp;
	*dp -= 1.0;
	Ft_push(d);
}

Code Ft_argassign(void)
{
	Datum d;

	CODE("argassign");
	d = Ft_pop();
	Ft_push(d);
	*getarg() = d.val;
}

Code Ft_argaddassign(void)
{
	Datum d;

	CODE("argaddassign");
	d = Ft_pop();
	d.val = (*getarg() += d.val);
	Ft_push(d);
}

Code Ft_argmulassign(void)
{
	Datum d;

	CODE("argmulassign");
	d = Ft_pop();
	d.val = (*getarg() *= d.val);
	Ft_push(d);
}

Code Ft_argsubassign(void)
{
	Datum d;

	CODE("argsubassign");
	d = Ft_pop();
	d.val = (*getarg() -= d.val);
	Ft_push(d);
}

Code Ft_argdivassign(void)
{
	Datum d;
	extern int Ft_Check;

	CODE("argdivassign");
	d = Ft_pop();
	if (d.val == 0.0 && Ft_Check & INF_CHK) {
		Ft_matherror("Division by zero.", NULL, 0);
	}
	d.val = (*getarg() /= d.val);
	Ft_push(d);
}

Code Ft_pushexprtype(void)
{
	Datum d;

	CODE("pushexprtype");
	d.val = NUMBER;
	Ft_push(d);
}

Code Ft_pushvectype(void)
{
	Datum d;

	CODE("pushvectype");
	d.val = VEC;
	Ft_push(d);
}

Code Ft_pushstrtype(void)
{
	Datum d;

	CODE("pushstrtype");
	d.val = STRVAR;
	Ft_push(d);
}

Code Ft_pushpartype(void)
{
	Datum d;

	CODE("pushpartype");
	d.val = PARAM;
	Ft_push(d);
}

Code Ft_pushavectype(void)
{
	Datum d;

	CODE("pushavectype");
	d.val = AUTOVEC;
	Ft_push(d);
}

Code Ft_pushastrtype(void)
{
	Datum d;

	CODE("pushastrtype");
	d.val = AUTOSTRVAR;
	Ft_push(d);
}

void Ft_defnonly(int type, char *string)
{
	switch(type) {
		case WHILE:
			if (Ft_Inbrace) return;
			Ft_matherror("`%s' used outside for or while loop.", string, 0);
			break;
		case FUNC:
			if (Ft_Indef) return;
			Ft_matherror("`%s' used outside function.", string, 0);
			break;
		case PROC:
			if (Ft_Indef) return;
			Ft_matherror("`%s' used outside procedure.", string, 0);
			break;
		default:
			Ft_matherror("Strange condition in chkfunc().", NULL, 0);
			break;
	}
}

Code Ft_argvarpush(void)
{
	Datum d;
	int which;

	CODE("argvarpush");
	which = (int)*pc++;
	d.sym = frp->argn[2*(which - frp->nargs) - 1].sym;
	CODE(d.sym->name);
	Ft_push(d);
}

Code Ft_strmake(void)
{
	Datum d;

	CODE("strmake");
	d.sym = Ft_geninstall("auto String", UNDEFSTRVAR, 0);
	Ft_push(d);
}

Code Ft_vecmake(void)
{
	Datum d;
	extern int Ft_Samples;

	CODE("vecmake");
	d.sym = Ft_geninstall("auto VEC", UNDEFVEC, Ft_Samples);
	Ft_push(d);
}

static Inst *checkargs(Inst *start, Frame *frpp)
{
	Datum *dp;
	int i, type, num;

	num = 0;
	while (start[num] != STOP) {
		num++;
	}
	if (num != frpp->nargs) {
		Ft_matherror("%s(): Argument number mismatch (%d required).",
		frpp->sp->name, num);
	}
	dp  = frpp->argn;  /* park it on the last type */
	start += num-1; /* park it on the last argument type */
	for (i=1-num; i<= 0; i++) {
		type = (int) dp[2*i].val;
		if (type != (int)start[i]) {
			Ft_matherror("%s(): Argument %d mismatch.", frpp->sp->name, (1-i));
		}
	}
	return(start+2);  /* skip the STOP */
}

void Ft_matherror(char *s1, char *s2, int lino)
{
	extern char Ft_Puffer[];

	fputs("Math error: ", stderr);
	fprintf(stderr, s1, s2, lino);
	fputc('\n', stderr);
	if (Index != ERRR)
		fprintf(stderr, "Error occurred at vector element %d.\n", Index);
	fprintf(stderr, "Command line: %s", Ft_Puffer);
	Ft_catcher(ERRR);
}

int Ft_showtable(void)
{
	FILE *fp;
	Symbol *sp, *Ft_Symlist(void);
	extern int Ft_Interact;
	extern char Ft_Pager[];
	extern FILE *popen(const char *, const char *);
	extern Datum *stack, *stackp;
	extern Frame *frame, *frp;
	extern Inst *prog;

	if (Ft_Interact && *Ft_Pager) {
		if ((fp = popen(Ft_Pager, "w")) == (FILE *)NULL)  {
			fprintf(stderr, "Could not open pager %s.\n", Ft_Pager);
			fp = stdout;
		}
	}
	else {
		fp = stdout;
	}

	fprintf(fp, "%12s%35s%10s\n", "Name", "Type", "Size");
	for (sp = Ft_Symlist(); sp != (Symbol *)0; sp = sp->next) {
		switch (sp->type) {
			case VEC:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "VEC", sp->size.val);
				break;
			case PARAM:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "PAR", sp->size.val);
				break;
			case BLTINSTRCONST:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "Bltin Str Constant", strlen(sp->u.str));
				break;
			case STRCONST:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "Str Constant", strlen(sp->u.str));
				break;
			case BLTINCONST:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "bltin constant", "1");
				break;
			case CONST:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "constant", "1");
				break;
			case BLTINVAR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "bltin variable", "1");
				break;
			case VAR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "variable", "1");
				break;
			case BLTINSTRVAR:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "Bltin Str Variable", sp->size.val);
				break;
			case STRVAR:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "Str Variable", sp->size.val);
				break;
			case BLTIN0STR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "Str Function(void)", "1");
				break;
			case BLTIN1STR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "Str Function(Str)", "1");
				break;
			case BLTIN2STR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "Str Function(Str, Str)", "1");
				break;
			case BLTIN0:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "function(void)", "1");
				break;
			case BLTIN1:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "function(expr)", "1");
				break;
			case BLTIN2:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "function(expr, expr)", "1");
				break;
			case STRBLTIN2:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "function(Str, Str)", "1");
				break;
			case EFUNCSYM:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, makename(sp), "1");
				break;
			case FUNCSYM:
				fprintf(fp, "%12s%35s%10s  from % 4d\n",
				sp->name, makename(sp), "1", sp->u.defn -prog);
				break;
			case EPROCSYM:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, makename(sp), "1");
				break;
			case PROCSYM:
				fprintf(fp, "%12s%35s%10s  from % 4d\n",
				sp->name, makename(sp), "1", sp->u.defn -prog);
				break;
			case UNDEFSTRVAR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "Unassigned Str Variable", "0");
				break;
			case UNDEFVAR:
				fprintf(fp, "%12s%35s%10s\n",
				sp->name, "unassigned variable", "1");
				break;
			case UNDEFVEC:
				fprintf(fp, "%12s%35s%10d\n",
				sp->name, "UNASSIGNED VEC", sp->size.val);
				break;
			default:
				/*** Why print keywords?
				fprintf(fp, "%12s%35s%10d\n", "Keyword", sp->size.val);
				***********/
				break;
		}
	}
	fprintf(fp,
	"\nactual: Stack: % 4d/%d,\tMachine: % 4d/%d,\tFrame: % 4d/%d\n",
	(stackp-stack), NSTACK, (Ft_Progp-prog), NPROG, (frp-frame), NFRAME);
	Ft_initcode();
	fprintf(fp,
	"reset:  Stack: % 4d/%d,\tMachine: % 4d/%d,\tFrame: % 4d/%d\n",
	(stackp-stack), NSTACK, (Ft_Progp-prog), NPROG, (frp-frame), NFRAME);
	if (fp != stdout) pclose(fp);
	return(0);
}

static char *makename(Symbol *sp)
{
	char *lp;
	static char arglist[256];
	int ext = 0;

	arglist[0] = '\0';
	switch (sp->type) {
		case EFUNCSYM:
			strcpy(arglist, " ext.");
			ext = 1;
		case FUNCSYM:
			strcat(arglist, " function(");
			break;
		case EPROCSYM:
			strcpy(arglist, " ext.");
			ext = 1;
		case PROCSYM:
			strcat(arglist, " procedure(");
			break;
		default:
			Ft_matherror("%s: Unknown function type %d.", "makename",
			sp->type);
			break;
	}
	if (ext) {
		char *cp;

		cp = sp->size.vals;
		while (*cp)   /* go at the end */
			cp++;

		while (--cp >= sp->size.vals) {  /* come back */
			switch (*cp) {
				case PROTO_VEC:
					strcat(arglist, "VEC, ");
					break;
				case PROTO_VAL:
					strcat(arglist, "expr, ");
					break;
				case PROTO_PAR:
					strcat(arglist, "PAR, ");
					break;
				case PROTO_STR:
					strcat(arglist, "Str, ");
					break;
				default:
					Ft_matherror("%s: Unknown case %d.", "makename", *cp);
					break;
			}
		}
	}
	else {
		Inst *pp = sp->u.defn;

		while (*pp != STOP) {
			switch ((int) *pp) {
				case VEC:
					strcat(arglist, "VEC, ");
					break;
				case NUMBER:
					strcat(arglist, "expr, ");
					break;
				case PARAM:
					strcat(arglist, "PAR, ");
					break;
				case STRVAR:
					strcat(arglist, "Str, ");
					break;
				default:
					Ft_matherror("%s: Unknown case %d.", "makename", (int)*pp);
					break;
			}
			pp++;
		}
	}
	lp = arglist + strlen(arglist) - 2;
	*lp++ = ')';
	*lp = '\0';

	return(arglist);
}

