# include "comp.h"
# include "str.h"
# include "array.h"
# include "object.h"
# include "xfloat.h"
# include "interpret.h"
# include "data.h"
# include "hash.h"
# include "table.h"
# include "node.h"
# include "compile.h"
# include "control.h"

typedef struct _oh_ {		/* object hash table */
    hte chain;			/* hash table chain */
    object *obj;		/* object */
    short index;		/* -1: direct; 0: new; 1: indirect */
    struct _oh_ **next;		/* next in linked list */
} oh;

static hashtab *otab;		/* object hash table */
static oh **olist;		/* list of all object hash table entries */

/*
 * NAME:	oh->init()
 * DESCRIPTION:	initialize the object hash table
 */
static void oh_init()
{
    otab = ht_new(OMERGETABSZ, OBJHASHSZ);
}

/*
 * NAME:	oh->new()
 * DESCRIPTION:	put an object in the hash table
 */
static oh *oh_new(name)
char *name;
{
    register oh **h;

    h = (oh **) ht_lookup(otab, name, FALSE);
    if (*h == (oh *) NULL) {
	/*
	 * new object
	 */
	*h = ALLOC(oh, 1);
	(*h)->chain.next = (hte *) NULL;
	(*h)->chain.name = name;
	(*h)->index = 0;		/* new object */
	(*h)->next = olist;
	olist = h;
    }

    return *h;
}

/*
 * NAME:	oh->clear()
 * DESCRIPTION:	clear the object hash table
 */
static void oh_clear()
{
    register oh **h, *f;

    for (h = olist; h != (oh **) NULL; ) {
	f = *h;
	h = f->next;
	FREE(f);
    }
    olist = (oh **) NULL;

    if (otab != (hashtab *) NULL) {
	ht_del(otab);
	otab = (hashtab *) NULL;
    }
}


# define VFH_CHUNK	64

typedef struct _vfh_ {		/* variable/function hash table */
    hte chain;			/* hash table chain */
    string *str;		/* name string */
    oh *ohash;			/* controlling object hash table entry */
    unsigned short ct;		/* function call, or variable type */
    short index;		/* definition table index */
} vfh;

typedef struct _vfhchunk_ {
    vfh vf[VFH_CHUNK];		/* vfh chunk */
    struct _vfhchunk_ *next;	/* next in linked list */
} vfhchunk;

static vfhchunk *vfhclist;	/* linked list of all vfh chunks */
static int vfhchunksz = VFH_CHUNK; /* size of current vfh chunk */

/*
 * NAME:	vfh->new()
 * DESCRIPTION:	create a new vfh table element
 */
static void vfh_new(str, ohash, ct, idx, addr)
string *str;
oh *ohash;
unsigned short ct;
short idx;
vfh **addr;
{
    register vfh *h;

    if (vfhchunksz == VFH_CHUNK) {
	register vfhchunk *l;

	l = ALLOC(vfhchunk, 1);
	l->next = vfhclist;
	vfhclist = l;
	vfhchunksz = 0;
    }
    h = &vfhclist->vf[vfhchunksz++];
    h->chain.next = (hte *) *addr;
    *addr = h;
    h->chain.name = str->text;
    str_ref(h->str = str);
    h->ohash = ohash;
    h->ct = ct;
    h->index = idx;
}

/*
 * NAME:	vfh->clear()
 * DESCRIPTION:	clear the vfh tables
 */
static void vfh_clear()
{
    register vfhchunk *l, *f;
    register vfh *vf;

    for (l = vfhclist; l != (vfhchunk *) NULL; ) {
	for (vf = l->vf; vfhchunksz != 0; vf++, --vfhchunksz) {
	    str_del(vf->str);
	}
	vfhchunksz = VFH_CHUNK;
	f = l;
	l = l->next;
	FREE(f);
    }
    vfhclist = (vfhchunk *) NULL;
}


typedef struct _lab_ {
    string *str;		/* label */
    oh *ohash;			/* entry in hash table */
    struct _lab_ *next;		/* next label */
} lab;

static lab *labels;		/* list of labeled inherited objects */

/*
 * NAME:	lab->new()
 * DESCRIPTION:	declare a new inheritance label
 */
static void lab_new(str, ohash)
string *str;
oh *ohash;
{
    register lab *l;

    l = ALLOC(lab, 1);
    str_ref(l->str = str);
    l->ohash = ohash;
    l->next = labels;
    labels = l;
}

/*
 * NAME:	lab->find()
 * DESCRIPTION:	find a labeled object in the list
 */
static oh *lab_find(name)
char *name;
{
    register lab *l;

    for (l = labels; l != (lab *) NULL; l = l->next) {
	if (strcmp(l->str->text, name) == 0) {
	    return l->ohash;
	}
    }
    return (oh *) NULL;
}

/*
 * NAME:	lab->clear()
 * DESCRIPTION:	wipe out all inheritance label declarations
 */
static void lab_clear()
{
    register lab *l, *f;

    l = labels;
    while (l != (lab *) NULL) {
	str_del(l->str);
	f = l;
	l = l->next;
	FREE(f);
    }
    labels = (lab *) NULL;
}


/*
 * NAME:	cmp_proto()
 * DESCRIPTION:	Compare two prototypes. Return TRUE if equal.
 */
static bool cmp_proto(prot1, prot2)
register char *prot1, *prot2;
{
    register int i;

    /* check if either prototype is implicit */
    if (PROTO_FTYPE(prot1) == T_IMPLICIT || PROTO_FTYPE(prot2) == T_IMPLICIT) {
	return TRUE;
    }

    /* check if classes are equal */
    if ((PROTO_CLASS(prot1) ^ PROTO_CLASS(prot2)) &
	UCHAR(~(C_COMPILED | C_UNDEFINED))) {
	return FALSE;
    }

    /* compare return type */
    if (PROTO_FTYPE(prot1) != PROTO_FTYPE(prot2)) {
	return FALSE;
    }

    /* check if the number of arguments is equal */
    if ((i=PROTO_NARGS(prot1)) != PROTO_NARGS(prot2)) {
	return FALSE;
    }

    /* compare argument types */
    for (prot1 = PROTO_ARGS(prot1), prot2 = PROTO_ARGS(prot2); i > 0; --i) {
	if (*prot1++ != *prot2++) {
	    return FALSE;
	}
    }

    return TRUE;	/* equal */
}


# define MAX_INHERITS		255

static oh *directs[MAX_INHERITS];	/* direct inherit table */
static int ndirects;			/* # directly inh. objects */
static int ninherits;			/* # inherited objects */
static hashtab *vtab;			/* variable merge table */
static hashtab *ftab;			/* function merge table */
static unsigned short nvars;		/* # variables */
static unsigned short nfloats;		/* # float variables */
static unsigned short nsymbs;		/* # symbols */
static int nfclash;			/* # prototype clashes */
static Uint nifcalls;			/* # inherited function calls */

/*
 * NAME:	control->init()
 * DESCRIPTION:	initialize control block construction
 */
void ctrl_init()
{
    oh_init();
    vtab = ht_new(VFMERGETABSZ, VFMERGEHASHSZ);
    ftab = ht_new(VFMERGETABSZ, VFMERGEHASHSZ);
}

/*
 * NAME:	control->vardefs()
 * DESCRIPTION:	put variable definitions from an inherited object into the
 *		variable merge table
 */
static void ctrl_vardefs(ohash, ctrl)
oh *ohash;
register control *ctrl;
{
    register dvardef *v;
    register int n;
    register string *str;
    register vfh **h;

    v = d_get_vardefs(ctrl);
    for (n = 0; n < ctrl->nvardefs; n++) {
	if (v->type == T_FLOAT) {
	    nfloats++;	/* inherited float variable */
	}
	/*
	 * Add only non-private variables, and check if a variable with the
	 * same name hasn't been inherited already.
	 */
	if (!(v->class & C_PRIVATE)) {
	    str = d_get_strconst(ctrl, v->inherit, v->index);
	    h = (vfh **) ht_lookup(vtab, str->text, FALSE);
	    if (*h == (vfh *) NULL) {
		/* new variable */
		vfh_new(str, ohash, v->type, n, h);
	    } else {
	       /* duplicate variable */
	       c_error("multiple inheritance of variable %s (/%s, /%s)",
		       str->text, (*h)->ohash->chain.name, ohash->chain.name);
	    }
	}
	v++;
    }
}

/*
 * NAME:	control->funcdef()
 * DESCRIPTION:	put a function definition from an inherited object into
 *		the function merge table
 */
static void ctrl_funcdef(ctrl, idx, ohash)
register control *ctrl;
register int idx;
oh *ohash;
{
    register vfh **h, **l;
    register dfuncdef *f;
    string *str;

    f = &ctrl->funcdefs[idx];
    str = d_get_strconst(ctrl, f->inherit, f->index);
    h = (vfh **) ht_lookup(ftab, str->text, FALSE);
    if (*h == (vfh *) NULL) {
	/*
	 * New function (-1: no calls to it yet)
	 */
	vfh_new(str, ohash, -1, idx, h);
	if (ctrl->ninherits != 1 ||
	    (f->class & (C_STATIC | C_UNDEFINED)) != C_STATIC) {
	    /* don't count static functions from the auto object */
	    nsymbs++;
	}
    } else if ((*h)->ohash != ohash) {
	register dinherit *inh;
	register int n;
	object *o;
	char *prot1, *prot2;
	vfh **marker;

	/*
	 * Different prototypes.
	 */
	if ((*h)->ohash == (oh *) NULL) {
	    /*
	     * Skip old clash marker.
	     */
	    marker = h;
	    h = (vfh **) &(*h)->chain.next;
	} else {
	    marker = (vfh **) NULL;
	}

	prot1 = ctrl->prog + f->offset;
	/*
	 * compare with the other prototypes
	 */
	for (l = h;
	     *l != (vfh *) NULL && strcmp((*l)->chain.name, str->text) == 0;
	     l = (vfh **) &(*l)->chain.next) {
	    /*
	     * First check if the function in the merge table is in
	     * an object inherited by the currently inherited object.
	     */
	    o = (*l)->ohash->obj;
	    ctrl = ohash->obj->ctrl;
	    inh = ctrl->inherits;
	    n = ctrl->ninherits;
	    ctrl = o->ctrl;
	    while (--n != 0) {
		if (o == inh->obj) {
		    /*
		     * redefined inherited function
		     */
		    if (marker == (vfh **) NULL && ctrl->ninherits == 1 &&
			(ctrl->funcdefs[(*l)->index].class &
				  (C_STATIC | C_UNDEFINED)) == C_STATIC) {
			/*
			 * redefine static function in auto object
			 */
			nsymbs++;
		    }
		    (*l)->ohash = ohash;
		    (*l)->index = idx;
		    return;
		}
		inh++;
	    }

	    /*
	     * Now check if the function in the currently inherited object is
	     * inherited by the object that defines the function in the merge
	     * table.
	     */
	    o = inh->obj;
	    inh = ctrl->inherits;
	    n = ctrl->ninherits;
	    while (--n != 0) {
		if (o == inh->obj) {
		    /*
		     * previously inherited, and redefined function
		     */
		    return;
		}
		inh++;
	    }

	    /*
	     * Check for clashes between the prototypes.
	     */
	    prot2 = ctrl->prog + ctrl->funcdefs[(*l)->index].offset;
	    if (((f->class | PROTO_CLASS(prot2)) & (C_NOMASK | C_UNDEFINED)) ==
								    C_NOMASK) {
		/*
		 * a nomask function is inherited more than once
		 */
		c_error("multiple inheritance of nomask function %s (/%s, /%s)",
			str->text, (*l)->ohash->chain.name, ohash->chain.name);
		return;
	    }
	    if (((f->class | PROTO_CLASS(prot2)) & C_UNDEFINED) &&
		!cmp_proto(prot1, prot2)) {
		/*
		 * prototype conflict
		 */
		c_error("unequal prototypes for function %s (/%s, /%s)",
			str->text, (*l)->ohash->chain.name, ohash->chain.name);
		return;
	    }
	}

	ctrl = (*h)->ohash->obj->ctrl;
	prot2 = ctrl->prog + ctrl->funcdefs[(*h)->index].offset;
	if (PROTO_CLASS(prot2) & C_UNDEFINED) {
	    /*
	     * replace undefined function
	     */
	    vfh_new(str, ohash, -1, idx, h);
	    return;
	}
	if (f->class & C_UNDEFINED) {
	    /*
	     * add undefined prototype at the end
	     */
	    vfh_new(str, ohash, -1, idx, l);
	    return;
	}

	if (marker != (vfh **) NULL) {
	    /*
	     * replace clash marker with function
	     */
	    h = marker;
	    (*h)->ohash = ohash;
	    (*h)->ct = -1;
	    (*h)->index = idx;
	} else {
	    /*
	     * first clash: insert before old prototype
	     */
	    nfclash++;
	    vfh_new(str, ohash, -1, idx, h);
	}

	/* insert new clash marker */
	vfh_new(str, (oh *) NULL, 0, 0, h);
    }
}

/*
 * NAME:	control->funcdefs()
 * DESCRIPTION:	put function definitions from an inherited object into
 *		the function merge table
 */
static void ctrl_funcdefs(ctrl)
register control *ctrl;
{
    register unsigned short n;
    register object *o;
    register dsymbol *symb;

    /*
     * The symbol table rather than the function definition table is
     * used here.
     */
    for (n = ctrl->nsymbols, symb = d_get_symbols(ctrl); n > 0; --n, symb++) {
	o = ctrl->inherits[UCHAR(symb->inherit)].obj;
	ctrl_funcdef(o->ctrl, UCHAR(symb->index), oh_new(o->chain.name));
    }
}

/*
 * NAME:	control->inherit()
 * DESCRIPTION:	inherit an object
 */
bool ctrl_inherit(f, from, obj, label)
register frame *f;
char *from;
object *obj;
string *label;
{
    register oh *ohash;

    if (!(obj->flags & O_MASTER)) {
	c_error("cannot inherit cloned object");
	return TRUE;
    }
    if (O_UPGRADING(obj)) {
	c_error("cannot inherit object being upgraded");
	return TRUE;
    }

    ohash = oh_new(obj->chain.name);
    if (label != (string *) NULL) {
	/*
	 * use a label
	 */
	if (lab_find(label->text) != (oh *) NULL) {
	    c_error("redeclaration of label %s", label->text);
	}
	lab_new(label, ohash);
    }

    if (ohash->index == 0) {
	register control *ctrl;
	register object *o;
	dinherit *inh;
	register int i, n;

	/*
	 * new inherited object
	 */
	ctrl = o_control(obj);
	inh = ctrl->inherits;
	if (ndirects != 0 && strcmp(inh->obj->chain.name,
				    directs[0]->obj->chain.name) != 0) {
	    c_error("inherited different auto objects");
	}
	for (i = ctrl->ninherits; i > 0; --i) {
	    /*
	     * check all the objects inherited by the object now inherited
	     */
	    o = (inh++)->obj;
	    if (o->count == 0) {
		Uint ocount;

		if (strcmp(o->chain.name, from) == 0) {
		    /*
		     * inheriting old instance of the same object
		     */
		    c_error("cycle in inheritance");
		    return TRUE;
		}

		/*
		 * This object inherits an object that has been destructed.
		 * Give the driver object a chance to destruct it.
		 */
		(--f->sp)->type = T_OBJECT;
		f->sp->oindex = obj->index;
		f->sp->u.objcnt = ocount = obj->count;
		call_driver_object(f, "recompile", 1);
		i_del_value(f->sp++);
		if (obj->count != ocount) {
		    return FALSE;	/* recompile this object */
		}
	    }

	    ohash = oh_new(o->chain.name);
	    if (ohash->index == 0) {
		/*
		 * inherit a new object
		 */
		ohash->obj = o;
		ohash->index = 2;	/* indirect */
		ctrl = o_control(o);

		/*
		 * put variables in variable merge table
		 */
		ctrl_vardefs(ohash, ctrl);
		/*
		 * ensure that relevant parts are loaded
		 */
		d_get_prog(ctrl);
		d_get_funcdefs(ctrl);
	    } else if (ohash->obj != o) {
		/*
		 * inherited two different objects with same name
		 */
		c_error("inherited different instances of /%s",
			o->chain.name);
		return TRUE;
	    } else if (ohash->index < 0 && !(ohash->obj->flags & O_AUTO)) {
		/*
		 * Inherit an object which previously was inherited
		 * directly (but is not the auto object). Mark it as
		 * indirect now.
		 */
		ohash->index = 1;	/* indirect, but immediate */
		n = ohash->obj->ctrl->ninherits - 1;
		ninherits -= n;
	    }
	}

	n = ctrl->ninherits;
	if (n > 1) {
	    /*
	     * Don't count the auto object, unless it is the auto object
	     * only.
	     */
	    --n;
	}
	ninherits += n;
	directs[ndirects++] = ohash;
	ohash->index = -1;	/* direct */

	/*
	 * put functions in function merge table
	 */
	ctrl_funcdefs(ctrl);

    } else if (ohash->obj != obj) {
	/*
	 * inherited two objects with same name
	 */
	c_error("inherited different instances of /%s", obj->chain.name);
    } else if (ohash->index == 2) {
	/* not inherited directly before */
	directs[ndirects++] = ohash;
	ohash->index = 1;	/* indirect, but immediate */
    }

    if (ninherits >= MAX_INHERITS || ndirects == MAX_INHERITS) {
	c_error("too many objects inherited");
    }

    return TRUE;
}


# define STRING_CHUNK	64

typedef struct _strchunk_ {
    string *s[STRING_CHUNK];		/* chunk of strings */
    struct _strchunk_ *next;		/* next in string chunk list */
} strchunk;

# define FCALL_CHUNK	64

typedef struct _fcchunk_ {
    char *f[FCALL_CHUNK];		/* function reference */
    struct _fcchunk_ *next;		/* next in fcall chunk list */
} fcchunk;

typedef struct _cfunc_ {
    dfuncdef func;			/* function name/type */
    char *name;				/* function name */
    char *proto;			/* function prototype */
    char *prog;				/* function program */
    unsigned short progsize;		/* function program size */
} cfunc;

static control *newctrl;		/* the new control block */
static oh *newohash;			/* fake ohash entry for new object */
static strchunk *str_list;		/* list of string chunks */
static int strchunksz = STRING_CHUNK;	/* size of current string chunk */
static Uint nstrs;			/* # of strings in all string chunks */
static fcchunk *fclist;			/* list of fcall chunks */
static int fcchunksz = FCALL_CHUNK;	/* size of current fcall chunk */
static cfunc *functions;		/* defined functions table */
static int nfdefs, fdef;		/* # defined functions, current func */
static Uint progsize;			/* size of all programs and protos */
static dvardef *variables;		/* defined variables */
static Uint nfcalls;			/* # function calls */

/*
 * NAME:	control->create()
 * DESCRIPTION:	make an initial control block
 */
void ctrl_create()
{
    register dinherit *new;
    register control *ctrl;
    register unsigned short n;
    register int i, count;

    /*
     * create a new control block
     */
    newohash = oh_new("/");		/* unique name */
    newohash->index = count = ninherits;
    newctrl = d_new_control();
    new = newctrl->inherits = ALLOC(dinherit, newctrl->ninherits = count + 1);
    new += count;
    nvars = 0;

    if (ninherits > 0) {
	/*
	 * initialize the virtually inherited objects
	 */
	for (n = ndirects; n > 0; ) {
	    register oh *ohash;
	    register dinherit *old;

	    ohash = directs[--n];
	    if (ohash->index < 0) {		/* directly inherited */
		ctrl = ohash->obj->ctrl;
		i = ctrl->ninherits - 1;
		old = ctrl->inherits + i;
		/*
		 * do this ctrl->ninherits - 1 times, but at least once
		 */
		do {
		    ohash = oh_new(old->obj->chain.name);
		    --old;
		    (--new)->obj = ohash->obj;
		    ohash->index = --count;	/* may happen more than once */
		} while (--i > 0);
	    }
	}

	/*
	 * Fix function offsets and variable offsets, and collect all string
	 * constants from inherited objects and put them in the string merge
	 * table.
	 */
	for (count = 0; count < ninherits; count++) {
	    i = oh_new(new->obj->chain.name)->index;
	    if (i == count) {
		ctrl = new->obj->ctrl;
		i = ctrl->ninherits - 1;
		new->funcoffset = nifcalls;
		n = ctrl->nfuncalls - ctrl->inherits[i].funcoffset;
		nifcalls += n;
		if (nifcalls > UINDEX_MAX && nifcalls - n <= UINDEX_MAX) {
		    c_error("inherited too many function calls");
		}
		new->varoffset = nvars;
		nvars += ctrl->nvardefs;

		for (n = ctrl->nstrings; n > 0; ) {
		    --n;
		    str_put(d_get_strconst(ctrl, i, n),
			    ((Uint) count << 16) | n);
		}
	    } else {
		new->funcoffset = newctrl->inherits[i].funcoffset;
		new->varoffset = newctrl->inherits[i].varoffset;
	    }
	    new++;
	}
    }

    /*
     * stats for new object
     */
    new->obj = (object *) NULL;
    new->funcoffset = nifcalls;
    new->varoffset = newctrl->nvariables = nvars;
    newctrl->nfloats = nfloats;

    /*
     * prepare for construction of a new control block
     */
    functions = ALLOC(cfunc, 256);
    variables = ALLOC(dvardef, 256);
    progsize = 0;
    nstrs = 0;
    nfdefs = 0;
    nvars = 0;
    nfcalls = 0;
    nfloats = 0;
}

/*
 * NAME:	control->dstring()
 * DESCRIPTION:	define a new (?) string constant
 */
long ctrl_dstring(str)
string *str;
{
    register Uint desc, new;

    desc = str_put(str, new = ((Uint) ninherits << 16) | nstrs);
    if (desc == new) {
	/*
	 * it is really a new string
	 */
	if (strchunksz == STRING_CHUNK) {
	    register strchunk *l;

	    l = ALLOC(strchunk, 1);
	    l->next = str_list;
	    str_list = l;
	    strchunksz = 0;
	}
	str_ref(str_list->s[strchunksz++] = str);
	if (nstrs == USHRT_MAX) {
	    c_error("too many string constants");
	}
	nstrs++;
    }
    if (desc >> 16 == ninherits) {
	desc |= 0x01000000L;	/* mark it as new */
    }
    return desc;
}

/*
 * NAME:	control->dproto()
 * DESCRIPTION:	define a new function prototype
 */
void ctrl_dproto(str, proto)
register string *str;
register char *proto;
{
    register vfh **h;
    register dfuncdef *func;
    register int i;
    long s;

    i = -1;	/* default: no calls yet */

    /* first check if prototype exists already */
    h = (vfh **) ht_lookup(ftab, str->text, FALSE);
    if (*h != (vfh *) NULL) {
	register char *proto2;
	register control *ctrl;

	/*
	 * redefinition
	 */
	if ((*h)->ohash == newohash) {
	    /*
	     * redefinition of new function
	     */
	    proto2 = functions[(*h)->index].proto;
	    if (!((PROTO_CLASS(proto) | PROTO_CLASS(proto2)) & C_UNDEFINED)) {
		/*
		 * both prototypes are from functions
		 */
		c_error("multiple declaration of function %s", str->text);
	    } else if (!cmp_proto(proto, proto2)) {
		if ((PROTO_CLASS(proto) ^ PROTO_CLASS(proto2)) & C_UNDEFINED) {
		    /*
		     * declaration does not match prototype
		     */
		    c_error("declaration does not match prototype of %s",
			    str->text);
		} else {
		    /*
		     * unequal prototypes
		     */
		    c_error("unequal prototypes for function %s", str->text);
		}
	    } else if (!(PROTO_CLASS(proto) & C_UNDEFINED) ||
		       PROTO_FTYPE(proto2) == T_IMPLICIT) {
		/*
		 * replace undefined prototype
		 */
		if (PROTO_FTYPE(proto2) == T_IMPLICIT &&
		    (PROTO_CLASS(proto) & C_PRIVATE)) {
		    /* private function replaces implicit prototype */
		    --nsymbs;
		}
		i = PROTO_SIZE(proto);
		progsize += i - PROTO_SIZE(proto2);
		functions[fdef = (*h)->index].proto =
			(char *) memcpy(REALLOC(proto2, char, 0, i), proto, i);
		functions[fdef].func.class = PROTO_CLASS(proto);
	    }
	    return;
	}

	/*
	 * redefinition of inherited function
	 */
	if ((*h)->ohash == (oh *) NULL) {
	    if (!(PROTO_CLASS(proto) & C_PRIVATE)) {
		/*
		 * mask inherited functions
		 */
		--nfclash;
	    }
	} else {
	    ctrl = (*h)->ohash->obj->ctrl;
	    proto2 = ctrl->prog + ctrl->funcdefs[(*h)->index].offset;
	    if ((PROTO_CLASS(proto2) & C_UNDEFINED) &&
		!cmp_proto(proto, proto2)) {
		/*
		 * declaration does not match inherited prototype
		 */
		c_error("inherited different prototype for %s (/%s)",
			str->text, (*h)->ohash->chain.name);
	    } else if ((PROTO_CLASS(proto) & C_UNDEFINED) &&
		       PROTO_FTYPE(proto2) != T_IMPLICIT &&
		       cmp_proto(proto, proto2)) {
		/*
		 * there is no point in replacing an identical prototype
		 */
		return;
	    } else if ((PROTO_CLASS(proto2) & (C_NOMASK | C_UNDEFINED)) ==
								    C_NOMASK) {
		/*
		 * attempt to redefine nomask function
		 */
		c_error("redeclaration of nomask function %s (/%s)",
			str->text, (*h)->ohash->chain.name);
	    }

	    if (!(PROTO_CLASS(proto) & C_PRIVATE) && ctrl->ninherits == 1 &&
		(PROTO_CLASS(proto2) & (C_STATIC | C_UNDEFINED)) == C_STATIC) {
		/*
		 * replace static function in auto object by non-private
		 * function
		 */
		nsymbs++;
	    }
	    i = (*h)->ct;	/* take old call index */
	}
	/*
	 * insert the definition before the old one in the hash table
	 */
    } else if (!(PROTO_CLASS(proto) & C_PRIVATE)) {
	/*
	 * add new prototype to symbol table
	 */
	nsymbs++;
    }

    if (nfdefs == 255) {
	c_error("too many functions declared");
	return;
    }

    /*
     * Actual definition.
     */
    vfh_new(str, newohash, i, nfdefs, h);
    s = ctrl_dstring(str);
    i = PROTO_SIZE(proto);
    functions[nfdefs].name = str->text;
    functions[nfdefs].proto = (char *) memcpy(ALLOC(char, i), proto, i);
    functions[nfdefs].progsize = 0;
    progsize += i;
    func = &functions[nfdefs++].func;
    func->class = PROTO_CLASS(proto);
    func->inherit = s >> 16;
    func->index = s;
}

/*
 * NAME:	control->dfunc()
 * DESCRIPTION:	define a new function
 */
void ctrl_dfunc(str, proto)
string *str;
char *proto;
{
    fdef = nfdefs;
    ctrl_dproto(str, proto);
}

/*
 * NAME:	control->dprogram()
 * DESCRIPTION:	define a function body
 */
void ctrl_dprogram(prog, size)
char *prog;
unsigned int size;
{
    functions[fdef].prog = prog;
    functions[fdef].progsize = size;
    progsize += size;
}

/*
 * NAME:	control->dvar()
 * DESCRIPTION:	define a variable
 */
void ctrl_dvar(str, class, type)
string *str;
unsigned int class, type;
{
    register vfh **h;
    register dvardef *var;
    register long s;

    h = (vfh **) ht_lookup(vtab, str->text, FALSE);
    if (*h != (vfh *) NULL) {
	if ((*h)->ohash == newohash) {
	    c_error("redeclaration of variable %s", str->text);
	    return;
	} else if (!(class & C_PRIVATE)) {
	    /*
	     * non-private redeclaration of a variable
	     */
	    c_error("redeclaration of variable %s (/%s)", str->text,
		    (*h)->ohash->chain.name);
	    return;
	}
    }
    if (nvars == 255) {
	c_error("too many variables declared");
	return;
    }

    /* actually define the variable */
    vfh_new(str, newohash, type, nvars, h);
    s = ctrl_dstring(str);
    var = &variables[nvars++];
    var->class = class;
    var->inherit = s >> 16;
    var->index = s;
    var->type = type;

    if (type == T_FLOAT) {
	nfloats++;
    }
}

/*
 * NAME:	control->ifcall()
 * DESCRIPTION:	call an inherited function
 */
char *ctrl_ifcall(str, label, call)
string *str;
char *label;
long *call;
{
    register control *ctrl;
    register oh *ohash;
    register short index;
    short inherit;

    if (label != (char *) NULL) {
	register dsymbol *symb;

	/* first check if the label exists */
	ohash = lab_find(label);
	if (ohash == (oh *) NULL) {
	    c_error("undefined label %s", label);
	    return (char *) NULL;
	}
	inherit = ohash->index;
	symb = ctrl_symb(ctrl = ohash->obj->ctrl, str->text, str->len);
	if (symb == (dsymbol *) NULL) {
	    /*
	     * It may seem strange to allow label::kfun, but remember that they
	     * are supposed to be inherited in the auto object.
	     */
	    index = kf_func(str->text);
	    if (index >= 0) {
		/* kfun call */
		*call = ((long) KFCALL << 24) | index;
		return KFUN(index).proto;
	    }
	    c_error("undefined function %s::%s", label, str->text);
	    return (char *) NULL;
	}
	ohash = oh_new(ctrl->inherits[UCHAR(symb->inherit)].obj->chain.name);
	index = UCHAR(symb->index);
    } else {
	register vfh *h;

	/* check if the function exists */
	inherit = ninherits;
	h = *(vfh **) ht_lookup(ftab, str->text, FALSE);
	if (h == (vfh *) NULL || (h->ohash == newohash &&
	    ((h=(vfh *) h->chain.next) == (vfh *) NULL ||
	     strcmp(h->chain.name, str->text) != 0))) {

	    index = kf_func(str->text);
	    if (index >= 0) {
		/* kfun call */
		*call = ((long) KFCALL << 24) | index;
		return KFUN(index).proto;
	    }
	    c_error("undefined function ::%s", str->text);
	    return (char *) NULL;
	}
	ohash = h->ohash;
	if (ohash == (oh *) NULL) {
	    /*
	     * call to multiple inherited function
	     */
	    c_error("ambiguous call to function ::%s", str->text);
	    return (char *) NULL;
	}
	index = h->index;
	label = "";
    }

    ctrl = ohash->obj->ctrl;
    if (ctrl->funcdefs[index].class & C_UNDEFINED) {
	c_error("undefined function %s::%s", label, str->text);
	return (char *) NULL;
    }
    inherit = (ohash->index == 0) ? 0 : ninherits + 1 - ohash->index;
    *call = ((long) DFCALL << 24) | ((long) inherit << 8) | index;
    return ctrl->prog + ctrl->funcdefs[index].offset;
}

/*
 * NAME:	control->fcall()
 * DESCRIPTION:	call a function
 */
char *ctrl_fcall(str, call, typechecking)
string *str;
long *call;
int typechecking;
{
    register vfh *h;
    char *proto;

    h = *(vfh **) ht_lookup(ftab, str->text, FALSE);
    if (h == (vfh *) NULL) {
	static char uproto[] = { (char) C_UNDEFINED, T_IMPLICIT, 0 };
	register short kf;

	/*
	 * undefined function
	 */
	kf = kf_func(str->text);
	if (kf >= 0) {
	    /* kfun call */
	    *call = ((long) KFCALL << 24) | kf;
	    return KFUN(kf).proto;
	}

	/* create an undefined prototype for the function */
	if (nfdefs == 255) {
	    c_error("too many undefined functions");
	    return (char *) NULL;
	}
	ctrl_dproto(str, proto = uproto);
	h = *(vfh **) ht_lookup(ftab, str->text, FALSE);
    } else if (h->ohash == newohash) {
	/*
	 * call to new function
	 */
	proto = functions[h->index].proto;
    } else if (h->ohash == (oh *) NULL) {
	/*
	 * call to multiple inherited function
	 */
	c_error("ambiguous call to function %s", str->text);
	return (char *) NULL;
    } else {
	register control *ctrl;

	/*
	 * call to inherited function
	 */
	ctrl = h->ohash->obj->ctrl;
	proto = ctrl->prog + ctrl->funcdefs[h->index].offset;
    }

    if (typechecking && PROTO_FTYPE(proto) == T_IMPLICIT) {
	/* don't allow calls to implicit prototypes when typechecking */
	c_error("undefined function %s", str->text);
	return (char *) NULL;
    }

    if ((PROTO_CLASS(proto) & C_PRIVATE) ||
	(PROTO_CLASS(proto) & (C_NOMASK | C_UNDEFINED)) == C_NOMASK ||
	((PROTO_CLASS(proto) & (C_STATIC | C_UNDEFINED)) == C_STATIC &&
	 h->ohash->index == 0)) {
	/* direct call */
	if (h->ohash->index == 0) {
	    *call = ((long) DFCALL << 24) | h->index;
	} else {
	    *call = ((long) DFCALL << 24) |
		    ((ninherits + 1L - h->ohash->index) << 8) |
		    h->index;
	}
    } else {
	/* ordinary function call */
	*call = ((long) FCALL << 24) | ((long) h->ohash->index << 8) | h->index;
    }
    return proto;
}

/*
 * NAME:	control->gencall()
 * DESCRIPTION:	generate a function call
 */
unsigned short ctrl_gencall(call)
long call;
{
    register vfh *h;
    char *name;
    short inherit, index;

    inherit = (call >> 8) & 0xff;
    index = call & 0xff;
    if (inherit == ninherits) {
	name = functions[index].name;
    } else {
	control *ctrl;
	dfuncdef *f;

	ctrl = newctrl->inherits[inherit].obj->ctrl;
	f = ctrl->funcdefs + index;
	name = d_get_strconst(ctrl, f->inherit, f->index)->text;
    }
    h = *(vfh **) ht_lookup(ftab, name, FALSE);
    if (h->ct == (unsigned short) -1) {
	/*
	 * add to function call table
	 */
	if (fcchunksz == FCALL_CHUNK) {
	    register fcchunk *l;

	    l = ALLOC(fcchunk, 1);
	    l->next = fclist;
	    fclist = l;
	    fcchunksz = 0;
	}
	fclist->f[fcchunksz++] = name;
	if (nifcalls + nfcalls == UINDEX_MAX) {
	    c_error("too many function calls");
	}
	h->ct = nfcalls++;
    }
    return h->ct;
}

/*
 * NAME:	control->var()
 * DESCRIPTION:	handle a variable reference
 */
unsigned short ctrl_var(str, ref)
string *str;
long *ref;
{
    register vfh *h;

    /* check if the variable exists */
    h = *(vfh **) ht_lookup(vtab, str->text, TRUE);
    if (h == (vfh *) NULL) {
	c_error("undeclared variable %s", str->text);
	if (nvars < 255) {
	    /* don't repeat this error */
	    ctrl_dvar(str, 0, T_MIXED);
	}
	return T_MIXED;
    }

    if (h->ohash->index == 0 && ninherits != 0) {
	*ref = h->index;
    } else {
	*ref = ((ninherits + 1L - h->ohash->index) << 8) | h->index;
    }
    return h->ct;	/* the variable type */
}


/*
 * NAME:	control->chkfuncs()
 * DESCRIPTION:	check for multiple function definitions
 */
bool ctrl_chkfuncs()
{
    if (nfclash != 0) {
	register hte **t;
	register unsigned short sz;
	register vfh *f, *n;

	c_error("inherited multiple instances of:");
	for (t = ftab->table, sz = ftab->size; nfclash > 0 && sz > 0; t++, --sz)
	{
	    for (f = (vfh *) *t; f != NULL; f = n) {
		n = (vfh *) f->chain.next;
		if (f->ohash == (oh *) NULL) {
		    /*
		     * list a clash (only the first two)
		     */
		    c_error("  %s (/%s, %s)", f->chain.name,
			    n->ohash->chain.name,
			    ((vfh *) n->chain.next)->ohash->chain.name);
		    --nfclash;
		} else if (n != (vfh *) NULL && n->ohash == (oh *) NULL &&
			   strcmp(n->str->text, f->str->text) == 0 &&
			   !(PROTO_CLASS(functions[f->index].proto) &C_PRIVATE))
		{
		    /*
		     * this function was redefined, and must not be listed
		     */
		    n = (vfh *) n->chain.next;
		}
	    }
	}
	return FALSE;
    }
    return TRUE;
}


/*
 * NAME:	control->mkstrings()
 * DESCRIPTION:	create the string table for the new control block
 */
static void ctrl_mkstrings()
{
    register string **s;
    register strchunk *l, *f;
    register unsigned short i;
    register long strsize;

    strsize = 0;
    if ((newctrl->nstrings = nstrs) != 0) {
	newctrl->strings = ALLOC(string*, newctrl->nstrings);
	s = newctrl->strings + nstrs;
	i = strchunksz;
	for (l = str_list; l != (strchunk *) NULL; ) {
	    while (i > 0) {
		*--s = l->s[--i];	/* already referenced */
		strsize += (*s)->len;
	    }
	    i = STRING_CHUNK;
	    f = l;
	    l = l->next;
	    FREE(f);
	}
	str_list = (strchunk *) NULL;
	strchunksz = i;
    }
    newctrl->strsize = strsize;
}

/*
 * NAME:	control->mkfuncs()
 * DESCRIPTION:	make the function definition table for the control block
 */
static void ctrl_mkfuncs()
{
    register char *p;
    register dfuncdef *d;
    register cfunc *f;
    register int i;
    register unsigned int len;

    newctrl->progsize = progsize;
    if ((newctrl->nfuncdefs = nfdefs) != 0) {
	p = newctrl->prog = ALLOC(char, progsize);
	d = newctrl->funcdefs = ALLOC(dfuncdef, nfdefs);
	f = functions;
	for (i = nfdefs; i > 0; --i) {
	    *d = f->func;
	    d->offset = p - newctrl->prog;
	    memcpy(p, f->proto, len = PROTO_SIZE(f->proto));
	    p += len;
	    if (f->progsize != 0) {
		/* more than just a prototype */
		memcpy(p, f->prog, f->progsize);
		p += f->progsize;
	    }
	    d++;
	    f++;
	}
    }
}

/*
 * NAME:	control->mkvars()
 * DESCRIPTION:	make the variable definition table for the control block
 */
static void ctrl_mkvars()
{
    if ((newctrl->nvardefs = nvars) != 0) {
	newctrl->vardefs = ALLOC(dvardef, nvars);
	memcpy(newctrl->vardefs, variables, nvars * sizeof(dvardef));
    }
}

/*
 * NAME:	control->mkfcalls()
 * DESCRIPTION:	make the function call table for the control block
 */
static void ctrl_mkfcalls()
{
    register char *fc;
    register int i;
    register vfh *h;
    register fcchunk *l;

    newctrl->nfuncalls = nifcalls + nfcalls;
    if (newctrl->nfuncalls == 0) {
	return;
    }
    fc = newctrl->funcalls = ALLOC(char, 2 * newctrl->nfuncalls);
    for (i = 0; i < ninherits; i++) {
	/*
	 * Walk through the list of inherited objects, starting with the auto
	 * object, and fill in the function call table segment for each object
	 * once.
	 */
	if (oh_new(newctrl->inherits[i].obj->chain.name)->index == i) {
	    register char *ofc;
	    register dfuncdef *f;
	    register control *ctrl, *ctrl2;
	    register uindex j, n;

	    /*
	     * build the function call segment, based on the function call
	     * table of the inherited object
	     */
	    ctrl = newctrl->inherits[i].obj->ctrl;
	    j = ctrl->ninherits - 1;
	    ofc = d_get_funcalls(ctrl) + 2L * ctrl->inherits[j].funcoffset;
	    for (n = ctrl->nfuncalls - ctrl->inherits[j].funcoffset; n > 0; --n)
	    {
		ctrl2 = ctrl->inherits[UCHAR(ofc[0])].obj->ctrl;
		f = &ctrl2->funcdefs[UCHAR(ofc[1])];
		if ((f->class & C_PRIVATE) ||
		    (f->class & (C_NOMASK | C_UNDEFINED)) == C_NOMASK ||
		    ((f->class & (C_STATIC | C_UNDEFINED)) == C_STATIC &&
		     ofc[0] == 0)) {
		    /*
		     * keep old call
		     */
		    *fc++ = (ofc[0] == 0) ? 0 : ofc[0] + i - j;
		    *fc++ = ofc[1];
		} else {
		    h = *(vfh **) ht_lookup(ftab,
					    d_get_strconst(ctrl2, f->inherit,
							   f->index)->text,
					    FALSE);
		    if (h->ohash->index == ninherits &&
			(functions[h->index].func.class & C_PRIVATE)) {
			/*
			 * private redefinition of (guaranteed non-private)
			 * inherited function
			 */
			h = (vfh *) h->chain.next;
		    }
		    *fc++ = h->ohash->index;
		    *fc++ = h->index;
		}
		ofc += 2;
	    }
	}
    }

    /*
     * Now fill in the function call entries for the object just compiled.
     */
    fc += 2L * nfcalls;
    i = fcchunksz;
    for (l = fclist; l != (fcchunk *) NULL; l = l->next) {
	do {
	    h = *(vfh **) ht_lookup(ftab, l->f[--i], FALSE);
	    *--fc = h->index;
	    *--fc = h->ohash->index;
	} while (i != 0);
	i = FCALL_CHUNK;
    }
}

/*
 * NAME:	control->mksymbs()
 * DESCRIPTION:	make the symbol table for the control block
 */
static void ctrl_mksymbs()
{
    register unsigned short i, n, x, ncoll;
    register dsymbol *symtab, *coll;

    if ((newctrl->nsymbols = nsymbs) == 0) {
	return;
    }

    /* initialize */
    symtab = newctrl->symbols = ALLOC(dsymbol, nsymbs);
    for (i = nsymbs; i > 0; --i) {
	symtab->next = -1;	/* mark as unused */
	symtab++;
    }
    symtab = newctrl->symbols;
    coll = ALLOCA(dsymbol, nsymbs);
    ncoll = 0;

    /*
     * Go down the list of inherited objects, adding the functions of each
     * object once.
     */
    for (i = 0; i <= ninherits; i++) {
	register dfuncdef *f;
	register control *ctrl;

	if (i == ninherits) {
	    ctrl = newctrl;
	} else if (oh_new(newctrl->inherits[i].obj->chain.name)->index == i) {
	    ctrl = newctrl->inherits[i].obj->ctrl;
	} else {
	    continue;
	}

	for (f = ctrl->funcdefs, n = 0; n < ctrl->nfuncdefs; f++, n++) {
	    register vfh *h;
	    register char *name;

	    if ((f->class & C_PRIVATE) ||
		(i == 0 && ninherits != 0 &&
		 (f->class & (C_STATIC | C_UNDEFINED)) == C_STATIC)) {
		/* not in symbol table */
		continue;
	    }
	    name = d_get_strconst(ctrl, f->inherit, f->index)->text;
	    h = *(vfh **) ht_lookup(ftab, name, FALSE);
	    if (h->ohash->index == ninherits &&
		(functions[h->index].func.class & C_PRIVATE)) {
		/*
		 * private redefinition of inherited function:
		 * use inherited function
		 */
		h = (vfh *) h->chain.next;
	    }
	    if (i == h->ohash->index) {
		/*
		 * all non-private functions are put into the hash table
		 */
		x = hashstr(name, VFMERGEHASHSZ) % nsymbs;
		if (symtab[x].next == (unsigned short) -1) {
		    /*
		     * new entry
		     */
		    symtab[x].inherit = i;
		    symtab[x].index = n;
		    symtab[x].next = x;
		} else {
		    /*
		     * collision
		     */
		    coll[ncoll].inherit = i;
		    coll[ncoll].index = n;
		    coll[ncoll++].next = x;
		}
	    }
	}
    }

    /*
     * Now deal with the collisions.
     */
    n = 0;
    for (i = 0; i < ncoll; i++) {
	/* find a free slot */
	while (symtab[n].next != (unsigned short) -1) {
	    n++;
	}
	x = coll[i].next;
	/* add new entry to list */
	symtab[n] = symtab[x];
	if (symtab[n].next == x) {
	    symtab[n].next = n;	/* adjust list terminator */
	}
	symtab[x].inherit = coll[i].inherit;
	symtab[x].index = coll[i].index;
	symtab[x].next = n++;	/* link to previous slot */
    }

    AFREE(coll);
}

/*
 * NAME:	control->symb()
 * DESCRIPTION:	return the entry in the symbol table for func, or NULL
 */
dsymbol *ctrl_symb(ctrl, func, len)
register control *ctrl;
char *func;
unsigned int len;
{
    register dsymbol *symb;
    register dfuncdef *f;
    register unsigned int i, j;
    register string *str;
    dsymbol *symtab, *symb1;
    dinherit *inherits;

    if ((i=ctrl->nsymbols) == 0) {
	return (dsymbol *) NULL;
    }

    inherits = ctrl->inherits;
    symtab = d_get_symbols(ctrl);
    i = hashstr(func, VFMERGEHASHSZ) % i;
    symb1 = symb = &symtab[i];
    ctrl = o_control(inherits[UCHAR(symb->inherit)].obj);
    f = d_get_funcdefs(ctrl) + UCHAR(symb->index);
    str = d_get_strconst(ctrl, f->inherit, f->index);
    if (len == str->len && memcmp(func, str->text, len) == 0) {
	/* found it */
	return (f->class & C_UNDEFINED) ? (dsymbol *) NULL : symb1;
    }
    while (i != symb->next) {
	symb = &symtab[i = symb->next];
	ctrl = o_control(inherits[UCHAR(symb->inherit)].obj);
	f = d_get_funcdefs(ctrl) + UCHAR(symb->index);
	str = d_get_strconst(ctrl, f->inherit, f->index);
	if (len == str->len && memcmp(func, str->text, len) == 0) {
	    /* found it: put symbol first in linked list */
	    i = symb1->inherit;
	    j = symb1->index;
	    symb1->inherit = symb->inherit;
	    symb1->index = symb->index;
	    symb->inherit = i;
	    symb->index = j;
	    return (f->class & C_UNDEFINED) ? (dsymbol *) NULL : symb1;
	}
    }
    return (dsymbol *) NULL;
}

/*
 * NAME:	control->construct()
 * DESCRIPTION:	construct and return a control block for the object just
 *		compiled
 */
control *ctrl_construct()
{
    register control *ctrl;

    ctrl = newctrl;
    ctrl->nvariables += nvars;

    ctrl_mkstrings();
    ctrl_mkfuncs();
    ctrl_mkvars();
    ctrl_mkfcalls();
    ctrl_mksymbs();
    ctrl->nfloatdefs = nfloats;
    ctrl->nfloats += nfloats;
    ctrl->compiled = P_time();

    newctrl = (control *) NULL;
    return ctrl;
}

/*
 * NAME:	control->clear()
 * DESCRIPTION:	clean up
 */
void ctrl_clear()
{
    oh_clear();
    vfh_clear();
    if (vtab != (hashtab *) NULL) {
	ht_del(vtab);
	ht_del(ftab);
	vtab = (hashtab *) NULL;
	ftab = (hashtab *) NULL;
    }
    lab_clear();

    ndirects = 0;
    ninherits = 0;
    nfloats = 0;
    nsymbs = 0;
    nfclash = 0;
    nifcalls = 0;

    if (newctrl != (control *) NULL) {
	d_del_control(newctrl);
	newctrl = (control *) NULL;
    }
    str_clear();
    while (str_list != (strchunk *) NULL) {
	register strchunk *l;
	register string **s;

	l = str_list;
	s = &l->s[strchunksz];
	while (--strchunksz >= 0) {
	    str_del(*--s);
	}
	strchunksz = STRING_CHUNK;
	str_list = l->next;
	FREE(l);
    }
    while (fclist != (fcchunk *) NULL) {
	register fcchunk *l;

	l = fclist;
	fclist = l->next;
	FREE(l);
    }
    fcchunksz = FCALL_CHUNK;
    if (functions != (cfunc *) NULL) {
	register int i;
	register cfunc *f;

	for (i = nfdefs, f = functions; i > 0; --i, f++) {
	    FREE(f->proto);
	    if (f->progsize != 0) {
		FREE(f->prog);
	    }
	}
	FREE(functions);
	functions = (cfunc *) NULL;
    }
    if (variables != (dvardef *) NULL) {
	FREE(variables);
	variables = (dvardef *) NULL;
    }
}

/*
 * NAME:	control->varmap()
 * DESCRIPTION:	create a variable mapping from the old control block to the new
 */
unsigned short *ctrl_varmap(old, new)
register control *old, *new;
{
    register unsigned short j, k;
    register dvardef *v;
    register long n;
    register unsigned short *vmap;
    register dinherit *inh, *inh2;
    register control *ctrl, *ctrl2;
    unsigned short i, voffset;

    /*
     * make variable mapping from old to new, with new just compiled
     */

    vmap = ALLOC(unsigned short, new->nvariables + 1);

    voffset = 0;
    for (i = new->ninherits, inh = new->inherits; i > 0; --i, inh++) {
	ctrl = (i == 1) ? new : inh->obj->ctrl;
	if (inh->varoffset < voffset || ctrl->nvardefs == 0) {
	    continue;
	}
	voffset = inh->varoffset + ctrl->nvardefs;

	for (j = old->ninherits, inh2 = old->inherits; j > 0; --j, inh2++) {
	    if (strcmp(inh->obj->chain.name, inh2->obj->chain.name) == 0) {
		/*
		 * put var names from old control block in string merge table
		 */
		ctrl2 = o_control(inh2->obj);
		v = d_get_vardefs(ctrl2);
		for (k = 0; k < ctrl2->nvardefs; k++, v++) {
		    str_put(d_get_strconst(ctrl2, v->inherit, v->index),
			    ((Uint) k << 8) | v->type);
		}
	    } else if (j != 1) {
		continue;
	    }

	    /*
	     * map new variables to old ones
	     */
	    for (k = 0, v = ctrl->vardefs; k < ctrl->nvardefs; k++, v++) {
		n = str_put(d_get_strconst(ctrl, v->inherit, v->index),
			    (Uint) 0);
		if ((n & 0xff) == v->type) {
		    *vmap = inh2->varoffset + (n >> 8);
		} else if (v->type == T_FLOAT) {
		    *vmap = NEW_FLOAT;
		} else {
		    *vmap = NEW_INT;
		}
		vmap++;
	    }
	    str_clear();
	    break;
	}
    }

    /*
     * check if any variable changed
     */
    *vmap = old->nvariables;
    vmap -= new->nvariables;
    if (old->nvariables != new->nvariables) {
	return vmap;		/* changed */
    }
    for (i = 0; i <= new->nvariables; i++) {
	if (vmap[i] != i) {
	    return vmap;	/* changed */
	}
    }
    /* no variable remapping needed */
    FREE(vmap);
    return (unsigned short *) NULL;
}