1: /*
2: * Copyright (C) 1984 by Eric C. Cooper.
3: * All rights reserved.
4: */
5: #ifndef lint
6: static char RCSid[] = "$Header: typecode.c,v 2.0 85/11/21 07:21:47 jqj Exp $";
7: #endif
8:
9: /* $Log: typecode.c,v $
10: * Revision 2.0 85/11/21 07:21:47 jqj
11: * 4.3BSD standard release
12: *
13: * Revision 1.6 85/05/23 06:20:12 jqj
14: * *** empty log message ***
15: *
16: * Revision 1.6 85/05/23 06:20:12 jqj
17: * Public Beta-test version, released 24 May 1985
18: *
19: * Revision 1.5 85/05/06 08:13:43 jqj
20: * Almost Beta-test version.
21: *
22: * Revision 1.4 85/03/26 06:10:42 jqj
23: * Revised public alpha-test version, released 26 March 1985
24: *
25: * Revision 1.3 85/03/11 16:40:21 jqj
26: * Public alpha-test version, released 11 March 1985
27: *
28: * Revision 1.2 85/02/21 11:06:11 jqj
29: * alpha test version
30: *
31: * Revision 1.1 85/02/15 13:55:45 jqj
32: * Initial revision
33: *
34: */
35:
36: #include "compiler.h"
37:
38: #define candidate_name(str) (str)
39:
40: /*
41: * This function is used to cope with the fact that C passes arrays
42: * by reference but all other types by value.
43: * The argument should be a base type.
44: */
45: char *
46: refstr(typtr)
47: struct type *typtr;
48: {
49: /* if (typtr->o_class != O_TYPE)
50: error(FATAL, "internal error (refstr): not a type");
51: */
52: return (typtr->type_constr == C_ARRAY ? "" : "&");
53: }
54:
55: /*
56: * Names of translation functions for types.
57: * Warning: returns pointer to a static buffer.
58: */
59: char *
60: xfn(kind, typtr)
61: enum translation kind;
62: struct type *typtr;
63: {
64: static char buf[MAXSTR];
65: char *name;
66:
67: switch (kind) {
68: case EXTERNALIZE:
69: name = "externalize";
70: break;
71: case INTERNALIZE:
72: name = "internalize";
73: break;
74: }
75: (void) sprintf(buf, "%s_%s", name, typtr->type_name);
76: return (buf);
77: }
78:
79: /*
80: * Print the heading for a type externalizing or internalizing function.
81: */
82: (kind, typtr, ptr_type)
83: enum translation kind;
84: struct type *typtr, *ptr_type;
85: {
86: FILE *f;
87:
88: switch (kind) {
89: case :
90: f = support1; break;
91: case :
92: f = support2; break;
93: }
94: fprintf(f,
95: "\n\
96: int\n\
97: %s(p, buf)\n\
98: \tregister %s *p;\n\
99: \tregister Unspecified *buf;\n",
100: xfn(kind, typtr), typename(ptr_type));
101: }
102:
103: /*
104: * create an alias for a type's datastructures. Note that caller must
105: * create the alias for the typedef name itself.
106: */
107: copy_typefns(headerfile,new,old)
108: FILE *headerfile;
109: char *new, *old;
110: {
111: fprintf(headerfile,
112: "#define sizeof_%s sizeof_%s\n\
113: #define clear_%s clear_%s\n\
114: #define externalize_%s externalize_%s\n\
115: #define internalize_%s internalize_%s\n\n",
116: new, old, new, old, new, old, new, old);
117: }
118:
119:
120: define_enumeration_type(typtr)
121: struct type *typtr;
122: {
123: list p,q;
124:
125: typtr->type_xsize = 1;
126: if (recursive_flag)
127: return;
128: /*
129: * Print a C definition for the enumeration.
130: */
131: fprintf(header, "\ntypedef enum {\n");
132: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
133: q=car(p);
134: fprintf(header, "\t%s = %s", name_of(car(q)),
135: ((char *) cdr(q)) );
136: if (cdr(p) != NIL)
137: fprintf(header, ",\n");
138: else
139: fprintf(header, "\n");
140: }
141: fprintf(header, "} %s;\n", typename(typtr));
142: /*
143: * We use the same sizeof and translation functions
144: * for all enumerated types.
145: */
146: copy_typefns(header,typename(typtr),"enumeration");
147: }
148:
149:
150: define_record_type(typtr)
151: struct type *typtr;
152: {
153: struct type *bt;
154: list p, q;
155: int fixed_size;
156: char *format, *ref, *member;
157:
158: /*
159: * Make sure all subtypes are defined and have sizes
160: */
161: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
162: bt = (struct type *) cdar(p);
163: if (typename(bt) == NULL) {
164: struct object *name;
165: name = make_symbol(gensym("T_r"),CurrentProgram);
166: define_type(name,bt);
167: }
168: }
169: /*
170: * Generate size field.
171: * The size is equal to the sum of the sizes of each field.
172: */
173: fixed_size = 0;
174: typtr->type_xsize = 0;
175: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
176: bt = (struct type *) cdar(p);
177: if (bt->type_xsize == -1)
178: typtr->type_xsize = -1;
179: else
180: fixed_size += bt->type_xsize;
181: }
182: if (typtr->type_xsize != -1)
183: typtr->type_xsize = fixed_size;
184: if (recursive_flag)
185: return;
186: /*
187: * Print a C definition for the record.
188: */
189: fprintf(header, "\ntypedef struct {\n");
190: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
191: bt = (struct type *) cdar(p);
192: q = caar(p);
193: member = (char *) car(q);
194: fprintf(header, "\t%s %s;\n", typename(bt), member);
195: }
196: fprintf(header, "} %s;\n", typename(typtr));
197: /*
198: * Generate sizeof and free functions for the record.
199: */
200: if (typtr->type_xsize != -1) {
201: /*
202: * The record is fixed-size, so just define a macro.
203: */
204: fprintf(header,
205: "\n\
206: #define sizeof_%s(p) %d\n\
207: \n\
208: #define clear_%s(p)\n",
209: typename(typtr), typtr->type_xsize,
210: typename(typtr));
211: } else {
212: /*
213: * There are some variable-size fields, so define functions.
214: */
215: fprintf(support1,
216: "\n\
217: int\n\
218: sizeof_%s(p)\n\
219: \tregister %s *p;\n\
220: {\n\
221: \tregister int size = %d;\n\
222: \n",
223: typename(typtr), typename(typtr), fixed_size);
224: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
225: bt = (struct type *) cdar(p);
226: if (bt->type_xsize != -1)
227: continue;
228: ref = refstr(bt);
229: q = caar(p);
230: member = (char *) car(q);
231: fprintf(support1,
232: "\tsize += sizeof_%s(%sp->%s);\n",
233: typename(bt), ref, member);
234: }
235: fprintf(support1,
236: "\treturn (size);\n\
237: }\n"
238: );
239: fprintf(support1,
240: "\n\
241: int\n\
242: clear_%s(p)\n\
243: \tregister %s *p;\n\
244: {\n\
245: \n",
246: typename(typtr), typename(typtr));
247: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
248: bt = (struct type *) cdar(p);
249: if (bt->type_xsize != -1)
250: continue;
251: ref = refstr(bt);
252: q = caar(p);
253: member = (char *) car(q);
254: fprintf(support1,
255: "\tclear_%s(%sp->%s);\n",
256: typename(bt), ref, member);
257: }
258: fprintf(support1, "}\n" );
259: }
260: /*
261: * Define translation functions.
262: */
263: xfn_header(EXTERNALIZE, typtr, typtr);
264: xfn_header(INTERNALIZE, typtr, typtr);
265: format =
266: "{\n\
267: \tregister Unspecified *bp;\n\
268: \n\
269: \tbp = buf;\n";
270: fprintf(support1, format);
271: fprintf(support2, format);
272: format =
273: "\tbp += %s(%sp->%s, bp);\n";
274: for (p = typtr->type_list; p != NIL; p = cdr(p)) {
275: bt = (struct type *) cdar(p);
276: ref = refstr(bt);
277: q = caar(p);
278: member = (char *) car(q);
279: fprintf(support1, format,
280: xfn(EXTERNALIZE, bt), ref, member);
281: fprintf(support2, format,
282: xfn(INTERNALIZE, bt), ref, member);
283: }
284: format =
285: "\treturn (bp - buf);\n\
286: }\n";
287: fprintf(support1, format);
288: fprintf(support2, format);
289: }
290:
291: define_array_type(typtr)
292: struct type *typtr;
293: {
294: struct type *bt;
295: int true_size;
296: char *ref, *format;
297:
298: bt = typtr->type_basetype;
299: /*
300: * Make sure the component type is defined and sized
301: */
302: if (typename(bt) == NULL) {
303: struct object *name;
304: name = make_symbol(gensym("T_a"),CurrentProgram);
305: define_type(name,bt);
306: }
307: ref = refstr(bt);
308: true_size = typtr->type_size;
309: if (bt->type_xsize != -1)
310: typtr->type_xsize = true_size * bt->type_xsize;
311: else
312: typtr->type_xsize = -1;
313: if (recursive_flag)
314: return;
315: /*
316: * Print a C definition for the array.
317: */
318: fprintf(header, "\ntypedef %s %s[%d];\n",
319: typename(bt), typename(typtr), true_size);
320: /*
321: * Generate a sizeof and free functions for the array.
322: * The size is equal to the sum of the sizes of each element.
323: */
324: if (bt->type_xsize != -1) {
325: /*
326: * The element type, and hence the array, is fixed-size,
327: * so just define a macro.
328: */
329: fprintf(header,
330: "\n\
331: #define sizeof_%s(p) %d\n\
332: \n\
333: #define clear_%s(p)\n",
334: typename(typtr), typtr->type_xsize,
335: typename(typtr));
336: } else {
337: /*
338: * The element type is variable-size, so define a function.
339: */
340: fprintf(support1,
341: "\n\
342: int\n\
343: sizeof_%s(p)\n\
344: \tregister %s *p;\n\
345: {\n\
346: \tregister int size = 0;\n\
347: \tregister int i;\n\
348: \n\
349: \tfor (i = 0; i < %d; i += 1)\n\
350: \t\tsize += sizeof_%s(%sp[i]);\n\
351: \treturn (size);\n\
352: }\n",
353: typename(typtr), typename(bt), true_size,
354: typename(bt), ref);
355: fprintf(support1,
356: "\n\
357: clear_%s(p)\n\
358: \t%s *p;\n\
359: {\n\
360: \tregister int i;\n\
361: \n\
362: \tfor (i = 0; i < %d; i += 1)\n\
363: \t\tclear_%s(%sp[i]);\n\
364: }\n",
365: typename(typtr), typename(bt), true_size,
366: typename(bt), ref);
367: }
368: /*
369: * Define translation functions.
370: */
371: xfn_header(EXTERNALIZE, typtr, bt);
372: xfn_header(INTERNALIZE, typtr, bt);
373: format =
374: "{\n\
375: \tregister Unspecified *bp;\n\
376: \tregister int i;\n\
377: \n\
378: \tbp = buf;\n\
379: \tfor (i = 0; i < %d; i += 1)\n\
380: \t\tbp += %s(%sp[i], bp);\n\
381: \treturn (bp - buf);\n\
382: }\n";
383: fprintf(support1, format,
384: true_size, xfn(EXTERNALIZE, bt), ref);
385: fprintf(support2, format,
386: true_size, xfn(INTERNALIZE, bt), ref);
387: }
388:
389: define_sequence_type(typtr)
390: struct type *typtr;
391: {
392: struct type *bt;
393: char *ref, *format;
394:
395: typtr->type_xsize = -1;
396: bt = typtr->type_basetype;
397: /*
398: * Make sure the component type is defined
399: */
400: if (typename(bt) == NULL) {
401: struct object *name;
402: name = make_symbol(gensym("T_s"),CurrentProgram);
403: define_type(name,bt);
404: }
405: if (recursive_flag)
406: return;
407: /*
408: * Print a C definition for the sequence.
409: */
410: fprintf(header,
411: "\n\
412: typedef struct {\n\
413: \tCardinal length;\n\
414: \t%s *sequence;\n\
415: } %s;\n",
416: typename(bt), typename(typtr));
417: /*
418: * Generate sizeof and free functions for the sequence.
419: * The size is equal to 1 (for the length word)
420: * plus the sum of the sizes of each element.
421: */
422: bt = typtr->type_basetype;
423: ref = refstr(bt);
424: if (bt->type_xsize != -1) {
425: /*
426: * The element type is fixed-size, so just define a macro.
427: */
428: fprintf(header,
429: "\n\
430: #define sizeof_%s(p) (1 + (p)->length * %d)\n",
431: typename(typtr), bt->type_xsize);
432: fprintf(support1,
433: "\n\
434: clear_%s(p)\n\
435: \tregister %s *p;\n\
436: {\n\
437: \tDeallocate((Unspecified*) p->sequence);\n\
438: \tp->length = 0; p->sequence = (%s*) 0;\n\
439: }\n",
440: typename(typtr), typename(typtr),
441: typename(bt) );
442: } else {
443: /*
444: * The element type is variable-size, so define a function.
445: */
446: fprintf(support1,
447: "\n\
448: int\n\
449: sizeof_%s(p)\n\
450: \tregister %s *p;\n\
451: {\n\
452: \tregister int size = 1;\n\
453: \tregister int i;\n\
454: \n\
455: \tif (p->sequence == (%s*) 0) return(size);\n\
456: \tfor (i = 0; i < p->length; i += 1)\n\
457: \t\tsize += sizeof_%s(%sp->sequence[i]);\n\
458: \treturn (size);\n\
459: }\n",
460: typename(typtr), typename(typtr), typename(bt),
461: typename(bt), ref);
462: fprintf(support1,
463: "\n\
464: clear_%s(p)\n\
465: \tregister %s *p;\n\
466: {\n\
467: \tregister int i;\n\
468: \n\
469: \tif (p->sequence != (%s*) 0) for (i = 0; i < p->length; i += 1)\n\
470: \t\tclear_%s(%sp->sequence[i]);\n\
471: \tDeallocate((Unspecified*) p->sequence);\n\
472: \tp->length = 0; p->sequence = (%s*) 0;\n\
473: }\n",
474: typename(typtr), typename(typtr), typename(bt),
475: typename(bt), ref,
476: typename(bt) );
477:
478: }
479: /*
480: * Define translation functions.
481: */
482: xfn_header(EXTERNALIZE, typtr, typtr);
483: xfn_header(INTERNALIZE, typtr, typtr);
484: /*
485: * The externalize function (trivially) checks its pointer
486: * for consistency.
487: */
488: fprintf(support1,
489: "{\n\
490: \tregister Unspecified *bp;\n\
491: \tregister int i;\n\
492: \n\
493: \tif (p->sequence == (%s*)0) p->length = 0;\n\
494: \tbp = buf + %s(&p->length, buf);\n",
495: typename(bt),
496: xfn(EXTERNALIZE, Cardinal_type));
497: /*
498: * The internalize function needs to allocate space
499: * for the sequence elements dynamically.
500: */
501: fprintf(support2,
502: "{\n\
503: \tregister Unspecified *bp;\n\
504: \tregister int i;\n\
505: \n\
506: \tbp = buf + %s(&p->length, buf);\n\
507: \tp->sequence = (%s *)\n\
508: \t\tAllocate(p->length * sizeof(%s)/sizeof(Cardinal));\n",
509: xfn(INTERNALIZE, Cardinal_type),
510: typename(bt), typename(bt));
511: format =
512: "\tfor (i = 0; i < p->length; i++)\n\
513: \t\tbp += %s(%sp->sequence[i], bp);\n\
514: \treturn (bp - buf);\n\
515: }\n";
516: fprintf(support1, format, xfn(EXTERNALIZE, bt), ref);
517: fprintf(support2, format, xfn(INTERNALIZE, bt), ref);
518: }
519:
520: define_choice_type(typtr)
521: struct type *typtr;
522: {
523: struct type *designator, *bt;
524: list p,q,candidates;
525: char *format, *ref, *member;
526:
527: typtr->type_xsize = -1;
528:
529: designator = typtr->type_designator;
530: candidates = typtr->type_candidates;
531: if (! recursive_flag)
532: fprintf(header,
533: "\n\
534: extern struct %s;\n\
535: typedef struct %s %s;\n",
536: typename(typtr), typename(typtr), typename(typtr));
537: /*
538: * Make sure each arm type is defined
539: */
540: for (p = candidates; p != NIL; p = cdr(p)) {
541: bt = (struct type *) cdar(p);
542: if (typename(bt) == NULL) {
543: struct object *name;
544: name = make_symbol(gensym("T_c"),CurrentProgram);
545: define_type(name,bt);
546: }
547: }
548: if (recursive_flag)
549: return;
550: /*
551: * Print a C definition for the choice.
552: * First, be prepared for recursive references of the SEQUENCE OF form
553: */
554: fprintf(header,
555: "\n\
556: struct %s {\n\
557: \t%s designator;\n\
558: \tunion {\n",
559: typename(typtr), typename(designator));
560: for (p = candidates; p != NIL; p = cdr(p)) {
561: bt = (struct type *) cdar(p);
562: for (q = caar(p); q != NIL; q = cdr(q)) {
563: member = name_of(caar(q));
564: fprintf(header,
565: "\t\t%s u_%s;\n\
566: #define %s_case u.u_%s\n",
567: typename(bt), member,
568: candidate_name(member), member);
569: }
570: }
571: fprintf(header,
572: "\t} u;\n\
573: };\n" );
574: /*
575: * Generate a sizeof function for the choice.
576: * The size is equal to 1 (for the designator word)
577: * plus the size of the corresponding candidate.
578: * We could check if all the candidates happen to be the same size,
579: * but we don't bother and always call it variable-size.
580: */
581: fprintf(support1,
582: "\n\
583: int\n\
584: sizeof_%s(p)\n\
585: \tregister %s *p;\n\
586: {\n\
587: \tregister int size = 1;\n\
588: \n\
589: \tswitch (p->designator) {\n",
590: typename(typtr), typename(typtr));
591: for (p = candidates; p != NIL; p = cdr(p)) {
592: bt = (struct type *) cdar(p);
593: ref = refstr(bt);
594: for (q = caar(p); q != NIL; q = cdr(q)) {
595: member = name_of(caar(q));
596: fprintf(support1,
597: "\t case %s:\n\
598: \t\tsize += sizeof_%s(%sp->%s_case);\n\
599: \t\tbreak;\n",
600: member, typename(bt), ref,
601: candidate_name(member));
602: }
603: }
604: fprintf(support1,
605: "\t}\n\
606: \treturn (size);\n\
607: }\n"
608: );
609: /*
610: * Now generate the freeing function. Here we do bother
611: * not to free constant-sized structures, just for kicks.
612: * However, we always generate a freeing function, even if
613: * all the arms of the choice are constant sized.
614: */
615: fprintf(support1,
616: "\n\
617: clear_%s(p)\n\
618: \tregister %s *p;\n\
619: {\n\
620: \tswitch (p->designator) {\n",
621: typename(typtr), typename(typtr));
622: for (p = candidates; p != NIL; p = cdr(p)) {
623: bt = (struct type *) cdar(p);
624: ref = refstr(bt);
625: for (q = caar(p); q != NIL; q = cdr(q)) {
626: member = name_of(caar(q));
627: if (bt->type_xsize == -1)
628: fprintf(support1,
629: "\t case %s:\n\
630: \t\tbreak;\n",
631: member);
632: else
633: fprintf(support1,
634: "\t case %s:\n\
635: \t\tclear_%s(%sp->%s_case);\n\
636: \t\tbreak;\n",
637: member, typename(bt), ref,
638: candidate_name(member));
639: }
640: }
641: fprintf(support1,
642: "\t}\n\
643: }\n"
644: );
645: /*
646: * Define translation functions.
647: */
648: xfn_header(EXTERNALIZE, typtr, typtr);
649: xfn_header(INTERNALIZE, typtr, typtr);
650: format =
651: "{\n\
652: \tregister Unspecified *bp;\n\
653: \n\
654: \tbp = buf + %s(&p->designator, buf);\n\
655: \tswitch (p->designator) {\n";
656: fprintf(support1, format, xfn(EXTERNALIZE, designator));
657: fprintf(support2, format, xfn(INTERNALIZE, designator));
658: format =
659: "\t case %s:\n\
660: \t\tbp += %s(%sp->%s_case, bp);\n\
661: \t\tbreak;\n";
662: for (p = candidates; p != NIL; p = cdr(p)) {
663: bt = (struct type *) cdar(p);
664: ref = refstr(bt);
665: for (q = caar(p); q != NIL; q = cdr(q)) {
666: member = name_of(caar(q));
667: fprintf(support1, format,
668: member, xfn(EXTERNALIZE, bt),
669: ref, candidate_name(member));
670: fprintf(support2, format,
671: member, xfn(INTERNALIZE, bt),
672: ref, candidate_name(member));
673: }
674: }
675: format =
676: "\t}\n\
677: \treturn (bp - buf);\n\
678: }\n";
679: fprintf(support1, format);
680: fprintf(support2, format);
681: }
682:
683: /*
684: * Generate a new full name of the form <module><version>_<name>
685: */
686: char *
687: make_full_name(module,version,name)
688: char *module;
689: int version;
690: char *name;
691: {
692: char buf[MAXSTR];
693: sprintf(buf,"%s%d_%s",module,version,name);
694: return(copy(buf));
695: }
696:
697: /*
698: * Generate defininitions for named types
699: * and their size and translation functions.
700: * We assume that each type with a type_name field has already been
701: * generated.
702: */
703: define_type(name, typtr)
704: struct object *name;
705: struct type *typtr;
706: {
707: char *fullname;
708: /*
709: * create the symbol -- it has already been made via make_symbol()
710: * which, along with allocating an object, set o_name
711: */
712: name->o_class = O_TYPE;
713: name->o_type = typtr;
714: fullname = make_full_name(name->o_module, name->o_modversion,
715: name_of(name));
716: code_type(fullname, typtr);
717: if (!recursive_flag) {
718: /* widen scope */
719: fprintf(header1, "typedef %s %s;\n",
720: fullname, name_of(name));
721: copy_typefns(header1,name_of(name),fullname);
722: }
723: }
724:
725: /*
726: * Actually generate some code. This routine may be called recursively
727: * if subtypes have no name.
728: */
729: code_type(name, typtr)
730: char *name;
731: struct type *typtr;
732: {
733: /*
734: * check for simple case of "foo: TYPE = bar;" rename
735: */
736: if (typename(typtr) != NULL) {
737: if (!recursive_flag) {
738: /* create alias for typedef */
739: fprintf(header,"typedef %s %s;\n",
740: typename(typtr), name);
741: copy_typefns(header,name, typename(typtr));
742: }
743: return;
744: }
745: /*
746: * general case: "foo: TYPE = <type>;"
747: * actually generate some code
748: */
749: switch (typtr->type_constr) {
750: case C_PROCEDURE:
751: /* no code gets generated for these Types */
752: typename(typtr) = name;
753: break;
754: case C_NUMERIC:
755: case C_BOOLEAN:
756: case C_STRING:
757: /* create alias for typedef */
758: fprintf(header,"typedef %s %s;\n",
759: typename(typtr), name);
760: copy_typefns(header,name,typename(typtr));
761: typename(typtr) = name;
762: break;
763: case C_ENUMERATION:
764: typename(typtr) = name;
765: define_enumeration_type(typtr);
766: break;
767: case C_ARRAY:
768: typename(typtr) = name;
769: define_array_type(typtr);
770: break;
771: case C_SEQUENCE:
772: typename(typtr) = name;
773: define_sequence_type(typtr);
774: break;
775: case C_RECORD:
776: typename(typtr) = name;
777: define_record_type(typtr);
778: break;
779: case C_CHOICE:
780: typename(typtr) = name;
781: define_choice_type(typtr);
782: break;
783: case C_ERROR:
784: typename(typtr) = name;
785: if (typtr->type_list != NIL)
786: define_record_type(typtr);
787: break;
788: }
789: return;
790: }