|
|
1.1 root 1: #include "cem.h"
2: #define STD_OBJ 1
3: #include "stdobj.h"
4: #include "types.h"
5: #include "symbol.h"
6: #include "type.h"
7: #include "var.h"
8:
9: /*
10: * Type equivalence routines.
11: */
12:
13: /*
14: * Does p differ from q because of a file modtime difference?
15: */
16: int
17: different_vintage(p, q)
18: register type *p;
19: register type *q;
20: {
21: register char *s;
22: register char *t;
23:
24: loop
25: {
26: if (p->t_type != q->t_type)
27: return 0;
28:
29: switch (p->t_type)
30: {
31: case t_arrayof:
32: if (p->d.size != q->d.size)
33: return 0;
34:
35: case t_dimless:
36: case t_ftnreturning:
37: case t_ptrto:
38: p = p->t_subtype;
39: q = q->t_subtype;
40: continue;
41:
42: case t_basetype:
43: case t_bitfield:
44: return 0;
45:
46: case t_enum:
47: s = p->d.e->e_file->sy_name;
48: t = q->d.e->e_file->sy_name;
49: break;
50:
51: case t_structof:
52: s = p->d.s->s_file->sy_name;
53: t = q->d.s->s_file->sy_name;
54: break;
55:
56: case t_unionof:
57: s = p->d.u->u_file->sy_name;
58: t = q->d.u->u_file->sy_name;
59: break;
60:
61: default:
62: fprintf(stderr, "%s: bad type in different_vintage\n", my_name);
63: exit(1);
64: }
65:
66: if (s == t)
67: return 0;
68:
69: while (*s++ == *t)
70: {
71: if (*t++ == TIME_SEP)
72: return 1;
73: }
74:
75: return 0;
76: }
77: }
78:
79: /*
80: * Is p an elaboration of q (complex type as base).
81: */
82: int
83: complex_elaboration(p, q)
84: register type *p;
85: register type *q;
86: {
87: register symbol *s;
88: register symbol *t;
89:
90: loop
91: {
92: if (p->t_type != q->t_type)
93: return 0;
94:
95: switch (p->t_type)
96: {
97: case t_arrayof:
98: if (p->d.size != q->d.size)
99: return 0;
100:
101: case t_dimless:
102: case t_ftnreturning:
103: case t_ptrto:
104: p = p->t_subtype;
105: q = q->t_subtype;
106: continue;
107:
108: case t_basetype:
109: case t_bitfield:
110: return 0;
111:
112: case t_enum:
113: if (p->d.e->e_list == NULL || q->d.e->e_list != NULL)
114: return 0;
115:
116: s = p->d.e->e_name;
117: t = q->d.e->e_name;
118: break;
119:
120: case t_structof:
121: if (p->d.s->s_list == NULL || q->d.s->s_list != NULL)
122: return 0;
123:
124: s = p->d.s->s_name;
125: t = q->d.s->s_name;
126: break;
127:
128: case t_unionof:
129: if (p->d.u->u_list == NULL || q->d.u->u_list != NULL)
130: return 0;
131:
132: s = p->d.u->u_name;
133: t = q->d.u->u_name;
134: break;
135:
136: default:
137: fprintf(stderr, "%s: bad type in complex_elaboration\n", my_name);
138: exit(1);
139: }
140:
141: return s == t || s == NULL;
142: }
143: }
144:
145: /*
146: * Is p an elaboration of q (a dimensionless array).
147: */
148: int
149: array_elaboration(p, q)
150: register type *p;
151: register type *q;
152: {
153: return p->t_type == t_arrayof && q->t_type == t_dimless && p->t_subtype == q->t_subtype;
154: }
155:
156: /*
157: * Can t be coerced (silently) to u (reflexive).
158: */
159: int
160: coercible(t, u)
161: type *t;
162: type *u;
163: {
164: register int e;
165: register int b;
166:
167: if (pedantic)
168: return 0;
169:
170: switch (t->t_type)
171: {
172: case t_basetype:
173: if ((t->d.mask & FLOAT) != 0)
174: return 0;
175:
176: b = 1;
177: e = 0;
178: break;
179:
180: case t_enum:
181: b = 0;
182: e = 1;
183: break;
184:
185: default:
186: return 0;
187: }
188:
189: switch (u->t_type)
190: {
191: case t_basetype:
192: if ((u->d.mask & FLOAT) != 0)
193: return 0;
194:
195: b++;
196: break;
197:
198: case t_enum:
199: e++;
200: break;
201:
202: default:
203: return 0;
204: }
205:
206: if (b == 2)
207: return (t->d.mask & ~UNSIGNED) == (u->d.mask & ~UNSIGNED);
208:
209: return e != 2;
210: }
211:
212: static int really_compatible();
213:
214: /*
215: * Struct/union member compatible.
216: */
217: static int
218: member_compatible(p, q)
219: type *p;
220: type *q;
221: {
222: if (p == q)
223: return 1;
224:
225: return really_compatible(p, q);
226: }
227:
228: /*
229: * Is p compatible with q (reflexive).
230: */
231: static int
232: really_compatible(p, q)
233: register type *p;
234: register type *q;
235: {
236: typedef struct busy busy;
237:
238: struct busy
239: {
240: type *b_p;
241: type *b_q;
242: busy *b_next;
243: };
244:
245: busy this;
246: static busy *busy_list;
247:
248: loop
249: {
250: if (p->t_type != q->t_type)
251: {
252: if (p->t_type == t_arrayof || p->t_type == t_dimless)
253: p = p->t_subtype;
254: else
255: return 0;
256:
257: if (q->t_type == t_arrayof || q->t_type == t_dimless)
258: q = q->t_subtype;
259: else
260: return 0;
261:
262: /*
263: * If the types are now equal one is an array
264: * elaboration of the other.
265: */
266: if (p == q)
267: return 1;
268:
269: continue;
270: }
271:
272: switch (p->t_type)
273: {
274: case t_arrayof:
275: if (p->d.size != q->d.size)
276: return 0;
277:
278: case t_dimless:
279: case t_ftnreturning:
280: case t_ptrto:
281: p = p->t_subtype;
282: q = q->t_subtype;
283: break;
284:
285: case t_basetype:
286: case t_bitfield:
287: return 0;
288:
289: case t_enum:
290: if
291: (
292: p->d.e->e_name != q->d.e->e_name
293: &&
294: p->d.e->e_name != NULL
295: &&
296: q->d.e->e_name != NULL
297: )
298: return 0;
299:
300: if (p->d.e->e_list == NULL || q->d.e->e_list == NULL)
301: return 1;
302:
303: return 0;
304:
305: case t_structof:
306: if
307: (
308: p->d.s->s_name != q->d.s->s_name
309: &&
310: p->d.s->s_name != NULL
311: &&
312: q->d.s->s_name != NULL
313: )
314: return 0;
315:
316: if (p->d.s->s_list == NULL || q->d.s->s_list == NULL)
317: return 1;
318:
319: if (p->d.s->s_size != q->d.s->s_size)
320: return 0;
321:
322: {
323: register busy *sb;
324:
325: for (sb = busy_list; sb != NULL; sb = sb->b_next)
326: {
327: if
328: (
329: sb->b_p == p && sb->b_q == q
330: ||
331: sb->b_p == q && sb->b_q == p
332: )
333: return 1;
334: }
335: }
336:
337: if (modtimes && p->d.s->s_line == q->d.s->s_line && match_times(p->d.s->s_file, q->d.s->s_file))
338: return 1;
339:
340: this.b_p = p;
341: this.b_q = q;
342: this.b_next = busy_list;
343: busy_list = &this;
344:
345: {
346: register s_elt *a;
347: register s_elt *b;
348:
349: a = p->d.s->s_list;
350: b = q->d.s->s_list;
351:
352: while (a != NULL)
353: {
354: if (b == NULL || !member_compatible(a->s_type, b->s_type))
355: {
356: busy_list = this.b_next;
357: return 0;
358: }
359:
360: a = a->s_next;
361: b = b->s_next;
362: }
363:
364: busy_list = this.b_next;
365: return b == NULL;
366: }
367:
368: case t_unionof:
369: if
370: (
371: p->d.u->u_name != q->d.u->u_name
372: &&
373: p->d.u->u_name != NULL
374: &&
375: q->d.u->u_name != NULL
376: )
377: return 0;
378:
379: if (p->d.u->u_list == NULL || q->d.u->u_list == NULL)
380: return 1;
381:
382: if (p->d.u->u_size != q->d.u->u_size)
383: return 0;
384:
385: {
386: register busy *ub;
387:
388: for (ub = busy_list; ub != NULL; ub = ub->b_next)
389: {
390: if
391: (
392: ub->b_p == p && ub->b_q == q
393: ||
394: ub->b_p == q && ub->b_q == p
395: )
396: return 1;
397: }
398: }
399:
400: if (modtimes && p->d.u->u_line == q->d.u->u_line && match_times(p->d.u->u_file, q->d.u->u_file))
401: return 1;
402:
403: this.b_p = p;
404: this.b_q = q;
405: this.b_next = busy_list;
406: busy_list = &this;
407:
408: {
409: register u_elt *a;
410: register u_elt *b;
411:
412: a = p->d.u->u_list;
413: b = q->d.u->u_list;
414:
415: while (a != NULL)
416: {
417: if (b == NULL || !member_compatible(a->u_type, b->u_type))
418: {
419: busy_list = this.b_next;
420: return 0;
421: }
422:
423: a = a->u_next;
424: b = b->u_next;
425: }
426:
427: busy_list = this.b_next;
428: return b == NULL;
429: }
430:
431: default:
432: fprintf(stderr, "%s: bad type in really_compatible\n", my_name);
433: exit(1);
434: }
435: }
436: }
437:
438: int
439: compatible_arglist(a, b, v)
440: register arg *a;
441: register arg *b;
442: int v;
443: {
444: register args *p;
445: register args *q;
446: register int n;
447:
448: if (v < 0)
449: {
450: if (a->a_count != b->a_count)
451: return 0;
452:
453: n = a->a_count;
454: }
455: else
456: {
457: if (b->a_count < v)
458: return 0;
459:
460: n = v;
461: }
462:
463: p = a->a_head;
464: q = b->a_head;
465:
466: while (--n >= 0)
467: {
468: if (p->a_type != q->a_type && !compatible(p->a_type, q->a_type))
469: return 0;
470:
471: p = p->a_next;
472: q = q->a_next;
473: }
474:
475: return 1;
476: }
477:
478: int
479: coercible_arglist(a, b, v)
480: register arg *a;
481: register arg *b;
482: int v;
483: {
484: register args *p;
485: register args *q;
486: register int n;
487:
488: if (v < 0)
489: {
490: if (a->a_count != b->a_count)
491: return 0;
492:
493: n = a->a_count;
494: }
495: else
496: {
497: if (b->a_count < v)
498: return 0;
499:
500: n = v;
501: }
502:
503: p = a->a_head;
504: q = b->a_head;
505:
506: while (--n >= 0)
507: {
508: if (p->a_type != q->a_type && !coercible(p->a_type, q->a_type))
509: return 0;
510:
511: p = p->a_next;
512: q = q->a_next;
513: }
514:
515: return 1;
516: }
517:
518: /*
519: * We win a lot by hashing previous results.
520: */
521: #define CHASHSZ 37
522: #define CPRIME0 7
523: #define CPRIME1 31
524:
525: /*
526: * 'compatible' hashing by type indices.
527: */
528: static int
529: hash_compatible(h0, h1, r)
530: long h0;
531: long h1;
532: int r;
533: {
534: typedef struct chash chash;
535:
536: struct chash
537: {
538: long h0;
539: long h1;
540: int r;
541: chash *left;
542: chash *right;
543: };
544:
545: register long i;
546: register long j;
547: register chash **n;
548: static chash *chasht[CHASHSZ];
549:
550: i = CPRIME0 * h0 + CPRIME1 * h1;
551:
552: if (i < 0)
553: j = -i % CHASHSZ;
554: else
555: j = i % CHASHSZ;
556:
557: n = &chasht[j];
558:
559: while (*n != NULL)
560: {
561: j = CPRIME0 * (*n)->h0 + CPRIME1 * (*n)->h1 - i;
562:
563: if (j == 0 && (*n)->h0 == h0 && (*n)->h1 == h1)
564: return (*n)->r;
565:
566: n = j > 0 ? &(*n)->left : &(*n)->right;
567: }
568:
569: if (r >= 0)
570: {
571: *n = talloc(chash);
572: (*n)->h0 = h0;
573: (*n)->h1 = h1;
574: (*n)->r = r;
575: (*n)->left = NULL;
576: (*n)->right = NULL;
577: }
578:
579: return r;
580: }
581:
582: /*
583: * Is p compatible with q (reflexive). This includes coercible.
584: */
585: int
586: compatible(p, q)
587: type *p;
588: type *q;
589: {
590: register int ret;
591:
592: if (coercible(p, q))
593: return 1;
594:
595: if
596: (
597: (ret = hash_compatible(p->t_index, q->t_index, -1)) < 0
598: &&
599: (ret = hash_compatible(q->t_index, p->t_index, -1)) < 0
600: )
601: {
602: ret = really_compatible(p, q);
603: hash_compatible(p->t_index, q->t_index, ret);
604: }
605:
606: return ret;
607: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.