1 /*
2  * This file is part of DGD, https://github.com/dworkin/dgd
3  * Copyright (C) 1993-2010 Dworkin B.V.
4  * Copyright (C) 2010,2012-2013 DGD Authors (see the commit log for details)
5  *
6  * This program is free software: you can redistribute it and/or modify
7  * it under the terms of the GNU Affero General Public License as
8  * published by the Free Software Foundation, either version 3 of the
9  * License, or (at your option) any later version.
10  *
11  * This program is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  * GNU Affero General Public License for more details.
15  *
16  * You should have received a copy of the GNU Affero General Public License
17  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
18  */
19 
20 # include "comp.h"
21 # include "str.h"
22 # include "array.h"
23 # include "object.h"
24 # include "xfloat.h"
25 # include "interpret.h"
26 # include "data.h"
27 # include "hash.h"
28 # include "table.h"
29 # include "node.h"
30 # include "compile.h"
31 # include "control.h"
32 
33 typedef struct _oh_ {		/* object hash table */
34     hte chain;			/* hash table chain */
35     object *obj;		/* object */
36     short index;		/* -1: new */
37     short priv;			/* 1: direct private, 2: indirect private */
38     struct _oh_ **next;		/* next in linked list */
39 } oh;
40 
41 static hashtab *otab;		/* object hash table */
42 static oh **olist;		/* list of all object hash table entries */
43 
44 /*
45  * NAME:	oh->init()
46  * DESCRIPTION:	initialize the object hash table
47  */
oh_init()48 static void oh_init()
49 {
50     otab = ht_new(OMERGETABSZ, OBJHASHSZ, FALSE);
51 }
52 
53 /*
54  * NAME:	oh->new()
55  * DESCRIPTION:	put an object in the hash table
56  */
oh_new(char * name)57 static oh *oh_new(char *name)
58 {
59     oh **h;
60 
61     h = (oh **) ht_lookup(otab, name, FALSE);
62     if (*h == (oh *) NULL) {
63 	/*
64 	 * new object
65 	 */
66 	*h = ALLOC(oh, 1);
67 	(*h)->chain.next = (hte *) NULL;
68 	(*h)->chain.name = name;
69 	(*h)->index = -1;		/* new object */
70 	(*h)->priv = 0;
71 	(*h)->next = olist;
72 	olist = h;
73     }
74 
75     return *h;
76 }
77 
78 /*
79  * NAME:	oh->clear()
80  * DESCRIPTION:	clear the object hash table
81  */
oh_clear()82 static void oh_clear()
83 {
84     oh **h, *f;
85 
86     for (h = olist; h != (oh **) NULL; ) {
87 	f = *h;
88 	h = f->next;
89 	FREE(f);
90     }
91     olist = (oh **) NULL;
92 
93     if (otab != (hashtab *) NULL) {
94 	ht_del(otab);
95 	otab = (hashtab *) NULL;
96     }
97 }
98 
99 
100 # define VFH_CHUNK	64
101 
102 typedef struct _vfh_ {		/* variable/function hash table */
103     hte chain;			/* hash table chain */
104     string *str;		/* name string */
105     oh *ohash;			/* controlling object hash table entry */
106     string *cvstr;		/* class variable string */
107     unsigned short ct;		/* function call, or variable type */
108     short index;		/* definition table index */
109 } vfh;
110 
111 typedef struct _vfhchunk_ {
112     struct _vfhchunk_ *next;	/* next in linked list */
113     vfh vf[VFH_CHUNK];		/* vfh chunk */
114 } vfhchunk;
115 
116 static vfhchunk *vfhclist;	/* linked list of all vfh chunks */
117 static int vfhchunksz = VFH_CHUNK; /* size of current vfh chunk */
118 
119 /*
120  * NAME:	vfh->new()
121  * DESCRIPTION:	create a new vfh table element
122  */
vfh_new(string * str,oh * ohash,unsigned short ct,string * cvstr,short idx,vfh ** addr)123 static void vfh_new(string *str, oh *ohash, unsigned short ct,
124 	string *cvstr, short idx, vfh **addr)
125 {
126     vfh *h;
127 
128     if (vfhchunksz == VFH_CHUNK) {
129 	vfhchunk *l;
130 
131 	l = ALLOC(vfhchunk, 1);
132 	l->next = vfhclist;
133 	vfhclist = l;
134 	vfhchunksz = 0;
135     }
136     h = &vfhclist->vf[vfhchunksz++];
137     h->chain.next = (hte *) *addr;
138     *addr = h;
139     h->chain.name = str->text;
140     str_ref(h->str = str);
141     h->ohash = ohash;
142     h->cvstr = cvstr;
143     if (cvstr != (string *) NULL) {
144 	str_ref(cvstr);
145     }
146     h->ct = ct;
147     h->index = idx;
148 }
149 
150 /*
151  * NAME:	vfh->clear()
152  * DESCRIPTION:	clear the vfh tables
153  */
vfh_clear()154 static void vfh_clear()
155 {
156     vfhchunk *l, *f;
157     vfh *vf;
158 
159     for (l = vfhclist; l != (vfhchunk *) NULL; ) {
160 	for (vf = l->vf; vfhchunksz != 0; vf++, --vfhchunksz) {
161 	    str_del(vf->str);
162 	    if (vf->cvstr != (string *) NULL) {
163 		str_del(vf->cvstr);
164 	    }
165 	}
166 	vfhchunksz = VFH_CHUNK;
167 	f = l;
168 	l = l->next;
169 	FREE(f);
170     }
171     vfhclist = (vfhchunk *) NULL;
172 }
173 
174 
175 typedef struct _lab_ {
176     string *str;		/* label */
177     oh *ohash;			/* entry in hash table */
178     struct _lab_ *next;		/* next label */
179 } lab;
180 
181 static lab *labels;		/* list of labeled inherited objects */
182 
183 /*
184  * NAME:	lab->new()
185  * DESCRIPTION:	declare a new inheritance label
186  */
lab_new(string * str,oh * ohash)187 static void lab_new(string *str, oh *ohash)
188 {
189     lab *l;
190 
191     l = ALLOC(lab, 1);
192     str_ref(l->str = str);
193     l->ohash = ohash;
194     l->next = labels;
195     labels = l;
196 }
197 
198 /*
199  * NAME:	lab->find()
200  * DESCRIPTION:	find a labeled object in the list
201  */
lab_find(char * name)202 static oh *lab_find(char *name)
203 {
204     lab *l;
205 
206     for (l = labels; l != (lab *) NULL; l = l->next) {
207 	if (strcmp(l->str->text, name) == 0) {
208 	    return l->ohash;
209 	}
210     }
211     return (oh *) NULL;
212 }
213 
214 /*
215  * NAME:	lab->clear()
216  * DESCRIPTION:	wipe out all inheritance label declarations
217  */
lab_clear()218 static void lab_clear()
219 {
220     lab *l, *f;
221 
222     l = labels;
223     while (l != (lab *) NULL) {
224 	str_del(l->str);
225 	f = l;
226 	l = l->next;
227 	FREE(f);
228     }
229     labels = (lab *) NULL;
230 }
231 
232 
233 # define MAX_INHERITS		255
234 # define MAX_VARIABLES		(USHRT_MAX - 2)
235 
236 static oh *inherits[MAX_INHERITS * 2];	/* inherited objects */
237 static int ninherits;			/* # inherited objects */
238 static bool privinherit;		/* TRUE if private inheritance used */
239 static hashtab *vtab;			/* variable merge table */
240 static hashtab *ftab;			/* function merge table */
241 static unsigned short nvars;		/* # variables */
242 static unsigned short nsymbs;		/* # symbols */
243 static int nfclash;			/* # prototype clashes */
244 static Uint nifcalls;			/* # inherited function calls */
245 
246 /*
247  * NAME:	control->init()
248  * DESCRIPTION:	initialize control block construction
249  */
ctrl_init()250 void ctrl_init()
251 {
252     oh_init();
253     vtab = ht_new(VFMERGETABSZ, VFMERGEHASHSZ, FALSE);
254     ftab = ht_new(VFMERGETABSZ, VFMERGEHASHSZ, FALSE);
255 }
256 
257 /*
258  * NAME:	control->vardefs()
259  * DESCRIPTION:	put variable definitions from an inherited object into the
260  *		variable merge table
261  */
ctrl_vardefs(oh * ohash,control * ctrl)262 static void ctrl_vardefs(oh *ohash, control *ctrl)
263 {
264     dvardef *v;
265     int n;
266     string *str, *cvstr;
267     vfh **h;
268 
269     v = d_get_vardefs(ctrl);
270     for (n = 0; n < ctrl->nvardefs; n++) {
271 	/*
272 	 * Add only non-private variables, and check if a variable with the
273 	 * same name hasn't been inherited already.
274 	 */
275 	if (!(v->class & C_PRIVATE)) {
276 	    str = d_get_strconst(ctrl, v->inherit, v->index);
277 	    h = (vfh **) ht_lookup(vtab, str->text, FALSE);
278 	    if (*h == (vfh *) NULL) {
279 		/* new variable */
280 		if (ctrl->nclassvars != 0) {
281 		    cvstr = ctrl->cvstrings[n];
282 		} else {
283 		    cvstr = (string *) NULL;
284 		}
285 		vfh_new(str, ohash, v->type, cvstr, n, h);
286 	    } else {
287 	       /* duplicate variable */
288 	       c_error("multiple inheritance of variable %s (/%s, /%s)",
289 		       str->text, (*h)->ohash->chain.name, ohash->chain.name);
290 	    }
291 	}
292 	v++;
293     }
294 }
295 
296 /*
297  * NAME:	comp_class()
298  * DESCRIPTION:	compare two class strings
299  */
cmp_class(control * ctrl1,Uint s1,control * ctrl2,Uint s2)300 static bool cmp_class(control *ctrl1, Uint s1, control *ctrl2, Uint s2)
301 {
302     if (ctrl1 == ctrl2 && s1 == s2) {
303 	return TRUE;	/* the same */
304     }
305     if (ctrl1->compiled == 0 && (s1 >> 16) == ninherits) {
306 	return FALSE;	/* one is new, and therefore different */
307     }
308     if (ctrl2->compiled == 0 && (s2 >> 16) == ninherits) {
309 	return FALSE;	/* one is new, and therefore different */
310     }
311     return !str_cmp(d_get_strconst(ctrl1, s1 >> 16, s1 & 0xffff),
312 		    d_get_strconst(ctrl2, s2 >> 16, s2 & 0xffff));
313 }
314 
315 /*
316  * NAME:	cmp_proto()
317  * DESCRIPTION:	Compare two prototypes. Return TRUE if equal.
318  */
cmp_proto(control * ctrl1,char * prot1,control * ctrl2,char * prot2)319 static bool cmp_proto(control *ctrl1, char *prot1, control *ctrl2, char *prot2)
320 {
321     int i;
322     char c1, c2;
323     Uint s1, s2;
324 
325     /* check if either prototype is implicit */
326     if (PROTO_FTYPE(prot1) == T_IMPLICIT || PROTO_FTYPE(prot2) == T_IMPLICIT) {
327 	return TRUE;
328     }
329 
330     /* check if classes are compatible */
331     c1 = *prot1++;
332     c2 = *prot2++;
333     if ((c1 ^ c2) & (C_PRIVATE | C_ELLIPSIS)) {
334 	return FALSE;		/* must agree on this much */
335     } else if (c1 & c2 & C_UNDEFINED) {
336 	if ((c1 ^ c2) & ~C_TYPECHECKED) {
337 	    return FALSE;	/* 2 prototypes must be equal */
338 	}
339     } else if (c1 & C_UNDEFINED) {
340 	if ((c1 ^ (c1 & c2)) & (C_STATIC | C_NOMASK | C_ATOMIC)) {
341 	    return FALSE;	/* everthing in prototype must be supported */
342 	}
343     } else if (c2 & C_UNDEFINED) {
344 	if ((c2 ^ (c2 & c1)) & (C_STATIC | C_NOMASK | C_ATOMIC)) {
345 	    return FALSE;	/* everthing in prototype must be supported */
346 	}
347     } else {
348 	return FALSE;		/* not compatible */
349     }
350 
351     /* check if the number of arguments is equal */
352     if ((i=UCHAR(*prot1++)) != UCHAR(*prot2++)) {
353 	return FALSE;
354     }
355     if (*prot1 != *prot2) {
356 	return FALSE;
357     }
358     i += UCHAR(*prot1);
359 
360     /* compare return type & arguments */
361     prot1 += 3;
362     prot2 += 3;
363     do {
364 	if (*prot1++ != *prot2) {
365 	    return FALSE;
366 	}
367 	if ((*prot2++ & T_TYPE) == T_CLASS) {
368 	    /* compare class strings */
369 	    FETCH3U(prot1, s1);
370 	    FETCH3U(prot2, s2);
371 	    if (!cmp_class(ctrl1, s1, ctrl2, s2)) {
372 		return FALSE;
373 	    }
374 	}
375     } while (--i >= 0);
376 
377     return TRUE;	/* equal */
378 }
379 
380 /*
381  * NAME:	control->funcdef()
382  * DESCRIPTION:	put a function definition from an inherited object into
383  *		the function merge table
384  */
ctrl_funcdef(control * ctrl,int idx,oh * ohash)385 static void ctrl_funcdef(control *ctrl, int idx, oh *ohash)
386 {
387     vfh **h, **l;
388     dfuncdef *f;
389     string *str;
390 
391     f = &ctrl->funcdefs[idx];
392     str = d_get_strconst(ctrl, f->inherit, f->index);
393     if (ohash->priv != 0 && (f->class & C_NOMASK)) {
394 	/*
395 	 * privately inherited nomask function is not allowed
396 	 */
397 	c_error("private inherit of nomask function %s (/%s)", str->text,
398 		ohash->chain.name);
399 	return;
400     }
401 
402     h = (vfh **) ht_lookup(ftab, str->text, FALSE);
403     if (*h == (vfh *) NULL) {
404 	/*
405 	 * New function (-1: no calls to it yet)
406 	 */
407 	vfh_new(str, ohash, -1, (string *) NULL, idx, h);
408 	if (ohash->priv == 0 &&
409 	    (ctrl->ninherits != 1 ||
410 	     (f->class & (C_STATIC | C_UNDEFINED)) != C_STATIC)) {
411 	    /*
412 	     * don't count privately inherited functions, or static functions
413 	     * from the auto object
414 	     */
415 	    nsymbs++;
416 	}
417     } else {
418 	dinherit *inh;
419 	int n;
420 	object *o;
421 	char *prot1, *prot2;
422 	bool privflag, inhflag, firstsym;
423 	int nfunc, npriv;
424 
425 	/*
426 	 * prototype already exists
427 	 */
428 	prot1 = ctrl->prog + f->offset;
429 
430 	/*
431 	 * First check if the new function's object is inherited by the
432 	 * object that defines the function in the merge table.
433 	 */
434 	privflag = FALSE;
435 	o = ohash->obj;
436 	for (l = h;
437 	     *l != (vfh *) NULL && strcmp((*l)->chain.name, str->text) == 0;
438 	     l = (vfh **) &(*l)->chain.next) {
439 	    if ((*l)->ohash == (oh *) NULL) {
440 		continue;
441 	    }
442 
443 	    ctrl = (*l)->ohash->obj->ctrl;
444 	    inh = ctrl->inherits;
445 	    n = ctrl->ninherits;
446 	    ctrl = ohash->obj->ctrl;
447 	    while (--n != 0) {
448 		if (o->index == inh->oindex && !inh->priv) {
449 		    if (ohash->priv == 0 && (*l)->ohash->priv != 0 &&
450 			(ctrl->ninherits != 1 ||
451 			 (ctrl->funcdefs[idx].class &
452 				       (C_STATIC | C_UNDEFINED)) != C_STATIC)) {
453 			/*
454 			 * private masks nonprivate function that isn't a
455 			 * static function in the auto object
456 			 */
457 			if (l == h) {
458 			    privflag = TRUE;
459 			}
460 			break;
461 		    } else {
462 			return;	/* no change */
463 		    }
464 		}
465 		inh++;
466 	    }
467 	}
468 
469 	/*
470 	 * Now check if the functions in the merge table are in
471 	 * an object inherited by the currently inherited object.
472 	 */
473 	inhflag = firstsym = TRUE;
474 	nfunc = npriv = 0;
475 	l = h;
476 	while (*l != (vfh *) NULL && strcmp((*l)->chain.name, str->text) == 0) {
477 	    if ((*l)->ohash == (oh *) NULL) {
478 		l = (vfh **) &(*l)->chain.next;
479 		continue;
480 	    }
481 
482 	    o = (*l)->ohash->obj;
483 	    ctrl = ohash->obj->ctrl;
484 	    inh = ctrl->inherits;
485 	    n = ctrl->ninherits;
486 	    ctrl = o->ctrl;
487 	    prot2 = ctrl->prog + ctrl->funcdefs[(*l)->index].offset;
488 	    for (;;) {
489 		if (--n >= 0) {
490 		    if (o->index == (inh++)->oindex) {
491 			/*
492 			 * redefined inherited function
493 			 */
494 			if ((*l)->ohash != ohash && (*l)->ohash->priv == 0 &&
495 			    (ctrl->ninherits != 1 ||
496 			     (ctrl->funcdefs[(*l)->index].class &
497 				       (C_STATIC | C_UNDEFINED)) != C_STATIC)) {
498 			    /*
499 			     * function in merge table is nonprivate and is
500 			     * not a static function in the auto object
501 			     */
502 			    firstsym = FALSE;
503 			    if (ohash->priv != 0) {
504 				/*
505 				 * masked by private function: leave it
506 				 */
507 				if (!(PROTO_CLASS(prot2) & C_UNDEFINED)) {
508 				    nfunc++;
509 				}
510 				l = (vfh **) &(*l)->chain.next;
511 				break;
512 			    }
513 			}
514 			*l = (vfh *) (*l)->chain.next;
515 			break;
516 		    }
517 		} else {
518 		    /*
519 		     * not inherited: check for prototype clashes
520 		     */
521 		    if (((f->class | PROTO_CLASS(prot2)) &
522 					(C_NOMASK | C_UNDEFINED)) == C_NOMASK) {
523 			/*
524 			 * a nomask function is inherited more than once
525 			 */
526 			c_error("multiple inheritance of nomask function %s (/%s, /%s)",
527 				str->text, (*l)->ohash->chain.name,
528 				ohash->chain.name);
529 			return;
530 		    }
531 		    if (((f->class | PROTO_CLASS(prot2)) & C_UNDEFINED) &&
532 			!cmp_proto(ohash->obj->ctrl, prot1, ctrl, prot2)) {
533 			/*
534 			 * prototype conflict
535 			 */
536 			c_error("unequal prototypes for function %s (/%s, /%s)",
537 				str->text, (*l)->ohash->chain.name,
538 				ohash->chain.name);
539 			return;
540 		    }
541 
542 		    if (!(PROTO_CLASS(prot2) & C_UNDEFINED)) {
543 			inhflag = FALSE;
544 			if ((*l)->ohash->priv == 0) {
545 			    nfunc++;
546 			} else {
547 			    npriv++;
548 			}
549 		    }
550 
551 		    if ((*l)->ohash->priv == 0) {
552 			firstsym = FALSE;
553 		    }
554 		    l = (vfh **) &(*l)->chain.next;
555 		    break;
556 		}
557 	    }
558 	}
559 
560 	if (firstsym && ohash->priv == 0) {
561 	    nsymbs++;	/* first symbol */
562 	}
563 
564 	if (inhflag) {
565 	    /* insert new prototype at the beginning */
566 	    vfh_new(str, ohash, -1, (string *) NULL, idx, h);
567 	    h = (vfh **) &(*h)->chain.next;
568 	} else if (!(PROTO_CLASS(prot1) & C_UNDEFINED)) {
569 	    /* add the new prototype to the count */
570 	    if (ohash->priv == 0) {
571 		nfunc++;
572 	    } else {
573 		npriv++;
574 	    }
575 	}
576 
577 	if (privflag) {
578 	    /* skip private function at the start */
579 	    h = (vfh **) &(*h)->chain.next;
580 	}
581 
582 	/* add/remove clash markers */
583 	if (*h != (vfh *) NULL &&
584 	    strcmp((*h)->chain.name, str->text) == 0) {
585 	    /*
586 	     * there are other prototypes
587 	     */
588 	    if ((*h)->ohash == (oh *) NULL) {
589 		/* first entry is clash marker */
590 		if (nfunc + npriv <= 1) {
591 		    /* remove it */
592 		    *h = (vfh *) (*h)->chain.next;
593 		    --nfclash;
594 		} else {
595 		    /* adjust it */
596 		    (*h)->index = nfunc;
597 		    h = (vfh **) &(*h)->chain.next;
598 		}
599 	    } else if (nfunc + npriv > 1) {
600 		/* add new clash marker as first entry */
601 		vfh_new(str, (oh *) NULL, 0, (string *) NULL, nfunc, h);
602 		nfclash++;
603 		h = (vfh **) &(*h)->chain.next;
604 	    }
605 	}
606 
607 	/* add new prototype, undefined at the end */
608 	if (!inhflag) {
609 	    if (PROTO_CLASS(prot1) & C_UNDEFINED) {
610 		vfh_new(str, ohash, -1, (string *) NULL, idx, l);
611 	    } else {
612 		vfh_new(str, ohash, -1, (string *) NULL, idx, h);
613 	    }
614 	}
615     }
616 }
617 
618 /*
619  * NAME:	control->funcdefs()
620  * DESCRIPTION:	put function definitions from an inherited object into
621  *		the function merge table
622  */
ctrl_funcdefs(oh * ohash,control * ctrl)623 static void ctrl_funcdefs(oh *ohash, control *ctrl)
624 {
625     short n;
626     dfuncdef *f;
627 
628     d_get_prog(ctrl);
629     for (n = 0, f = d_get_funcdefs(ctrl); n < ctrl->nfuncdefs; n++, f++) {
630 	if (!(f->class & C_PRIVATE)) {
631 	    ctrl_funcdef(ctrl, n, ohash);
632 	}
633     }
634 }
635 
636 /*
637  * NAME:	control->inherit()
638  * DESCRIPTION:	inherit an object
639  */
ctrl_inherit(frame * f,char * from,object * obj,string * label,int priv)640 bool ctrl_inherit(frame *f, char *from, object *obj, string *label, int priv)
641 {
642     oh *ohash;
643     control *ctrl;
644     dinherit *inh;
645     int i;
646     object *o;
647 
648     if (!(obj->flags & O_MASTER)) {
649 	c_error("cannot inherit cloned object");
650 	return TRUE;
651     }
652     if (O_UPGRADING(obj)) {
653 	c_error("cannot inherit object being upgraded");
654 	return TRUE;
655     }
656 
657     ohash = oh_new(obj->chain.name);
658     if (label != (string *) NULL) {
659 	/*
660 	 * use a label
661 	 */
662 	if (lab_find(label->text) != (oh *) NULL) {
663 	    c_error("redeclaration of label %s", label->text);
664 	}
665 	lab_new(label, ohash);
666     }
667 
668     if (ohash->index < 0) {
669 	/*
670 	 * new inherited object
671 	 */
672 	ctrl = o_control(obj);
673 	inh = ctrl->inherits;
674 	if (ninherits != 0 && strcmp(OBJR(inh->oindex)->chain.name,
675 				     inherits[0]->obj->chain.name) != 0) {
676 	    c_error("inherited different auto objects");
677 	}
678 
679 	for (i = ctrl->ninherits - 1, inh += i; i > 0; --i) {
680 	    /*
681 	     * check if object inherits destructed objects
682 	     */
683 	    --inh;
684 	    o = OBJR(inh->oindex);
685 	    if (o->count == 0) {
686 		Uint ocount;
687 
688 		if (strcmp(o->chain.name, from) == 0) {
689 		    /*
690 		     * inheriting old instance of the same object
691 		     */
692 		    c_error("cycle in inheritance");
693 		    return TRUE;
694 		}
695 
696 		/*
697 		 * This object inherits an object that has been destructed.
698 		 * Give the driver object a chance to destruct it.
699 		 */
700 		(--f->sp)->type = T_OBJECT;
701 		f->sp->oindex = obj->index;
702 		f->sp->u.objcnt = ocount = obj->count;
703 		call_driver_object(f, "recompile", 1);
704 		i_del_value(f->sp++);
705 		obj = OBJR(obj->index);
706 		if (obj->count != ocount) {
707 		    return FALSE;	/* recompile this object */
708 		}
709 	    }
710 	}
711 
712 	for (i = ctrl->ninherits, inh += i; i > 0; --i) {
713 	    /*
714 	     * check if inherited objects have been inherited before
715 	     */
716 	    --inh;
717 	    o = OBJR(inh->oindex);
718 	    ohash = oh_new(o->chain.name);
719 	    if (ohash->index < 0) {
720 		/*
721 		 * inherit a new object
722 		 */
723 		ohash->obj = o;
724 		o_control(o);		/* load the control block */
725 		if (inh->priv) {
726 		    ohash->priv = 2;	/* indirect private */
727 		} else {
728 		    ohash->priv = priv;
729 		    /*
730 		     * add functions and variables from this object
731 		     */
732 		    ctrl_funcdefs(ohash, o->ctrl);
733 		    ctrl_vardefs(ohash, o->ctrl);
734 		}
735 	    } else if (ohash->obj != o) {
736 		/*
737 		 * inherited two different objects with same name
738 		 */
739 		c_error("inherited different instances of /%s", o->chain.name);
740 		return TRUE;
741 	    } else if (!inh->priv && ohash->priv > priv) {
742 		/*
743 		 * add to function and variable table
744 		 */
745 		if (ohash->priv == 2) {
746 		    ctrl_vardefs(ohash, o->ctrl);
747 		}
748 		ohash->priv = priv;
749 		ctrl_funcdefs(ohash, o->ctrl);
750 	    }
751 	}
752 
753 	for (i = ctrl->ninherits; i > 0; --i) {
754 	    /*
755 	     * add to the inherited array
756 	     */
757 	    ohash = oh_new(OBJR(inh->oindex)->chain.name);
758 	    if (ohash->index < 0) {
759 		ohash->index = ninherits;
760 		inherits[ninherits++] = ohash;
761 	    }
762 	    inh++;
763 	}
764 
765 	if (priv) {
766 	    privinherit = TRUE;
767 	}
768 
769     } else if (ohash->obj != obj) {
770 	/*
771 	 * inherited two objects with same name
772 	 */
773 	c_error("inherited different instances of /%s", obj->chain.name);
774     } else if (ohash->priv > priv) {
775 	/*
776 	 * previously inherited with greater privateness; process all
777 	 * objects inherited by this object
778 	 */
779 	ctrl = o_control(obj);
780 	for (i = ctrl->ninherits, inh = ctrl->inherits + i; i > 0; --i) {
781 	    --inh;
782 	    o = OBJR(inh->oindex);
783 	    ohash = oh_new(o->chain.name);
784 	    if (!inh->priv && ohash->priv > priv) {
785 		/*
786 		 * add to function and variable table
787 		 */
788 		if (ohash->priv == 2) {
789 		    ctrl_vardefs(ohash, o->ctrl);
790 		}
791 		ohash->priv = priv;
792 		ctrl_funcdefs(ohash, o->ctrl);
793 	    }
794 	}
795     }
796 
797     if (ninherits >= MAX_INHERITS) {
798 	c_error("too many objects inherited");
799     }
800 
801     return TRUE;
802 }
803 
804 
805 # define STRING_CHUNK	64
806 
807 typedef struct _strchunk_ {
808     struct _strchunk_ *next;		/* next in string chunk list */
809     string *s[STRING_CHUNK];		/* chunk of strings */
810 } strchunk;
811 
812 # define FCALL_CHUNK	64
813 
814 typedef struct _fcchunk_ {
815     struct _fcchunk_ *next;		/* next in fcall chunk list */
816     char *f[FCALL_CHUNK];		/* function reference */
817 } fcchunk;
818 
819 typedef struct _cfunc_ {
820     dfuncdef func;			/* function name/type */
821     char *name;				/* function name */
822     char *proto;			/* function prototype */
823     string *cfstr;			/* function class string */
824     char *prog;				/* function program */
825     unsigned short progsize;		/* function program size */
826 } cfunc;
827 
828 static control *newctrl;		/* the new control block */
829 static oh *newohash;			/* fake ohash entry for new object */
830 static strchunk *str_list;		/* list of string chunks */
831 static int strchunksz = STRING_CHUNK;	/* size of current string chunk */
832 static Uint nstrs;			/* # of strings in all string chunks */
833 static fcchunk *fclist;			/* list of fcall chunks */
834 static int fcchunksz = FCALL_CHUNK;	/* size of current fcall chunk */
835 static cfunc *functions;		/* defined functions table */
836 static int nfdefs, fdef;		/* # defined functions, current func */
837 static int nundefs;			/* # private undefined prototypes */
838 static Uint progsize;			/* size of all programs and protos */
839 static dvardef *variables;		/* defined variables */
840 static string **cvstrings;		/* variable class strings */
841 static char *classvars;			/* class variables */
842 static int nclassvars;			/* # classvars */
843 static Uint nfcalls;			/* # function calls */
844 
845 /*
846  * NAME:	control->imap()
847  * DESCRIPTION:	initialize inherit map
848  */
ctrl_imap(control * ctrl)849 static void ctrl_imap(control *ctrl)
850 {
851     dinherit *inh;
852     int i, j, n, imapsz;
853     control *ctrl2;
854 
855     imapsz = ctrl->ninherits;
856     for (n = imapsz - 1, inh = &ctrl->inherits[n]; n > 0; ) {
857 	--n;
858 	(--inh)->progoffset = imapsz;
859 	ctrl2 = OBJR(inh->oindex)->ctrl;
860 	for (i = 0; i < ctrl2->ninherits; i++) {
861 	    ctrl->imap[imapsz++] = oh_new(OBJR(ctrl2->inherits[UCHAR(ctrl2->imap[i])].oindex)->chain.name)->index;
862 	}
863 	for (j = ctrl->ninherits - n; --j > 0; ) {
864 	    if (memcmp(ctrl->imap + inh->progoffset,
865 		       ctrl->imap + inh[j].progoffset, i) == 0) {
866 		/* merge with table of inheriting object */
867 		inh->progoffset = inh[j].progoffset;
868 		imapsz -= i;
869 		break;
870 	    }
871 	}
872     }
873     ctrl->imap = REALLOC(ctrl->imap, char, ctrl->imapsz, imapsz);
874     ctrl->imapsz = imapsz;
875 }
876 
877 /*
878  * NAME:	control->convert()
879  * DESCRIPTION:	convert inherits
880  */
ctrl_convert(control * ctrl)881 void ctrl_convert(control *ctrl)
882 {
883     int n, imapsz;
884     oh *ohash;
885     dinherit *inh;
886     object *obj;
887     hashtab *xotab;
888     oh **xolist;
889 
890     xotab = otab;
891     xolist = olist;
892     oh_init();
893     olist = (oh **) NULL;
894 
895     imapsz = 0;
896     for (n = 0, inh = ctrl->inherits; n < ctrl->ninherits; n++, inh++) {
897 	obj = OBJR(inh->oindex);
898 	ohash = oh_new(obj->chain.name);
899 	if (ohash->index < 0) {
900 	    ohash->obj = obj;
901 	    ohash->index = n;
902 	}
903 	imapsz += o_control(obj)->ninherits;
904     }
905     ctrl->imap = ALLOC(char, ctrl->imapsz = imapsz);
906     imapsz = 0;
907     for (n = ctrl->ninherits, inh = ctrl->inherits; n > 0; --n, inh++) {
908 	ctrl->imap[imapsz++] = n;
909     }
910     ctrl->imap[0] = 0;
911     ctrl_imap(ctrl);
912 
913     oh_clear();
914     olist = xolist;
915     otab = xotab;
916 }
917 
918 /*
919  * NAME:	control->create()
920  * DESCRIPTION:	make an initial control block
921  */
ctrl_create()922 void ctrl_create()
923 {
924     dinherit *new;
925     control *ctrl;
926     unsigned short n;
927     int i, count;
928     oh *ohash;
929 
930     /*
931      * create a new control block
932      */
933     newohash = oh_new("/");		/* unique name */
934     newohash->index = ninherits;
935     newctrl = d_new_control();
936     new = newctrl->inherits =
937 	  ALLOC(dinherit, newctrl->ninherits = ninherits + 1);
938     newctrl->imap = ALLOC(char, (ninherits + 2) * (ninherits + 1) / 2);
939     newctrl->progindex = ninherits;
940     nvars = 0;
941     str_merge();
942 
943     /*
944      * Fix function offsets and variable offsets, and collect all string
945      * constants from inherited objects and put them in the string merge
946      * table.
947      */
948     for (count = 0; count < ninherits; count++) {
949 	newctrl->imap[count] = count;
950 	ohash = inherits[count];
951 	new->oindex = ohash->obj->index;
952 	ctrl = ohash->obj->ctrl;
953 	i = ctrl->ninherits - 1;
954 	new->funcoffset = nifcalls;
955 	n = ctrl->nfuncalls - ctrl->inherits[i].funcoffset;
956 	if (nifcalls > UINDEX_MAX - n) {
957 	    c_error("inherited too many function calls");
958 	}
959 	nifcalls += n;
960 	new->varoffset = nvars;
961 	if (nvars > MAX_VARIABLES - ctrl->nvardefs) {
962 	    c_error("inherited too many variables");
963 	}
964 	nvars += ctrl->nvardefs;
965 
966 	for (n = ctrl->nstrings; n > 0; ) {
967 	    --n;
968 	    str_put(d_get_strconst(ctrl, i, n), ((Uint) count << 16) | n);
969 	}
970 	new->priv = (ohash->priv != 0);
971 	new++;
972     }
973     newctrl->imap[count] = count;
974     new->oindex = UINDEX_MAX;
975     new->progoffset = 0;
976     new->funcoffset = nifcalls;
977     new->varoffset = newctrl->nvariables = nvars;
978     new->priv = FALSE;
979     ctrl_imap(newctrl);
980 
981     /*
982      * prepare for construction of a new control block
983      */
984     functions = ALLOC(cfunc, 256);
985     variables = ALLOC(dvardef, 256);
986     cvstrings = ALLOC(string*, 256 * sizeof(string*));
987     classvars = ALLOC(char, 256 * 3);
988     progsize = 0;
989     nstrs = 0;
990     nfdefs = 0;
991     nvars = 0;
992     nclassvars = 0;
993     nfcalls = 0;
994 }
995 
996 /*
997  * NAME:	control->dstring()
998  * DESCRIPTION:	define a new (?) string constant
999  */
ctrl_dstring(string * str)1000 long ctrl_dstring(string *str)
1001 {
1002     Uint desc, new;
1003 
1004     desc = str_put(str, new = ((Uint) ninherits << 16) | nstrs);
1005     if (desc == new) {
1006 	/*
1007 	 * it is really a new string
1008 	 */
1009 	if (strchunksz == STRING_CHUNK) {
1010 	    strchunk *l;
1011 
1012 	    l = ALLOC(strchunk, 1);
1013 	    l->next = str_list;
1014 	    str_list = l;
1015 	    strchunksz = 0;
1016 	}
1017 	str_ref(str_list->s[strchunksz++] = str);
1018 	if (nstrs == USHRT_MAX) {
1019 	    c_error("too many string constants");
1020 	}
1021 	nstrs++;
1022     }
1023     if (desc >> 16 == ninherits) {
1024 	desc |= 0x01000000L;	/* mark it as new */
1025     }
1026     return desc;
1027 }
1028 
1029 /*
1030  * NAME:	control->dproto()
1031  * DESCRIPTION:	define a new function prototype
1032  */
ctrl_dproto(string * str,char * proto,string * class)1033 void ctrl_dproto(string *str, char *proto, string *class)
1034 {
1035     vfh **h, **l;
1036     dfuncdef *func;
1037     char *proto2;
1038     control *ctrl;
1039     int i;
1040     long s;
1041 
1042     /* first check if prototype exists already */
1043     h = l = (vfh **) ht_lookup(ftab, str->text, FALSE);
1044     if (*h != (vfh *) NULL) {
1045 	/*
1046 	 * redefinition
1047 	 */
1048 	if ((*h)->ohash == newohash) {
1049 	    /*
1050 	     * redefinition of new function
1051 	     */
1052 	    proto2 = functions[(*h)->index].proto;
1053 	    if (!((PROTO_CLASS(proto) | PROTO_CLASS(proto2)) & C_UNDEFINED)) {
1054 		/*
1055 		 * both prototypes are from functions
1056 		 */
1057 		c_error("multiple declaration of function %s", str->text);
1058 	    } else if (!cmp_proto(newctrl, proto, newctrl, proto2)) {
1059 		if ((PROTO_CLASS(proto) ^ PROTO_CLASS(proto2)) & C_UNDEFINED) {
1060 		    /*
1061 		     * declaration does not match prototype
1062 		     */
1063 		    c_error("declaration does not match prototype of %s",
1064 			    str->text);
1065 		} else {
1066 		    /*
1067 		     * unequal prototypes
1068 		     */
1069 		    c_error("unequal prototypes for function %s", str->text);
1070 		}
1071 	    } else if (!(PROTO_CLASS(proto) & C_UNDEFINED) ||
1072 		       PROTO_FTYPE(proto2) == T_IMPLICIT) {
1073 		/*
1074 		 * replace undefined prototype
1075 		 */
1076 		if (PROTO_FTYPE(proto2) == T_IMPLICIT &&
1077 		    (PROTO_CLASS(proto) & C_PRIVATE)) {
1078 		    /* private function replaces implicit prototype */
1079 		    --nsymbs;
1080 		}
1081 		if ((PROTO_CLASS(proto2) & C_PRIVATE) &&
1082 		    !(PROTO_CLASS(proto) & C_UNDEFINED)) {
1083 		    /* replace private undefined prototype by declaration */
1084 		    --nundefs;
1085 		}
1086 
1087 		i = PROTO_SIZE(proto);
1088 		progsize += i - PROTO_SIZE(proto2);
1089 		functions[fdef = (*h)->index].proto =
1090 			(char *) memcpy(REALLOC(proto2, char, 0, i), proto, i);
1091 		functions[fdef].func.class = PROTO_CLASS(proto);
1092 		if (functions[fdef].cfstr != (string *) NULL) {
1093 		    str_del(functions[fdef].cfstr);
1094 		}
1095 		functions[fdef].cfstr = class;
1096 		if (class != (string *) NULL) {
1097 		    str_ref(class);
1098 		}
1099 	    }
1100 	    return;
1101 	}
1102 
1103 	/*
1104 	 * redefinition of inherited function
1105 	 */
1106 	if ((*h)->ohash != (oh *) NULL) {
1107 	    ctrl = (*h)->ohash->obj->ctrl;
1108 	    proto2 = ctrl->prog + ctrl->funcdefs[(*h)->index].offset;
1109 	    if ((PROTO_CLASS(proto2) & C_UNDEFINED) &&
1110 		!cmp_proto(newctrl, proto, ctrl, proto2)) {
1111 		/*
1112 		 * declaration does not match inherited prototype
1113 		 */
1114 		c_error("inherited different prototype for %s (/%s)",
1115 			str->text, (*h)->ohash->chain.name);
1116 	    } else if ((PROTO_CLASS(proto) & C_UNDEFINED) &&
1117 		       (*h)->ohash->priv == 0 &&
1118 		       (ctrl->ninherits != 1 ||
1119 			(PROTO_CLASS(proto2) & (C_STATIC | C_UNDEFINED)) !=
1120 								    C_STATIC) &&
1121 		       PROTO_FTYPE(proto2) != T_IMPLICIT &&
1122 		       cmp_proto(newctrl, proto, ctrl, proto2)) {
1123 		/*
1124 		 * there is no point in replacing an identical prototype
1125 		 * that is not a static function in the auto object
1126 		 */
1127 		return;
1128 	    } else if ((PROTO_CLASS(proto2) & (C_NOMASK | C_UNDEFINED)) ==
1129 								    C_NOMASK) {
1130 		/*
1131 		 * attempt to redefine nomask function
1132 		 */
1133 		c_error("redeclaration of nomask function %s (/%s)",
1134 			str->text, (*h)->ohash->chain.name);
1135 	    }
1136 
1137 	    if ((*l)->ohash->priv != 0) {
1138 		l = (vfh **) &(*l)->chain.next;	/* skip private function */
1139 	    }
1140 	}
1141     }
1142 
1143     if (!(PROTO_CLASS(proto) & C_PRIVATE)) {
1144 	/*
1145 	 * may be a new symbol
1146 	 */
1147 	if (*l == (vfh *) NULL || strcmp((*l)->chain.name, str->text) != 0) {
1148 	    nsymbs++;		/* no previous symbol */
1149 	} else if ((*l)->ohash == (oh *) NULL) {
1150 	    if ((*l)->index == 0) {
1151 		nsymbs++;	/* previous functions all privately inherited */
1152 	    }
1153 	} else if ((*l)->ohash->priv != 0) {
1154 	    nsymbs++;		/* replace private function */
1155 	} else {
1156 	    ctrl = (*l)->ohash->obj->ctrl;
1157 	    proto2 = ctrl->prog + ctrl->funcdefs[(*l)->index].offset;
1158 	    if (ctrl->ninherits == 1 &&
1159 		(PROTO_CLASS(proto2) & (C_STATIC | C_UNDEFINED)) == C_STATIC) {
1160 		nsymbs++;	/* mask static function in auto object */
1161 	    }
1162 	}
1163     } else if (PROTO_CLASS(proto) & C_UNDEFINED) {
1164 	nundefs++;		/* private undefined prototype */
1165     }
1166 
1167     if (nfdefs == 255) {
1168 	c_error("too many functions declared");
1169     }
1170 
1171     /*
1172      * Actual definition.
1173      */
1174     vfh_new(str, newohash, -1, (string *) NULL, nfdefs, h);
1175     s = ctrl_dstring(str);
1176     i = PROTO_SIZE(proto);
1177     functions[nfdefs].name = str->text;
1178     functions[nfdefs].proto = (char *) memcpy(ALLOC(char, i), proto, i);
1179     functions[nfdefs].cfstr = class;
1180     if (class != (string *) NULL) {
1181 	str_ref(class);
1182     }
1183     functions[nfdefs].progsize = 0;
1184     progsize += i;
1185     func = &functions[nfdefs++].func;
1186     func->class = PROTO_CLASS(proto);
1187     func->inherit = s >> 16;
1188     func->index = s;
1189 }
1190 
1191 /*
1192  * NAME:	control->dfunc()
1193  * DESCRIPTION:	define a new function
1194  */
ctrl_dfunc(string * str,char * proto,string * class)1195 void ctrl_dfunc(string *str, char *proto, string *class)
1196 {
1197     fdef = nfdefs;
1198     ctrl_dproto(str, proto, class);
1199 }
1200 
1201 /*
1202  * NAME:	control->dprogram()
1203  * DESCRIPTION:	define a function body
1204  */
ctrl_dprogram(char * prog,unsigned int size)1205 void ctrl_dprogram(char *prog, unsigned int size)
1206 {
1207     functions[fdef].prog = prog;
1208     functions[fdef].progsize = size;
1209     progsize += size;
1210 }
1211 
1212 /*
1213  * NAME:	control->dvar()
1214  * DESCRIPTION:	define a variable
1215  */
ctrl_dvar(string * str,unsigned int class,unsigned int type,string * cvstr)1216 void ctrl_dvar(string *str, unsigned int class, unsigned int type, string *cvstr)
1217 {
1218     vfh **h;
1219     dvardef *var;
1220     char *p;
1221     long s;
1222 
1223     h = (vfh **) ht_lookup(vtab, str->text, FALSE);
1224     if (*h != (vfh *) NULL) {
1225 	if ((*h)->ohash == newohash) {
1226 	    c_error("redeclaration of variable %s", str->text);
1227 	    return;
1228 	} else if (!(class & C_PRIVATE)) {
1229 	    /*
1230 	     * non-private redeclaration of a variable
1231 	     */
1232 	    c_error("redeclaration of variable %s (/%s)", str->text,
1233 		    (*h)->ohash->chain.name);
1234 	    return;
1235 	}
1236     }
1237     if (nvars == 255 || newctrl->nvariables + nvars == MAX_VARIABLES) {
1238 	c_error("too many variables declared");
1239     }
1240 
1241     /* actually define the variable */
1242     vfh_new(str, newohash, type, cvstr, nvars, h);
1243     s = ctrl_dstring(str);
1244     var = &variables[nvars];
1245     var->class = class;
1246     var->inherit = s >> 16;
1247     var->index = s;
1248     var->type = type;
1249     cvstrings[nvars++] = cvstr;
1250     if (cvstr != (string *) NULL) {
1251 	str_ref(cvstr);
1252 	s = ctrl_dstring(cvstr);
1253 	p = classvars + nclassvars++ * 3;
1254 	*p++ = s >> 16;
1255 	*p++ = s >> 8;
1256 	*p = s;
1257     }
1258 }
1259 
1260 /*
1261  * NAME:	control->ifcall()
1262  * DESCRIPTION:	call an inherited function
1263  */
ctrl_ifcall(string * str,char * label,string ** cfstr,long * call)1264 char *ctrl_ifcall(string *str, char *label, string **cfstr, long *call)
1265 {
1266     control *ctrl;
1267     oh *ohash;
1268     short index;
1269     char *proto;
1270 
1271     *cfstr = (string *) NULL;
1272 
1273     if (label != (char *) NULL) {
1274 	dsymbol *symb;
1275 
1276 	/* first check if the label exists */
1277 	ohash = lab_find(label);
1278 	if (ohash == (oh *) NULL) {
1279 	    c_error("undefined label %s", label);
1280 	    return (char *) NULL;
1281 	}
1282 	symb = ctrl_symb(ctrl = ohash->obj->ctrl, str->text, str->len);
1283 	if (symb == (dsymbol *) NULL) {
1284 	    if (ctrl->ninherits != 1) {
1285 		ohash = inherits[0];
1286 		symb = ctrl_symb(ctrl = ohash->obj->ctrl, str->text, str->len);
1287 	    }
1288 	    if (symb == (dsymbol *) NULL) {
1289 		/*
1290 		 * It may seem strange to allow label::kfun, but remember that
1291 		 * they are supposed to be inherited by the auto object.
1292 		 */
1293 		index = kf_func(str->text);
1294 		if (index >= 0) {
1295 		    /* kfun call */
1296 		    *call = ((long) KFCALL << 24) | index;
1297 		    return KFUN(index).proto;
1298 		}
1299 		c_error("undefined function %s::%s", label, str->text);
1300 		return (char *) NULL;
1301 	    }
1302 	}
1303 	ohash = oh_new(OBJR(ctrl->inherits[UCHAR(symb->inherit)].oindex)->chain.name);
1304 	index = UCHAR(symb->index);
1305     } else {
1306 	vfh *h;
1307 
1308 	/* check if the function exists */
1309 	h = *(vfh **) ht_lookup(ftab, str->text, FALSE);
1310 	if (h == (vfh *) NULL || (h->ohash == newohash &&
1311 	    ((h=(vfh *) h->chain.next) == (vfh *) NULL ||
1312 	     strcmp(h->chain.name, str->text) != 0))) {
1313 
1314 	    index = kf_func(str->text);
1315 	    if (index >= 0) {
1316 		/* kfun call */
1317 		*call = ((long) KFCALL << 24) | index;
1318 		return KFUN(index).proto;
1319 	    }
1320 	    c_error("undefined function ::%s", str->text);
1321 	    return (char *) NULL;
1322 	}
1323 	ohash = h->ohash;
1324 	if (ohash == (oh *) NULL) {
1325 	    /*
1326 	     * call to multiple inherited function
1327 	     */
1328 	    c_error("ambiguous call to function ::%s", str->text);
1329 	    return (char *) NULL;
1330 	}
1331 	index = h->index;
1332 	label = "";
1333     }
1334 
1335     ctrl = ohash->obj->ctrl;
1336     if (ctrl->funcdefs[index].class & C_UNDEFINED) {
1337 	c_error("undefined function %s::%s", label, str->text);
1338 	return (char *) NULL;
1339     }
1340     *call = ((long) DFCALL << 24) | ((long) ohash->index << 8) | index;
1341     proto = ctrl->prog + ctrl->funcdefs[index].offset;
1342 
1343     if ((PROTO_FTYPE(proto) & T_TYPE) == T_CLASS) {
1344 	char *p;
1345 	Uint class;
1346 
1347 	p = &PROTO_FTYPE(proto) + 1;
1348 	FETCH3U(p, class);
1349 	*cfstr = d_get_strconst(ctrl, class >> 16, class & 0xffff);
1350     }
1351     return proto;
1352 }
1353 
1354 /*
1355  * NAME:	control->fcall()
1356  * DESCRIPTION:	call a function
1357  */
ctrl_fcall(string * str,string ** cfstr,long * call,int typechecking)1358 char *ctrl_fcall(string *str, string **cfstr, long *call, int typechecking)
1359 {
1360     vfh *h;
1361     char *proto;
1362 
1363     *cfstr = (string *) NULL;
1364 
1365     h = *(vfh **) ht_lookup(ftab, str->text, FALSE);
1366     if (h == (vfh *) NULL) {
1367 	static char uproto[] = { (char) C_UNDEFINED, 0, 0, 0, 6, T_IMPLICIT };
1368 	short kf;
1369 
1370 	/*
1371 	 * undefined function
1372 	 */
1373 	kf = kf_func(str->text);
1374 	if (kf >= 0) {
1375 	    /* kfun call */
1376 	    *call = ((long) KFCALL << 24) | kf;
1377 	    return KFUN(kf).proto;
1378 	}
1379 
1380 	/* create an undefined prototype for the function */
1381 	if (nfdefs == 255) {
1382 	    c_error("too many undefined functions");
1383 	    return (char *) NULL;
1384 	}
1385 	ctrl_dproto(str, proto = uproto, (string *) NULL);
1386 	h = *(vfh **) ht_lookup(ftab, str->text, FALSE);
1387     } else if (h->ohash == newohash) {
1388 	/*
1389 	 * call to new function
1390 	 */
1391 	proto = functions[h->index].proto;
1392 	*cfstr = functions[h->index].cfstr;
1393     } else if (h->ohash == (oh *) NULL) {
1394 	/*
1395 	 * call to multiple inherited function
1396 	 */
1397 	c_error("ambiguous call to function %s", str->text);
1398 	return (char *) NULL;
1399     } else {
1400 	control *ctrl;
1401 	char *p;
1402 	Uint class;
1403 
1404 	/*
1405 	 * call to inherited function
1406 	 */
1407 	ctrl = h->ohash->obj->ctrl;
1408 	proto = ctrl->prog + ctrl->funcdefs[h->index].offset;
1409 	if ((PROTO_FTYPE(proto) & T_TYPE) == T_CLASS) {
1410 	    p = &PROTO_FTYPE(proto) + 1;
1411 	    FETCH3U(p, class);
1412 	    *cfstr = d_get_strconst(ctrl, class >> 16, class & 0xffff);
1413 	}
1414     }
1415 
1416     if (typechecking && PROTO_FTYPE(proto) == T_IMPLICIT) {
1417 	/* don't allow calls to implicit prototypes when typechecking */
1418 	c_error("undefined function %s", str->text);
1419 	return (char *) NULL;
1420     }
1421 
1422     if (h->ohash->priv != 0 || (PROTO_CLASS(proto) & C_PRIVATE) ||
1423 	(PROTO_CLASS(proto) & (C_NOMASK | C_UNDEFINED)) == C_NOMASK ||
1424 	((PROTO_CLASS(proto) & (C_STATIC | C_UNDEFINED)) == C_STATIC &&
1425 	 h->ohash->index == 0)) {
1426 	/* direct call */
1427 	if (h->ohash->index == 0) {
1428 	    *call = ((long) DFCALL << 24) | h->index;
1429 	} else {
1430 	    *call = ((long) DFCALL << 24) | ((long) h->ohash->index << 8) | h->index;
1431 	}
1432     } else {
1433 	/* ordinary function call */
1434 	*call = ((long) FCALL << 24) | ((long) h->ohash->index << 8) | h->index;
1435     }
1436     return proto;
1437 }
1438 
1439 /*
1440  * NAME:	control->gencall()
1441  * DESCRIPTION:	generate a function call
1442  */
ctrl_gencall(long call)1443 unsigned short ctrl_gencall(long call)
1444 {
1445     vfh *h;
1446     char *name;
1447     short inherit, index;
1448 
1449     inherit = (call >> 8) & 0xff;
1450     index = call & 0xff;
1451     if (inherit == ninherits) {
1452 	name = functions[index].name;
1453     } else {
1454 	control *ctrl;
1455 	dfuncdef *f;
1456 
1457 	ctrl = OBJR(newctrl->inherits[inherit].oindex)->ctrl;
1458 	f = ctrl->funcdefs + index;
1459 	name = d_get_strconst(ctrl, f->inherit, f->index)->text;
1460     }
1461     h = *(vfh **) ht_lookup(ftab, name, FALSE);
1462     if (h->ct == (unsigned short) -1) {
1463 	/*
1464 	 * add to function call table
1465 	 */
1466 	if (fcchunksz == FCALL_CHUNK) {
1467 	    fcchunk *l;
1468 
1469 	    l = ALLOC(fcchunk, 1);
1470 	    l->next = fclist;
1471 	    fclist = l;
1472 	    fcchunksz = 0;
1473 	}
1474 	fclist->f[fcchunksz++] = name;
1475 	if (nifcalls + nfcalls == UINDEX_MAX) {
1476 	    c_error("too many function calls");
1477 	}
1478 	h->ct = nfcalls++;
1479     }
1480     return h->ct;
1481 }
1482 
1483 /*
1484  * NAME:	control->var()
1485  * DESCRIPTION:	handle a variable reference
1486  */
ctrl_var(string * str,long * ref,string ** cvstr)1487 unsigned short ctrl_var(string *str, long *ref, string **cvstr)
1488 {
1489     vfh *h;
1490 
1491     /* check if the variable exists */
1492     h = *(vfh **) ht_lookup(vtab, str->text, TRUE);
1493     if (h == (vfh *) NULL) {
1494 	c_error("undeclared variable %s", str->text);
1495 	if (nvars < 255) {
1496 	    /* don't repeat this error */
1497 	    ctrl_dvar(str, 0, T_MIXED, (string *) NULL);
1498 	}
1499 	return T_MIXED;
1500     }
1501 
1502     if (h->ohash->index == 0 && ninherits != 0) {
1503 	*ref = h->index;
1504     } else {
1505 	*ref = ((long) h->ohash->index << 8) | h->index;
1506     }
1507     *cvstr = h->cvstr;
1508     return h->ct;	/* the variable type */
1509 }
1510 
1511 /*
1512  * NAME:	ctrl->ninherits()
1513  * DESCRIPTION:	return the number of objects inherited
1514  */
ctrl_ninherits()1515 int ctrl_ninherits()
1516 {
1517     return ninherits;
1518 }
1519 
1520 
1521 /*
1522  * NAME:	control->chkfuncs()
1523  * DESCRIPTION:	check function definitions
1524  */
ctrl_chkfuncs()1525 bool ctrl_chkfuncs()
1526 {
1527     if (nundefs != 0) {
1528 	cfunc *f;
1529 	unsigned short i;
1530 
1531 	/*
1532 	 * private undefined prototypes
1533 	 */
1534 	c_error("undefined private functions:");
1535 	for (f = functions, i = nundefs; i != 0; f++) {
1536 	    if ((f->func.class & (C_PRIVATE | C_UNDEFINED)) ==
1537 						    (C_PRIVATE | C_UNDEFINED)) {
1538 		c_error("  %s", f->name);
1539 		--i;
1540 	    }
1541 	}
1542 	return FALSE;
1543     }
1544 
1545     if (nfclash != 0 || privinherit) {
1546 	hte **t;
1547 	unsigned short sz;
1548 	vfh **f, **n;
1549 	bool clash;
1550 
1551 	clash = FALSE;
1552 	for (t = ftab->table, sz = ftab->size; sz > 0; t++, --sz) {
1553 	    for (f = (vfh **) t; *f != (vfh *) NULL; ) {
1554 		if ((*f)->ohash == (oh *) NULL) {
1555 		    /*
1556 		     * clash marker found
1557 		     */
1558 		    if ((*f)->index <= 1) {
1559 			/*
1560 			 * erase clash which involves at most one function
1561 			 * that isn't privately inherited
1562 			 */
1563 			*f = (vfh *) (*f)->chain.next;
1564 		    } else {
1565 			/*
1566 			 * list a clash (only the first two)
1567 			 */
1568 			if (!clash) {
1569 			    clash = TRUE;
1570 			    c_error("inherited multiple instances of:");
1571 			}
1572 			f = (vfh **) &(*f)->chain.next;
1573 			while ((*f)->ohash->priv != 0) {
1574 			    f = (vfh **) &(*f)->chain.next;
1575 			}
1576 			n = (vfh **) &(*f)->chain.next;
1577 			while ((*n)->ohash->priv != 0) {
1578 			    n = (vfh **) &(*n)->chain.next;
1579 			}
1580 			c_error("  %s (/%s, /%s)", (*f)->chain.name,
1581 				(*f)->ohash->chain.name,
1582 				(*n)->ohash->chain.name);
1583 			f = (vfh **) &(*n)->chain.next;
1584 		    }
1585 		} else if ((*f)->ohash->priv != 0) {
1586 		    /*
1587 		     * skip privately inherited function
1588 		     */
1589 		    f = (vfh **) &(*f)->chain.next;
1590 		} else {
1591 		    n = (vfh **) &(*f)->chain.next;
1592 		    if (*n != (vfh *) NULL && (*n)->ohash != (oh *) NULL &&
1593 			(*n)->ohash->priv != 0) {
1594 			/* skip privately inherited function */
1595 			n = (vfh **) &(*n)->chain.next;
1596 		    }
1597 		    if (*n != (vfh *) NULL && (*n)->ohash == (oh *) NULL &&
1598 			strcmp((*n)->str->text, (*f)->str->text) == 0 &&
1599 			!(PROTO_CLASS(functions[(*f)->index].proto) &C_PRIVATE))
1600 		    {
1601 			/*
1602 			 * this function was redefined, skip the clash marker
1603 			 */
1604 			n = (vfh **) &(*n)->chain.next;
1605 		    }
1606 		    f = n;
1607 		}
1608 	    }
1609 	}
1610 	return !clash;
1611     }
1612 
1613     return TRUE;
1614 }
1615 
1616 
1617 /*
1618  * NAME:	control->mkstrings()
1619  * DESCRIPTION:	create the string table for the new control block
1620  */
ctrl_mkstrings()1621 static void ctrl_mkstrings()
1622 {
1623     string **s;
1624     strchunk *l, *f;
1625     unsigned short i;
1626     long strsize;
1627 
1628     strsize = 0;
1629     if ((newctrl->nstrings = nstrs) != 0) {
1630 	newctrl->strings = ALLOC(string*, newctrl->nstrings);
1631 	s = newctrl->strings + nstrs;
1632 	i = strchunksz;
1633 	for (l = str_list; l != (strchunk *) NULL; ) {
1634 	    while (i > 0) {
1635 		*--s = l->s[--i];	/* already referenced */
1636 		strsize += (*s)->len;
1637 	    }
1638 	    i = STRING_CHUNK;
1639 	    f = l;
1640 	    l = l->next;
1641 	    FREE(f);
1642 	}
1643 	str_list = (strchunk *) NULL;
1644 	strchunksz = i;
1645     }
1646     newctrl->strsize = strsize;
1647 }
1648 
1649 /*
1650  * NAME:	control->mkfuncs()
1651  * DESCRIPTION:	make the function definition table for the control block
1652  */
ctrl_mkfuncs()1653 static void ctrl_mkfuncs()
1654 {
1655     char *p;
1656     dfuncdef *d;
1657     cfunc *f;
1658     int i;
1659     unsigned int len;
1660 
1661     newctrl->progsize = progsize;
1662     if ((newctrl->nfuncdefs = nfdefs) != 0) {
1663 	p = newctrl->prog = ALLOC(char, progsize);
1664 	d = newctrl->funcdefs = ALLOC(dfuncdef, nfdefs);
1665 	f = functions;
1666 	for (i = nfdefs; i > 0; --i) {
1667 	    *d = f->func;
1668 	    d->offset = p - newctrl->prog;
1669 	    memcpy(p, f->proto, len = PROTO_SIZE(f->proto));
1670 	    p += len;
1671 	    if (f->progsize != 0) {
1672 		/* more than just a prototype */
1673 		memcpy(p, f->prog, f->progsize);
1674 		p += f->progsize;
1675 	    }
1676 	    d++;
1677 	    f++;
1678 	}
1679     }
1680 }
1681 
1682 /*
1683  * NAME:	control->mkvars()
1684  * DESCRIPTION:	make the variable definition table for the control block
1685  */
ctrl_mkvars()1686 static void ctrl_mkvars()
1687 {
1688     if ((newctrl->nvardefs = nvars) != 0) {
1689 	newctrl->vardefs = ALLOC(dvardef, nvars);
1690 	memcpy(newctrl->vardefs, variables, nvars * sizeof(dvardef));
1691 	if ((newctrl->nclassvars = nclassvars) != 0) {
1692 	    unsigned short i;
1693 	    string **s;
1694 
1695 	    newctrl->cvstrings = ALLOC(string*, nvars * sizeof(string*));
1696 	    memcpy(newctrl->cvstrings, cvstrings, nvars * sizeof(string*));
1697 	    for (i = nvars, s = newctrl->cvstrings; i != 0; --i, s++) {
1698 		if (*s != (string *) NULL) {
1699 		    str_ref(*s);
1700 		}
1701 	    }
1702 	    newctrl->classvars = ALLOC(char, nclassvars * 3);
1703 	    memcpy(newctrl->classvars, classvars, nclassvars * 3);
1704 	}
1705     }
1706 }
1707 
1708 /*
1709  * NAME:	control->mkfcalls()
1710  * DESCRIPTION:	make the function call table for the control block
1711  */
ctrl_mkfcalls()1712 static void ctrl_mkfcalls()
1713 {
1714     char *fc;
1715     int i;
1716     vfh *h;
1717     fcchunk *l;
1718     dinherit *inh;
1719     oh *ohash;
1720 
1721     newctrl->nfuncalls = nifcalls + nfcalls;
1722     if (newctrl->nfuncalls == 0) {
1723 	return;
1724     }
1725     fc = newctrl->funcalls = ALLOC(char, 2L * newctrl->nfuncalls);
1726     for (i = 0, inh = newctrl->inherits; i < ninherits; i++, inh++) {
1727 	/*
1728 	 * Walk through the list of inherited objects, starting with the auto
1729 	 * object, and fill in the function call table segment for each object
1730 	 * once.
1731 	 */
1732 	ohash = oh_new(OBJR(inh->oindex)->chain.name);
1733 	if (ohash->index == i) {
1734 	    char *ofc;
1735 	    dfuncdef *f;
1736 	    control *ctrl;
1737 	    object *obj;
1738 	    uindex j, n;
1739 
1740 	    /*
1741 	     * build the function call segment, based on the function call
1742 	     * table of the inherited object
1743 	     */
1744 	    ctrl = ohash->obj->ctrl;
1745 	    j = ctrl->ninherits - 1;
1746 	    ofc = d_get_funcalls(ctrl) + 2L * ctrl->inherits[j].funcoffset;
1747 	    for (n = ctrl->nfuncalls - ctrl->inherits[j].funcoffset; n > 0; --n)
1748 	    {
1749 		j = UCHAR(ofc[0]);
1750 		obj = OBJR(ctrl->inherits[j].oindex);
1751 		f = &obj->ctrl->funcdefs[UCHAR(ofc[1])];
1752 		if (inh->priv || (f->class & C_PRIVATE) ||
1753 		    (f->class & (C_NOMASK | C_UNDEFINED)) == C_NOMASK ||
1754 		    ((f->class & (C_STATIC | C_UNDEFINED)) == C_STATIC &&
1755 		     j == 0)) {
1756 		    /*
1757 		     * keep old call
1758 		     */
1759 		    if (j != 0) {
1760 			j = oh_new(obj->chain.name)->index;
1761 		    }
1762 		    *fc++ = j;
1763 		    *fc++ = ofc[1];
1764 		} else {
1765 		    h = *(vfh **) ht_lookup(ftab,
1766 					    d_get_strconst(obj->ctrl,
1767 							   f->inherit,
1768 							   f->index)->text,
1769 					    FALSE);
1770 		    if (h->ohash->index == ninherits &&
1771 			(functions[h->index].func.class & C_PRIVATE)) {
1772 			/*
1773 			 * private redefinition of (guaranteed non-private)
1774 			 * inherited function
1775 			 */
1776 			h = (vfh *) h->chain.next;
1777 		    }
1778 		    *fc++ = h->ohash->index;
1779 		    *fc++ = h->index;
1780 		}
1781 		ofc += 2;
1782 	    }
1783 	}
1784     }
1785 
1786     /*
1787      * Now fill in the function call entries for the object just compiled.
1788      */
1789     fc += 2L * nfcalls;
1790     i = fcchunksz;
1791     for (l = fclist; l != (fcchunk *) NULL; l = l->next) {
1792 	do {
1793 	    h = *(vfh **) ht_lookup(ftab, l->f[--i], FALSE);
1794 	    *--fc = h->index;
1795 	    *--fc = h->ohash->index;
1796 	} while (i != 0);
1797 	i = FCALL_CHUNK;
1798     }
1799 }
1800 
1801 /*
1802  * NAME:	control->mksymbs()
1803  * DESCRIPTION:	make the symbol table for the control block
1804  */
ctrl_mksymbs()1805 static void ctrl_mksymbs()
1806 {
1807     unsigned short i, n, x, ncoll;
1808     dsymbol *symtab, *coll;
1809     dinherit *inh;
1810 
1811     if ((newctrl->nsymbols = nsymbs) == 0) {
1812 	return;
1813     }
1814 
1815     /* initialize */
1816     symtab = newctrl->symbols = ALLOC(dsymbol, nsymbs);
1817     for (i = nsymbs; i > 0; --i) {
1818 	symtab->next = -1;	/* mark as unused */
1819 	symtab++;
1820     }
1821     symtab = newctrl->symbols;
1822     coll = ALLOCA(dsymbol, nsymbs);
1823     ncoll = 0;
1824 
1825     /*
1826      * Go down the list of inherited objects, adding the functions of each
1827      * object once.
1828      */
1829     for (i = 0, inh = newctrl->inherits; i <= ninherits; i++, inh++) {
1830 	dfuncdef *f;
1831 	control *ctrl;
1832 
1833 	if (i == ninherits) {
1834 	    ctrl = newctrl;
1835 	} else if (!inh->priv &&
1836 		   oh_new(OBJR(inh->oindex)->chain.name)->index == i) {
1837 	    ctrl = OBJR(inh->oindex)->ctrl;
1838 	} else {
1839 	    continue;
1840 	}
1841 
1842 	for (f = ctrl->funcdefs, n = 0; n < ctrl->nfuncdefs; f++, n++) {
1843 	    vfh *h;
1844 	    char *name;
1845 
1846 	    if ((f->class & C_PRIVATE) ||
1847 		(i == 0 && ninherits != 0 &&
1848 		 (f->class & (C_STATIC | C_UNDEFINED)) == C_STATIC)) {
1849 		continue;	/* not in symbol table */
1850 	    }
1851 	    name = d_get_strconst(ctrl, f->inherit, f->index)->text;
1852 	    h = *(vfh **) ht_lookup(ftab, name, FALSE);
1853 	    if (h->ohash->index == ninherits &&
1854 		(functions[h->index].func.class & C_PRIVATE)) {
1855 		/*
1856 		 * private redefinition of inherited function:
1857 		 * use inherited function
1858 		 */
1859 		h = (vfh *) h->chain.next;
1860 	    }
1861 	    while (h->ohash->priv != 0) {
1862 		/*
1863 		 * skip privately inherited function
1864 		 */
1865 		h = (vfh *) h->chain.next;
1866 	    }
1867 	    if (i == h->ohash->index) {
1868 		/*
1869 		 * all non-private functions are put into the hash table
1870 		 */
1871 		x = hashstr(name, VFMERGEHASHSZ) % nsymbs;
1872 		if (symtab[x].next == (unsigned short) -1) {
1873 		    /*
1874 		     * new entry
1875 		     */
1876 		    symtab[x].inherit = i;
1877 		    symtab[x].index = n;
1878 		    symtab[x].next = x;
1879 		} else {
1880 		    /*
1881 		     * collision
1882 		     */
1883 		    coll[ncoll].inherit = i;
1884 		    coll[ncoll].index = n;
1885 		    coll[ncoll++].next = x;
1886 		}
1887 		if (f->class & C_UNDEFINED) {
1888 		    newctrl->flags |= CTRL_UNDEFINED;
1889 		}
1890 	    }
1891 	}
1892     }
1893 
1894     /*
1895      * Now deal with the collisions.
1896      */
1897     n = 0;
1898     for (i = 0; i < ncoll; i++) {
1899 	/* find a free slot */
1900 	while (symtab[n].next != (unsigned short) -1) {
1901 	    n++;
1902 	}
1903 	x = coll[i].next;
1904 	/* add new entry to list */
1905 	symtab[n] = symtab[x];
1906 	if (symtab[n].next == x) {
1907 	    symtab[n].next = n;	/* adjust list terminator */
1908 	}
1909 	symtab[x].inherit = coll[i].inherit;
1910 	symtab[x].index = coll[i].index;
1911 	symtab[x].next = n++;	/* link to previous slot */
1912     }
1913 
1914     AFREE(coll);
1915 }
1916 
1917 /*
1918  * NAME:	ctrl->mkvtypes()
1919  * DESCRIPTION:	make the variable type table for the control block
1920  */
ctrl_mkvtypes(control * ctrl)1921 void ctrl_mkvtypes(control *ctrl)
1922 {
1923     char *type;
1924     unsigned short max, nv, n;
1925     dinherit *inh;
1926     dvardef *var;
1927 
1928     max = ctrl->nvariables - ctrl->nvardefs;
1929     if (max == 0) {
1930 	return;
1931     }
1932 
1933     ctrl->vtypes = type = ALLOC(char, max);
1934     for (nv = 0, inh = ctrl->inherits; nv != max; inh++) {
1935 	if (inh->varoffset == nv) {
1936 	    ctrl = o_control(OBJR(inh->oindex));
1937 	    for (n = ctrl->nvardefs, nv += n, var = d_get_vardefs(ctrl);
1938 		 n != 0; --n, var++) {
1939 		if (T_ARITHMETIC(var->type)) {
1940 		    *type++ = var->type;
1941 		} else {
1942 		    *type++ = nil_value.type;
1943 		}
1944 	    }
1945 	}
1946     }
1947 }
1948 
1949 /*
1950  * NAME:	control->symb()
1951  * DESCRIPTION:	return the entry in the symbol table for func, or NULL
1952  */
ctrl_symb(control * ctrl,char * func,unsigned int len)1953 dsymbol *ctrl_symb(control *ctrl, char *func, unsigned int len)
1954 {
1955     dsymbol *symb;
1956     dfuncdef *f;
1957     unsigned int i, j;
1958     string *str;
1959     dsymbol *symtab, *symb1;
1960     dinherit *inherits;
1961 
1962     if ((i=ctrl->nsymbols) == 0) {
1963 	return (dsymbol *) NULL;
1964     }
1965 
1966     inherits = ctrl->inherits;
1967     symtab = d_get_symbols(ctrl);
1968     i = hashstr(func, VFMERGEHASHSZ) % i;
1969     symb1 = symb = &symtab[i];
1970     ctrl = o_control(OBJR(inherits[UCHAR(symb->inherit)].oindex));
1971     f = d_get_funcdefs(ctrl) + UCHAR(symb->index);
1972     str = d_get_strconst(ctrl, f->inherit, f->index);
1973     if (len == str->len && memcmp(func, str->text, len) == 0) {
1974 	/* found it */
1975 	return (f->class & C_UNDEFINED) ? (dsymbol *) NULL : symb1;
1976     }
1977     while (i != symb->next) {
1978 	symb = &symtab[i = symb->next];
1979 	ctrl = o_control(OBJR(inherits[UCHAR(symb->inherit)].oindex));
1980 	f = d_get_funcdefs(ctrl) + UCHAR(symb->index);
1981 	str = d_get_strconst(ctrl, f->inherit, f->index);
1982 	if (len == str->len && memcmp(func, str->text, len) == 0) {
1983 	    /* found it: put symbol first in linked list */
1984 	    i = symb1->inherit;
1985 	    j = symb1->index;
1986 	    symb1->inherit = symb->inherit;
1987 	    symb1->index = symb->index;
1988 	    symb->inherit = i;
1989 	    symb->index = j;
1990 	    return (f->class & C_UNDEFINED) ? (dsymbol *) NULL : symb1;
1991 	}
1992     }
1993     return (dsymbol *) NULL;
1994 }
1995 
1996 /*
1997  * NAME:	control->construct()
1998  * DESCRIPTION:	construct and return a control block for the object just
1999  *		compiled
2000  */
ctrl_construct()2001 control *ctrl_construct()
2002 {
2003     control *ctrl;
2004 
2005     ctrl = newctrl;
2006     ctrl->nvariables += nvars;
2007 
2008     ctrl_mkstrings();
2009     ctrl_mkfuncs();
2010     ctrl_mkvars();
2011     ctrl_mkfcalls();
2012     ctrl_mksymbs();
2013     ctrl_mkvtypes(ctrl);
2014     ctrl->compiled = P_time();
2015 
2016     newctrl = (control *) NULL;
2017     return ctrl;
2018 }
2019 
2020 /*
2021  * NAME:	control->clear()
2022  * DESCRIPTION:	clean up
2023  */
ctrl_clear()2024 void ctrl_clear()
2025 {
2026     oh_clear();
2027     vfh_clear();
2028     if (vtab != (hashtab *) NULL) {
2029 	ht_del(vtab);
2030 	ht_del(ftab);
2031 	vtab = (hashtab *) NULL;
2032 	ftab = (hashtab *) NULL;
2033     }
2034     lab_clear();
2035 
2036     ninherits = 0;
2037     privinherit = FALSE;
2038     nsymbs = 0;
2039     nfclash = 0;
2040     nifcalls = 0;
2041     nundefs = 0;
2042 
2043     if (newctrl != (control *) NULL) {
2044 	d_del_control(newctrl);
2045 	newctrl = (control *) NULL;
2046     }
2047     str_clear();
2048     while (str_list != (strchunk *) NULL) {
2049 	strchunk *l;
2050 	string **s;
2051 
2052 	l = str_list;
2053 	s = &l->s[strchunksz];
2054 	while (--strchunksz >= 0) {
2055 	    str_del(*--s);
2056 	}
2057 	strchunksz = STRING_CHUNK;
2058 	str_list = l->next;
2059 	FREE(l);
2060     }
2061     while (fclist != (fcchunk *) NULL) {
2062 	fcchunk *l;
2063 
2064 	l = fclist;
2065 	fclist = l->next;
2066 	FREE(l);
2067     }
2068     fcchunksz = FCALL_CHUNK;
2069     if (functions != (cfunc *) NULL) {
2070 	int i;
2071 	cfunc *f;
2072 
2073 	for (i = nfdefs, f = functions; i > 0; --i, f++) {
2074 	    FREE(f->proto);
2075 	    if (f->progsize != 0) {
2076 		FREE(f->prog);
2077 	    }
2078 	    if (f->cfstr != (string *) NULL) {
2079 		str_del(f->cfstr);
2080 	    }
2081 	}
2082 	FREE(functions);
2083 	functions = (cfunc *) NULL;
2084     }
2085     if (variables != (dvardef *) NULL) {
2086 	FREE(variables);
2087 	variables = (dvardef *) NULL;
2088     }
2089     if (cvstrings != (string **) NULL) {
2090 	unsigned short i;
2091 	string **s;
2092 
2093 	for (i = nvars, s = cvstrings; i != 0; --i, s++) {
2094 	    if (*s != (string *) NULL) {
2095 		str_del(*s);
2096 	    }
2097 	}
2098 	FREE(cvstrings);
2099 	cvstrings = (string **) NULL;
2100     }
2101     if (classvars != (char *) NULL) {
2102 	FREE(classvars);
2103 	classvars = (char *) NULL;
2104     }
2105 }
2106 
2107 /*
2108  * NAME:	control->varmap()
2109  * DESCRIPTION:	create a variable mapping from the old control block to the new
2110  */
ctrl_varmap(control * old,control * new)2111 unsigned short *ctrl_varmap(control *old, control *new)
2112 {
2113     unsigned short j, k;
2114     dvardef *v;
2115     long n;
2116     unsigned short *vmap;
2117     dinherit *inh, *inh2;
2118     control *ctrl, *ctrl2;
2119     unsigned short i, voffset;
2120 
2121     /*
2122      * make variable mapping from old to new, with new just compiled
2123      */
2124 
2125     vmap = ALLOC(unsigned short, new->nvariables + 1);
2126 
2127     voffset = 0;
2128     for (i = new->ninherits, inh = new->inherits; i > 0; --i, inh++) {
2129 	ctrl = (i == 1) ? new : OBJR(inh->oindex)->ctrl;
2130 	if (inh->varoffset < voffset || ctrl->nvardefs == 0) {
2131 	    continue;
2132 	}
2133 	voffset = inh->varoffset + ctrl->nvardefs;
2134 
2135 	j = old->ninherits;
2136 	for (inh2 = old->inherits; ; inh2++) {
2137 	    if (strcmp(OBJR(inh->oindex)->chain.name,
2138 		       OBJR(inh2->oindex)->chain.name) == 0) {
2139 		/*
2140 		 * put var names from old control block in string merge table
2141 		 */
2142 		str_merge();
2143 		ctrl2 = o_control(OBJR(inh2->oindex));
2144 		v = d_get_vardefs(ctrl2);
2145 		for (k = 0; k < ctrl2->nvardefs; k++, v++) {
2146 		    str_put(d_get_strconst(ctrl2, v->inherit, v->index),
2147 			    ((Uint) k << 8) | v->type);
2148 		}
2149 
2150 		/*
2151 		 * map new variables to old ones
2152 		 */
2153 		for (k = 0, v = d_get_vardefs(ctrl); k < ctrl->nvardefs;
2154 		     k++, v++) {
2155 		    n = str_put(d_get_strconst(ctrl, v->inherit, v->index),
2156 				(Uint) 0);
2157 		    if (n != 0 &&
2158 			(((n & 0xff) == v->type &&
2159 			  ((n & T_TYPE) != T_CLASS ||
2160 			   str_cmp(ctrl->cvstrings[k],
2161 				   ctrl2->cvstrings[n >> 8]) == 0)) ||
2162 			 ((v->type & T_REF) <= (n & T_REF) &&
2163 			  (v->type & T_TYPE) == T_MIXED))) {
2164 			*vmap = inh2->varoffset + (n >> 8);
2165 		    } else {
2166 			switch (v->type) {
2167 			case T_INT:
2168 			    *vmap = NEW_INT;
2169 			    break;
2170 
2171 			case T_FLOAT:
2172 			    *vmap = NEW_FLOAT;
2173 			    break;
2174 
2175 			default:
2176 			    *vmap = NEW_POINTER;
2177 			    break;
2178 			}
2179 		    }
2180 		    vmap++;
2181 		}
2182 		str_clear();
2183 		break;
2184 	    }
2185 
2186 	    if (--j == 0) {
2187 		/*
2188 		 * new inherited object
2189 		 */
2190 		for (k = 0, v = d_get_vardefs(ctrl); k < ctrl->nvardefs;
2191 		     k++, v++) {
2192 		    switch (v->type) {
2193 		    case T_INT:
2194 			*vmap = NEW_INT;
2195 			break;
2196 
2197 		    case T_FLOAT:
2198 			*vmap = NEW_FLOAT;
2199 			break;
2200 
2201 		    default:
2202 			*vmap = NEW_POINTER;
2203 			break;
2204 		    }
2205 		    vmap++;
2206 		}
2207 		break;
2208 	    }
2209 	}
2210     }
2211 
2212     /*
2213      * check if any variable changed
2214      */
2215     *vmap = old->nvariables;
2216     vmap -= new->nvariables;
2217     if (old->nvariables != new->nvariables) {
2218 	return vmap;		/* changed */
2219     }
2220     for (i = 0; i <= new->nvariables; i++) {
2221 	if (vmap[i] != i) {
2222 	    return vmap;	/* changed */
2223 	}
2224     }
2225     /* no variable remapping needed */
2226     FREE(vmap);
2227     return (unsigned short *) NULL;
2228 }
2229 
2230 /*
2231  * NAME:	control->undefined()
2232  * DESCRIPTION:	list the undefined functions in a program
2233  */
ctrl_undefined(dataspace * data,control * ctrl)2234 array *ctrl_undefined(dataspace *data, control *ctrl)
2235 {
2236     typedef struct {
2237 	short count;		/* number of undefined functions */
2238 	short index;		/* index in inherits list */
2239     } ulist;
2240     ulist *u, *list;
2241     short i;
2242     dsymbol *symb;
2243     dfuncdef *f;
2244     value *v;
2245     object *obj;
2246     dinherit *inherits;
2247     dsymbol *symtab;
2248     unsigned short nsymbols;
2249     long size;
2250     array *m;
2251 
2252     list = ALLOCA(ulist, ctrl->ninherits);
2253     memset(list, '\0', ctrl->ninherits * sizeof(ulist));
2254     inherits = ctrl->inherits;
2255     symtab = d_get_symbols(ctrl);
2256     nsymbols = ctrl->nsymbols;
2257     size = 0;
2258 
2259     /*
2260      * count the number of undefined functions per program
2261      */
2262     for (i = nsymbols, symb = symtab; i != 0; --i, symb++) {
2263 	obj = OBJR(inherits[UCHAR(symb->inherit)].oindex);
2264 	ctrl = (O_UPGRADING(obj)) ? OBJR(obj->prev)->ctrl : o_control(obj);
2265 	if ((d_get_funcdefs(ctrl)[UCHAR(symb->index)].class & C_UNDEFINED) &&
2266 	    list[UCHAR(symb->inherit)].count++ == 0) {
2267 	    list[UCHAR(symb->inherit)].index = size;
2268 	    size += 2;
2269 	}
2270     }
2271 
2272     m = (array *) NULL;
2273     if (ec_push((ec_ftn) NULL)) {
2274 	if (m != (array *) NULL) {
2275 	    /* discard mapping */
2276 	    arr_ref(m);
2277 	    arr_del(m);
2278 	}
2279 	AFREE(list);
2280 	error((char *) NULL);	/* pass on error */
2281     }
2282     m = map_new(data, size);
2283     memset(m->elts, '\0', size * sizeof(value));
2284     for (i = nsymbols, symb = symtab; i != 0; --i, symb++) {
2285 	obj = OBJR(inherits[UCHAR(symb->inherit)].oindex);
2286 	ctrl = (O_UPGRADING(obj)) ? OBJR(obj->prev)->ctrl : o_control(obj);
2287 	f = d_get_funcdefs(ctrl) + UCHAR(symb->index);
2288 	if (f->class & C_UNDEFINED) {
2289 	    u = &list[UCHAR(symb->inherit)];
2290 	    v = &m->elts[u->index];
2291 	    if (v->u.string == (string *) NULL) {
2292 		string *str;
2293 		unsigned short len;
2294 
2295 		len = strlen(obj->chain.name);
2296 		str = str_new((char *) NULL, len + 1L);
2297 		str->text[0] = '/';
2298 		memcpy(str->text + 1, obj->chain.name, len);
2299 		PUT_STRVAL(v, str);
2300 		PUT_ARRVAL(v + 1, arr_ext_new(data, (long) u->count));
2301 		u->count = 0;
2302 	    }
2303 	    v = &v[1].u.array->elts[u->count++];
2304 	    PUT_STRVAL(v, d_get_strconst(ctrl, f->inherit, f->index));
2305 	}
2306     }
2307     ec_pop();
2308     AFREE(list);
2309 
2310     map_sort(m);
2311     return m;
2312 }
2313