#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"
#include "math.tab.h"
#include "fudgit.h"
#include "head.h"

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

#undef DEBUG

#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

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;
static Inst *prog;
static Inst *pc;
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;
}

#ifndef MACROPOP
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--;
}

#ifndef MACROPOP
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);
}