|
|
1.1 root 1: #include "cem.h"
2: #define STD_OBJ 1
3: #include "stdobj.h"
4: #include "types.h"
5: #include "equiv.h"
6: #include "symbol.h"
7: #include "type.h"
8: #include "var.h"
9:
10: /*
11: * Variable routines.
12: */
13:
14: static long new_var_index = 1;
15:
16: /*
17: * We keep a cache of data objects rather than allowing malloc
18: * to inefficiently recycle them.
19: */
20: static arg *arg_free;
21: static args *args_free;
22: static var *var_free;
23:
24: /*
25: * Allocation routines.
26: */
27: static var *
28: new_var()
29: {
30: register var *p;
31:
32: if (var_free == NULL)
33: return talloc(var);
34:
35: p = var_free;
36: var_free = p->v_next;
37: return p;
38: }
39:
40: static void
41: free_arglist(a)
42: register arg *a;
43: {
44: register args *p;
45: register args *q;
46:
47: for (p = a->a_head; p != NULL; p = q)
48: {
49: q = p->a_next;
50: p->a_next = args_free;
51: args_free = p;
52: }
53:
54: a->a_next = arg_free;
55: arg_free = a;
56: }
57:
58: static arg *
59: new_arg()
60: {
61: register arg *p;
62:
63: if ((p = arg_free) == NULL)
64: p = talloc(arg);
65: else
66: arg_free = p->a_next;
67:
68: p->a_head = NULL;
69: p->a_tail = &p->a_head;
70: p->a_count = 0;
71: p->a_next = NULL;
72: return p;
73: }
74:
75: static void
76: free_arguments(a)
77: register arg *a;
78: {
79: register arg *b;
80:
81: while (a != NULL)
82: {
83: b = a->a_next;
84: free_arglist(a);
85: a = b;
86: }
87: }
88:
89: static void
90: add_argument(a, t)
91: register arg *a;
92: type *t;
93: {
94: register args *p;
95:
96: if ((p = args_free) == NULL)
97: p = talloc(args);
98: else
99: args_free = p->a_next;
100:
101: p->a_type = t;
102: p->a_next = NULL;
103: *a->a_tail = p;
104: a->a_tail = &p->a_next;
105: a->a_count++;
106: }
107:
108: /*
109: * Make a declaration.
110: */
111: static var *
112: declare(v, n, t, f, l)
113: obj_vars v;
114: symbol *n;
115: type *t;
116: symbol *f;
117: long l;
118: {
119: register var *p;
120:
121: p = new_var();
122: p->v_what = v;
123: p->v_name = n;
124: p->v_type = t;
125: p->v_file = f;
126: p->v_line = l;
127: p->v_ifile = NULL;
128: p->v_varargs = -1;
129: p->v_argdefn = NULL;
130: p->v_args = NULL;
131: p->v_tail = &p->v_args;
132: p->v_next = NULL;
133: return p;
134: }
135:
136: /*
137: * Set array size.
138: */
139: static void
140: array_size(p, t)
141: var *p;
142: type *t;
143: {
144: p->v_type = t;
145: }
146:
147: /*
148: * Note initialisation.
149: */
150: static void
151: initialisation(p, f, l)
152: var *p;
153: symbol *f;
154: long l;
155: {
156: p->v_ifile = f;
157: p->v_iline = l;
158: }
159:
160: /*
161: * Note varargs count.
162: */
163: static void
164: set_varargs(p, l)
165: var *p;
166: long l;
167: {
168: p->v_varargs = l;
169: }
170:
171: /*
172: * Add an instance of a variable to the symbol table instance list.
173: */
174: static void
175: add_instance(v)
176: register var *v;
177: {
178: register inst *p;
179: register defn *d;
180: register init *i;
181:
182: /*
183: * Don't let library definitions override.
184: */
185: if (in_lib && v->v_name->sy_inst != NULL && v->v_name->sy_inst->i_init)
186: return;
187:
188: if ((p = v->v_name->sy_inst) == NULL)
189: {
190: p = talloc(inst);
191: v->v_name->sy_inst = p;
192: p->i_argdefn = v->v_argdefn;
193:
194: if ((p->i_args = v->v_args) == NULL)
195: p->i_tail = &p->i_args;
196: else
197: p->i_tail = v->v_tail;
198:
199: d = talloc(defn);
200: p->i_defn = d;
201: p->i_init = NULL;
202: p->i_name = v->v_name;
203: d->d_what = v->v_what;
204: d->d_type = v->v_type;
205:
206: if (in_lib)
207: {
208: d->d_file = src_file;
209: d->d_line = 0;
210: }
211: else
212: {
213: d->d_file = v->v_file;
214: d->d_line = v->v_line;
215: }
216:
217: d->d_next = NULL;
218: p->i_next = global_list;
219: global_list = p;
220: }
221: else
222: {
223: if (v->v_argdefn != NULL)
224: p->i_argdefn = v->v_argdefn;
225:
226: if ((*p->i_tail = v->v_args) != NULL)
227: p->i_tail = v->v_tail;
228:
229: d = p->i_defn;
230:
231: loop
232: {
233: if (d == NULL)
234: {
235: d = talloc(defn);
236: d->d_next = p->i_defn;
237: p->i_defn = d;
238:
239: elab:
240: d->d_what = v->v_what;
241: d->d_type = v->v_type;
242:
243: if (in_lib)
244: {
245: d->d_file = src_file;
246: d->d_line = 0;
247: }
248: else
249: {
250: d->d_file = v->v_file;
251: d->d_line = v->v_line;
252: }
253:
254: break;
255: }
256:
257: if (d->d_type == v->v_type)
258: break;
259:
260: if (complex_elaboration(v->v_type, d->d_type))
261: goto elab;
262:
263: if (array_elaboration(v->v_type, d->d_type))
264: goto elab;
265:
266: if (compatible(d->d_type, v->v_type))
267: break;
268:
269: d = d->d_next;
270: }
271: }
272:
273: if (v->v_ifile != NULL)
274: {
275: i = talloc(init);
276:
277: if (in_lib)
278: {
279: i->i_file = src_file;
280: i->i_line = 0;
281: }
282: else
283: {
284: i->i_file = v->v_ifile;
285: i->i_line = v->v_iline;
286: }
287:
288: i->i_varargs = v->v_varargs;
289: i->i_next = p->i_init;
290: p->i_init = i;
291: }
292: }
293:
294: /*
295: * Add an arglist (call) to args list. If it is ceorcible to
296: * the definition don't bother.
297: */
298: static void
299: add_arglist(v, a)
300: register var *v;
301: register arg *a;
302: {
303: if (v->v_argdefn != NULL && coercible_arglist(v->v_argdefn, a, -1))
304: {
305: free_arglist(a);
306: return;
307: }
308:
309: *v->v_tail = a;
310: v->v_tail = &a->a_next;
311: a->a_next = NULL;
312: }
313:
314: /*
315: * Complain about improper calls.
316: */
317: static void
318: put_improper_calls(d, u, v, af, tf)
319: register arg *d;
320: register arg *u;
321: int v;
322: int (*af)();
323: int (*tf)();
324: {
325: register args *p;
326: register args *q;
327: register char *sep;
328: register int n;
329: int i;
330: int force;
331:
332: while (u != NULL)
333: {
334: if (!(*af)(d, u, v))
335: {
336: putchar('\t');
337: put_file(u->a_file, u->a_line);
338:
339: if (v >= 0 && u->a_count < v)
340: printf(", expected at least %d arg%s, found %d\n", v, v == 1 ? "" : "s", u->a_count);
341: else if (d->a_count != u->a_count)
342: printf(", expected %d arg%s, found %d\n", d->a_count, d->a_count == 1 ? "" : "s", u->a_count);
343: else
344: {
345: if (v < 0)
346: n = d->a_count;
347: else
348: n = v;
349:
350: i = 1;
351: sep = ", ";
352: p = d->a_head;
353: q = u->a_head;
354:
355: while (--n >= 0)
356: {
357: if (p->a_type != q->a_type && !(*tf)(p->a_type, q->a_type))
358: {
359: force = different_vintage(p->a_type, q->a_type);
360: printf("%sarg %d expected ", sep, i);
361: put_type(p->a_type, force);
362: printf(", found ");
363: put_type(q->a_type, force);
364: sep = "\n\t\t";
365: }
366:
367: i++;
368: p = p->a_next;
369: q = q->a_next;
370: }
371:
372: putchar('\n');
373: }
374: }
375:
376: u = u->a_next;
377: }
378: }
379:
380: /*
381: * Enter vars from input file. Check statics and enter instances.
382: */
383: void
384: enter_vars(n)
385: register long n;
386: {
387: register int i;
388: register long j;
389: register var *p;
390: register var **v;
391:
392: v = (var **)salloc(n * sizeof (var *));
393: var_trans = v;
394:
395: for (j = 0; j < n; j++)
396: *v++ = NULL;
397:
398: v = var_trans;
399:
400: while (data_ptr < data_end)
401: {
402: register long l0;
403: register long l1;
404: register long l2;
405: arg *ap;
406:
407: i = getd();
408:
409: switch (obj_item(i))
410: {
411: case i_data:
412: l0 = getv();
413: l1 = getv();
414: initialisation(var_trans[l0], str_trans[l1], getv());
415:
416: loop
417: {
418: i = getd();
419:
420: switch (obj_item(i))
421: {
422: case d_addr:
423: skip4();
424: continue;
425:
426: case d_bytes:
427: if (obj_id(i) == 0)
428: l0 = getv();
429: else
430: l0 = obj_id(i);
431:
432: data_ptr += l0;
433: continue;
434:
435: case d_end:
436: break;
437:
438: case d_istring:
439: if (obj_id(i) == 0)
440: l0 = getv();
441: else
442: l0 = obj_id(i);
443:
444: str_num++;
445: data_ptr += l0;
446: continue;
447:
448: case d_irstring:
449: if (obj_id(i) == 0)
450: l0 = getv();
451: else
452: l0 = obj_id(i);
453:
454: str_num++;
455: data_ptr += l0;
456: skip4();
457: continue;
458:
459: case d_space:
460: if (obj_id(i) == 0)
461: skip();
462:
463: continue;
464:
465: case d_string:
466: skip();
467: continue;
468:
469: case d_reloc:
470: case d_rstring:
471: skip();
472: skip4();
473: continue;
474:
475: default:
476: fprintf(stderr, "%s: unknown data id %d\n", my_name, i);
477: exit(1);
478: }
479:
480: break;
481: }
482:
483: break;
484:
485: case i_lib:
486: case i_src:
487: skip();
488: break;
489:
490: case i_string:
491: if (obj_id(i) == 0)
492: l0 = getv();
493: else
494: l0 = obj_id(i);
495:
496: str_num++;
497: data_ptr += l0;
498: break;
499:
500: case i_type:
501: switch (obj_id(i))
502: {
503: case t_arrayof:
504: case t_bitfield:
505: skip();
506: skip();
507: break;
508:
509: case t_basetype:
510: (void)getd();
511: break;
512:
513: case t_dimless:
514: case t_ftnreturning:
515: case t_ptrto:
516: skip();
517: break;
518:
519: case t_elaboration:
520: skip();
521: skip();
522: skip();
523:
524: switch (i = obj_id(getd()))
525: {
526: case t_enum:
527: skip();
528: goto elab_enum;
529:
530: case t_structof:
531: skip();
532:
533: do
534: {
535: skip();
536: skip();
537: }
538: while (getv() != 0);
539:
540: skip();
541: break;
542:
543: case t_unionof:
544: skip();
545:
546: do
547: skip();
548: while (getv() != 0);
549:
550: skip();
551: break;
552:
553: default:
554: fprintf(stderr, "%s: unknown elaboration id %d\n", my_name, i);
555: exit(1);
556: }
557:
558: break;
559:
560: case t_enum:
561: skip();
562: skip();
563: skip();
564:
565: if (getv() == 0)
566: break;
567:
568: elab_enum:
569: do
570: skip();
571: while (getv() != 0);
572:
573: skip();
574: skip();
575: break;
576:
577: case t_structof:
578: case t_unionof:
579: skip();
580: skip();
581: skip();
582: break;
583:
584: default:
585: fprintf(stderr, "%s: unknown type id %d\n", my_name, obj_id(i));
586: exit(1);
587: }
588:
589: break;
590:
591: case i_var:
592: switch (obj_id(i))
593: {
594: case v_arglist:
595: l0 = getv();
596: l1 = getv();
597: initialisation(var_trans[l0], str_trans[l1], getv());
598: ap = new_arg();
599:
600: while (getv() != 0)
601: {
602: add_argument(ap, type_trans[getv()]);
603: skip();
604: skip();
605: var_index++;
606: }
607:
608: var_trans[l0]->v_argdefn = ap;
609: break;
610:
611: case v_array_size:
612: l0 = getv();
613: array_size(var_trans[l0], type_trans[getv()]);
614: break;
615:
616: case v_auto:
617: var_index++;
618: skip();
619: skip();
620: skip();
621: skip();
622: break;
623:
624: case v_call:
625: l0 = getv();
626: ap = new_arg();
627: ap->a_file = str_trans[getv()];
628: ap->a_line = getv();
629:
630: while ((l1 = getv()) != 0)
631: add_argument(ap, type_trans[l1]);
632:
633: add_arglist(var_trans[l0], ap);
634: break;
635:
636: case v_block_static:
637: case v_global:
638: case v_implicit_function:
639: case v_static:
640: l0 = getv();
641: l1 = getv();
642: l2 = getv();
643: var_trans[var_index++] = declare(obj_id(i), str_trans[l0], type_trans[l1], str_trans[l2], getv());
644: break;
645:
646: case v_varargs:
647: l0 = getv();
648: set_varargs(var_trans[l0], getv());
649: break;
650:
651: default:
652: fprintf(stderr, "%s: unknown var id %d\n", my_name, obj_id(i));
653: exit(1);
654: }
655:
656: break;
657:
658: default:
659: fprintf(stderr, "%s: unknown obj_item %d\n", my_name, obj_item(i));
660: exit(1);
661: }
662: }
663:
664: for (j = 1; j < n; j++)
665: {
666: register arg *a;
667:
668: if ((p = v[j]) == NULL)
669: continue;
670:
671: switch (p->v_what)
672: {
673: case v_block_static:
674: break;
675:
676: case v_global:
677: case v_implicit_function:
678: add_instance(p);
679: break;
680:
681: case v_static:
682: switch (p->v_type->t_type)
683: {
684: char *diag;
685:
686: error:
687: say_file();
688: printf(", static %s %s, ", diag, p->v_name->sy_name);
689: put_file(p->v_file, p->v_line);
690: printf(", never defined\n");
691: errors++;
692: break;
693:
694: case t_dimless:
695: diag = "array[]";
696: goto error;
697:
698: case t_ftnreturning:
699: if (p->v_ifile == NULL)
700: {
701: diag = "function";
702: goto error;
703: }
704:
705: for (a = p->v_args; a != NULL; a = a->a_next)
706: {
707: if (!coercible_arglist(p->v_argdefn, a, p->v_varargs))
708: {
709: say_file();
710: printf(": static function %s: ", p->v_name->sy_name);
711: put_file(p->v_file, p->v_line);
712: printf("\n");
713: put_improper_calls(p->v_argdefn, a, p->v_varargs, coercible_arglist, coercible);
714: errors++;
715: break;
716: }
717: }
718:
719: free_arguments(p->v_args);
720: free_arguments(p->v_argdefn);
721: }
722:
723: break;
724:
725: default:
726: fprintf(stderr, "%s: bad var type\n", my_name);
727: exit(1);
728: }
729:
730: p->v_next = var_free;
731: var_free = p;
732: }
733: }
734:
735: /*
736: * Check for mutliple declarations and definitions.
737: * Also check arglist compatibility.
738: */
739: static void
740: check_instance(p)
741: register inst *p;
742: {
743: register defn *d;
744: register init *i;
745: register arg *a;
746:
747: if (p->i_defn->d_next != NULL)
748: {
749: printf("%s multiply declared:\n", p->i_name->sy_name);
750:
751: for (d = p->i_defn; d != NULL; d = d->d_next)
752: {
753: putchar('\t');
754: put_file(d->d_file, d->d_line);
755:
756: if (d->d_what == v_implicit_function)
757: printf(" implicitly");
758:
759: printf(" as ");
760: put_type(d->d_type, 0);
761: putchar('\n');
762: }
763:
764: errors++;
765: }
766:
767: if (p->i_init != NULL)
768: {
769: if (p->i_init->i_next != NULL)
770: {
771: printf("%s multiply defined:\n", p->i_name->sy_name);
772:
773: for (i = p->i_init; i != NULL; i = i->i_next)
774: {
775: putchar('\t');
776: put_file(i->i_file, i->i_line);
777: putchar('\n');
778: }
779:
780: errors++;
781: return;
782: }
783:
784: if (p->i_argdefn != NULL)
785: {
786: for (a = p->i_args; a != NULL; a = a->a_next)
787: {
788: if (!compatible_arglist(p->i_argdefn, a, p->i_init->i_varargs))
789: {
790: printf("function %s: ", p->i_name->sy_name);
791: put_file(p->i_init->i_file, p->i_init->i_line);
792: printf("\n");
793: put_improper_calls(p->i_argdefn, a, p->i_init->i_varargs, compatible_arglist, compatible);
794: errors++;
795: break;
796: }
797: }
798: }
799: }
800: }
801:
802: void
803: check_externs()
804: {
805: register inst *p;
806:
807: for (p = global_list; p != NULL; p = p->i_next)
808: check_instance(p);
809: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.