1 /****************************************************************
2 Copyright 1990, 1992 - 1996, 2000 by AT&T, Lucent Technologies and Bellcore.
3
4 Permission to use, copy, modify, and distribute this software
5 and its documentation for any purpose and without fee is hereby
6 granted, provided that the above copyright notice appear in all
7 copies and that both that the copyright notice and this
8 permission notice and warranty disclaimer appear in supporting
9 documentation, and that the names of AT&T, Bell Laboratories,
10 Lucent or Bellcore or any of their entities not be used in
11 advertising or publicity pertaining to distribution of the
12 software without specific, written prior permission.
13
14 AT&T, Lucent and Bellcore disclaim all warranties with regard to
15 this software, including all implied warranties of
16 merchantability and fitness. In no event shall AT&T, Lucent or
17 Bellcore be liable for any special, indirect or consequential
18 damages or any damages whatsoever resulting from loss of use,
19 data or profits, whether in an action of contract, negligence or
20 other tortious action, arising out of or in connection with the
21 use or performance of this software.
22 ****************************************************************/
23
24 #include "defs.h"
25 #include "output.h"
26 #include "names.h"
27 #include "iob.h"
28
29
30 /* Names generated by the translator are guaranteed to be unique from the
31 Fortan names because Fortran does not allow underscores in identifiers,
32 and all of the system generated names do have underscores. The various
33 naming conventions are outlined below:
34
35 FORMAT APPLICATION
36 ----------------------------------------------------------------------
37 io_# temporaries generated by IO calls; these will
38 contain the device number (e.g. 5, 6, 0)
39 ret_val function return value, required for complex and
40 character functions.
41 ret_val_len length of the return value in character functions
42
43 ssss_len length of character argument "ssss"
44
45 c_# member of the literal pool, where # is an
46 arbitrary label assigned by the system
47 cs_# short integer constant in the literal pool
48 t_# expression temporary, # is the depth of arguments
49 on the stack.
50 L# label "#", given by user in the Fortran program.
51 This is unique because Fortran labels are numeric
52 pad_# label on an init field required for alignment
53 xxx_init label on a common block union, if a block data
54 requires a separate declaration
55 */
56
57 /* generate variable references */
58
59 char *
60 #ifdef KR_headers
c_type_decl(type,is_extern)61 c_type_decl(type, is_extern)
62 int type;
63 int is_extern;
64 #else
65 c_type_decl(int type, int is_extern)
66 #endif
67 {
68 static char buff[100];
69
70 switch (type) {
71 case TYREAL: if (!is_extern || !forcedouble)
72 { strcpy (buff, "real");break; }
73 case TYDREAL: strcpy (buff, "doublereal"); break;
74 case TYCOMPLEX: if (is_extern)
75 strcpy (buff, "/* Complex */ VOID");
76 else
77 strcpy (buff, "complex");
78 break;
79 case TYDCOMPLEX:if (is_extern)
80 strcpy (buff, "/* Double Complex */ VOID");
81 else
82 strcpy (buff, "doublecomplex");
83 break;
84 case TYADDR:
85 case TYINT1:
86 case TYSHORT:
87 case TYLONG:
88 #ifdef TYQUAD
89 case TYQUAD:
90 #endif
91 case TYLOGICAL1:
92 case TYLOGICAL2:
93 case TYLOGICAL: strcpy(buff, Typename[type]);
94 break;
95 case TYCHAR: if (is_extern)
96 strcpy (buff, "/* Character */ VOID");
97 else
98 strcpy (buff, "char");
99 break;
100
101 case TYUNKNOWN: strcpy (buff, "UNKNOWN");
102
103 /* If a procedure's type is unknown, assume it's a subroutine */
104
105 if (!is_extern)
106 break;
107
108 /* Subroutines must return an INT, because they might return a label
109 value. Even if one doesn't, the caller will EXPECT it to. */
110
111 case TYSUBR: strcpy (buff, "/* Subroutine */ int");
112 break;
113 case TYERROR: strcpy (buff, "ERROR"); break;
114 case TYVOID: strcpy (buff, "void"); break;
115 case TYCILIST: strcpy (buff, "cilist"); break;
116 case TYICILIST: strcpy (buff, "icilist"); break;
117 case TYOLIST: strcpy (buff, "olist"); break;
118 case TYCLLIST: strcpy (buff, "cllist"); break;
119 case TYALIST: strcpy (buff, "alist"); break;
120 case TYINLIST: strcpy (buff, "inlist"); break;
121 case TYFTNLEN: strcpy (buff, "ftnlen"); break;
122 default: sprintf (buff, "BAD DECL '%d'", type);
123 break;
124 } /* switch */
125
126 return buff;
127 } /* c_type_decl */
128
129
130 char *
new_func_length(Void)131 new_func_length(Void)
132 { return "ret_val_len"; }
133
134 char *
135 #ifdef KR_headers
new_arg_length(arg)136 new_arg_length(arg)
137 Namep arg;
138 #else
139 new_arg_length(Namep arg)
140 #endif
141 {
142 static char buf[64];
143 char *fmt = "%s_len", *s = arg->fvarname;
144 switch(*s) {
145 case 'r':
146 if (!strcmp(s+1, "et_val"))
147 goto adjust_fmt;
148 break;
149 case 'h':
150 case 'i':
151 if (!s[1]) {
152 adjust_fmt:
153 fmt = "%s_length"; /* avoid conflict with libF77 */
154 }
155 }
156 sprintf (buf, fmt, s);
157 return buf;
158 } /* new_arg_length */
159
160
161 /* declare_new_addr -- Add a new local variable to the function, given a
162 pointer to an Addrblock structure (which must have the uname_tag set)
163 This list of idents will be printed in reverse (i.e., chronological)
164 order */
165
166 void
167 #ifdef KR_headers
declare_new_addr(addrp)168 declare_new_addr(addrp)
169 struct Addrblock *addrp;
170 #else
171 declare_new_addr(struct Addrblock *addrp)
172 #endif
173 {
174 extern chainp new_vars;
175
176 new_vars = mkchain((char *)cpexpr((expptr)addrp), new_vars);
177 } /* declare_new_addr */
178
179
180 void
181 #ifdef KR_headers
wr_nv_ident_help(outfile,addrp)182 wr_nv_ident_help(outfile, addrp)
183 FILE *outfile;
184 struct Addrblock *addrp;
185 #else
186 wr_nv_ident_help(FILE *outfile, struct Addrblock *addrp)
187 #endif
188 {
189 int eltcount = 0;
190
191 if (addrp == (struct Addrblock *) NULL)
192 return;
193
194 if (addrp -> isarray) {
195 frexpr (addrp -> memoffset);
196 addrp -> memoffset = ICON(0);
197 eltcount = addrp -> ntempelt;
198 addrp -> ntempelt = 0;
199 addrp -> isarray = 0;
200 } /* if */
201 out_addr (outfile, addrp);
202 if (eltcount)
203 nice_printf (outfile, "[%d]", eltcount);
204 } /* wr_nv_ident_help */
205
206 int
207 #ifdef KR_headers
nv_type_help(addrp)208 nv_type_help(addrp)
209 struct Addrblock *addrp;
210 #else
211 nv_type_help(struct Addrblock *addrp)
212 #endif
213 {
214 if (addrp == (struct Addrblock *) NULL)
215 return -1;
216
217 return addrp -> vtype;
218 } /* nv_type_help */
219
220
221 /* lit_name -- returns a unique identifier for the given literal. Make
222 the label useful, when possible. For example:
223
224 1 -> c_1 (constant 1)
225 2 -> c_2 (constant 2)
226 1000 -> c_1000 (constant 1000)
227 1000000 -> c_b<memno> (big constant number)
228 1.2 -> c_1_2 (constant 1.2)
229 1.234345 -> c_b<memno> (big constant number)
230 -1 -> c_n1 (constant -1)
231 -1.0 -> c_n1_0 (constant -1.0)
232 .true. -> c_true (constant true)
233 .false. -> c_false (constant false)
234 default -> c_b<memno> (default label)
235 */
236
237 char *
238 #ifdef KR_headers
lit_name(litp)239 lit_name(litp)
240 struct Literal *litp;
241 #else
242 lit_name(struct Literal *litp)
243 #endif
244 {
245 static char buf[CONST_IDENT_MAX];
246 ftnint val;
247 char *fmt;
248
249 if (litp == (struct Literal *) NULL)
250 return NULL;
251
252 switch (litp -> littype) {
253 case TYINT1:
254 val = litp -> litval.litival;
255 if (val >= 256 || val < -255)
256 sprintf (buf, "ci1_b%ld", litp -> litnum);
257 else if (val < 0)
258 sprintf (buf, "ci1_n%ld", -val);
259 else
260 sprintf(buf, "ci1__%ld", val);
261 break;
262 case TYSHORT:
263 val = litp -> litval.litival;
264 if (val >= 32768 || val <= -32769)
265 sprintf (buf, "cs_b%ld", litp -> litnum);
266 else if (val < 0)
267 sprintf (buf, "cs_n%ld", -val);
268 else
269 sprintf (buf, "cs__%ld", val);
270 break;
271 case TYLONG:
272 #ifdef TYQUAD
273 case TYQUAD:
274 #endif
275 val = litp -> litval.litival;
276 if (val >= 100000 || val <= -10000)
277 sprintf (buf, "c_b%ld", litp -> litnum);
278 else if (val < 0)
279 sprintf (buf, "c_n%ld", -val);
280 else
281 sprintf (buf, "c__%ld", val);
282 break;
283 case TYLOGICAL1:
284 fmt = "cl1_%s";
285 goto spr_logical;
286 case TYLOGICAL2:
287 fmt = "cl2_%s";
288 goto spr_logical;
289 case TYLOGICAL:
290 fmt = "c_%s";
291 spr_logical:
292 sprintf (buf, fmt, (litp -> litval.litival
293 ? "true" : "false"));
294 break;
295 case TYREAL:
296 case TYDREAL:
297 /* Given a limit of 6 or 8 character on external names, */
298 /* few f.p. values can be meaningfully encoded in the */
299 /* constant name. Just going with the default cb_# */
300 /* seems to be the best course for floating-point */
301 /* constants. */
302 case TYCHAR:
303 /* Shouldn't be any of these */
304 case TYADDR:
305 case TYCOMPLEX:
306 case TYDCOMPLEX:
307 case TYSUBR:
308 default:
309 sprintf (buf, "c_b%ld", litp -> litnum);
310 } /* switch */
311 return buf;
312 } /* lit_name */
313
314
315
316 char *
317 #ifdef KR_headers
comm_union_name(count)318 comm_union_name(count)
319 int count;
320 #else
321 comm_union_name(int count)
322 #endif
323 {
324 static char buf[12];
325
326 sprintf(buf, "%d", count);
327 return buf;
328 }
329
330
331
332
333 /* wr_globals -- after every function has been translated, we need to
334 output the global declarations, such as the static table of constant
335 values */
336
337 void
338 #ifdef KR_headers
wr_globals(outfile)339 wr_globals(outfile)
340 FILE *outfile;
341 #else
342 wr_globals(FILE *outfile)
343 #endif
344 {
345 struct Literal *litp, *lastlit;
346 extern int hsize;
347 char *litname;
348 int did_one, t;
349 struct Constblock cb;
350 ftnint x, y;
351
352 if (nliterals == 0)
353 return;
354
355 lastlit = litpool + nliterals;
356 did_one = 0;
357 for (litp = litpool; litp < lastlit; litp++) {
358 if (!litp->lituse)
359 continue;
360 litname = lit_name(litp);
361 if (!did_one) {
362 margin_printf(outfile, "/* Table of constant values */\n\n");
363 did_one = 1;
364 }
365 cb.vtype = litp->littype;
366 if (litp->littype == TYCHAR) {
367 x = litp->litval.litival2[0] + litp->litval.litival2[1];
368 if (y = x % hsize)
369 x += y = hsize - y;
370 nice_printf(outfile,
371 "static struct { %s fill; char val[%ld+1];", halign, x);
372 nice_printf(outfile, " char fill2[%ld];", hsize - 1);
373 nice_printf(outfile, " } %s_st = { 0,", litname);
374 cb.vleng = ICON(litp->litval.litival2[0]);
375 cb.Const.ccp = litp->cds[0];
376 cb.Const.ccp1.blanks = litp->litval.litival2[1] + y;
377 cb.vtype = TYCHAR;
378 out_const(outfile, &cb);
379 frexpr(cb.vleng);
380 nice_printf(outfile, " };\n");
381 nice_printf(outfile, "#define %s %s_st.val\n", litname, litname);
382 continue;
383 }
384 nice_printf(outfile, "static %s %s = ",
385 c_type_decl(litp->littype,0), litname);
386
387 t = litp->littype;
388 if (ONEOF(t, MSKREAL|MSKCOMPLEX)) {
389 cb.vstg = 1;
390 cb.Const.cds[0] = litp->cds[0];
391 cb.Const.cds[1] = litp->cds[1];
392 }
393 else {
394 memcpy((char *)&cb.Const, (char *)&litp->litval,
395 sizeof(cb.Const));
396 cb.vstg = 0;
397 }
398 out_const(outfile, &cb);
399
400 nice_printf (outfile, ";\n");
401 } /* for */
402 if (did_one)
403 nice_printf (outfile, "\n");
404 } /* wr_globals */
405
406 ftnint
407 #ifdef KR_headers
commlen(vl)408 commlen(vl)
409 register chainp vl;
410 #else
411 commlen(register chainp vl)
412 #endif
413 {
414 ftnint size;
415 int type;
416 struct Dimblock *t;
417 Namep v;
418
419 while(vl->nextp)
420 vl = vl->nextp;
421 v = (Namep)vl->datap;
422 type = v->vtype;
423 if (type == TYCHAR)
424 size = v->vleng->constblock.Const.ci;
425 else
426 size = typesize[type];
427 if ((t = v->vdim) && ISCONST(t->nelt))
428 size *= t->nelt->constblock.Const.ci;
429 return size + v->voffset;
430 }
431
432 static void /* Pad common block if an EQUIVALENCE extended it. */
433 #ifdef KR_headers
pad_common(c)434 pad_common(c)
435 Extsym *c;
436 #else
437 pad_common(Extsym *c)
438 #endif
439 {
440 register chainp cvl;
441 register Namep v;
442 long L = c->maxleng;
443 int type;
444 struct Dimblock *t;
445 int szshort = typesize[TYSHORT];
446
447 for(cvl = c->allextp; cvl; cvl = cvl->nextp)
448 if (commlen((chainp)cvl->datap) >= L)
449 return;
450 v = ALLOC(Nameblock);
451 v->vtype = type = L % szshort ? TYCHAR
452 : type_choice[L/szshort % 4];
453 v->vstg = STGCOMMON;
454 v->vclass = CLVAR;
455 v->tag = TNAME;
456 v->vdim = t = ALLOC(Dimblock);
457 t->ndim = 1;
458 t->dims[0].dimsize = ICON(L / typesize[type]);
459 v->fvarname = v->cvarname = "eqv_pad";
460 if (type == TYCHAR)
461 v->vleng = ICON(1);
462 c->allextp = mkchain((char *)mkchain((char *)v, CHNULL), c->allextp);
463 }
464
465
466 /* wr_common_decls -- outputs the common declarations in one of three
467 formats. If all references to a common block look the same (field
468 names and types agree), only one actual declaration will appear.
469 Otherwise, the same block will require many structs. If there is no
470 block data, these structs will be union'ed together (so the linker
471 knows the size of the largest one). If there IS a block data, only
472 that version will be associated with the variable, others will only be
473 defined as types, so the pointer can be cast to it. e.g.
474
475 FORTRAN C
476 ----------------------------------------------------------------------
477 common /com1/ a, b, c struct { real a, b, c; } com1_;
478
479 common /com1/ a, b, c union {
480 common /com1/ i, j, k struct { real a, b, c; } _1;
481 struct { integer i, j, k; } _2;
482 } com1_;
483
484 common /com1/ a, b, c struct com1_1_ { real a, b, c; };
485 block data struct { integer i, j, k; } com1_ =
486 common /com1/ i, j, k { 1, 2, 3 };
487 data i/1/, j/2/, k/3/
488
489
490 All of these versions will be followed by #defines, since the code in
491 the function bodies can't know ahead of time which of these options
492 will be taken */
493
494 /* Macros for deciding the output type */
495
496 #define ONE_STRUCT 1
497 #define UNION_STRUCT 2
498 #define INIT_STRUCT 3
499
500 void
501 #ifdef KR_headers
wr_common_decls(outfile)502 wr_common_decls(outfile)
503 FILE *outfile;
504 #else
505 wr_common_decls(FILE *outfile)
506 #endif
507 {
508 Extsym *ext;
509 extern int extcomm;
510 static char *Extern[4] = {"", "Extern ", "extern "};
511 char *E, *E0 = Extern[extcomm];
512 int did_one = 0;
513
514 for (ext = extsymtab; ext < nextext; ext++) {
515 if (ext -> extstg == STGCOMMON && ext->allextp) {
516 chainp comm;
517 int count = 1;
518 int which; /* which display to use;
519 ONE_STRUCT, UNION or INIT */
520
521 if (!did_one)
522 nice_printf (outfile, "/* Common Block Declarations */\n\n");
523
524 pad_common(ext);
525
526 /* Construct the proper, condensed list of structs; eliminate duplicates
527 from the initial list ext -> allextp */
528
529 comm = ext->allextp = revchain(ext->allextp);
530
531 if (ext -> extinit)
532 which = INIT_STRUCT;
533 else if (comm->nextp) {
534 which = UNION_STRUCT;
535 nice_printf (outfile, "%sunion {\n", E0);
536 next_tab (outfile);
537 E = "";
538 }
539 else {
540 which = ONE_STRUCT;
541 E = E0;
542 }
543
544 for (; comm; comm = comm -> nextp, count++) {
545
546 if (which == INIT_STRUCT)
547 nice_printf (outfile, "struct %s%d_ {\n",
548 ext->cextname, count);
549 else
550 nice_printf (outfile, "%sstruct {\n", E);
551
552 next_tab (c_file);
553
554 wr_struct (outfile, (chainp) comm -> datap);
555
556 prev_tab (c_file);
557 if (which == UNION_STRUCT)
558 nice_printf (outfile, "} _%d;\n", count);
559 else if (which == ONE_STRUCT)
560 nice_printf (outfile, "} %s;\n", ext->cextname);
561 else
562 nice_printf (outfile, "};\n");
563 } /* for */
564
565 if (which == UNION_STRUCT) {
566 prev_tab (c_file);
567 nice_printf (outfile, "} %s;\n", ext->cextname);
568 } /* if */
569 did_one = 1;
570 nice_printf (outfile, "\n");
571
572 for (count = 1, comm = ext -> allextp; comm;
573 comm = comm -> nextp, count++) {
574 def_start(outfile, ext->cextname,
575 comm_union_name(count), "");
576 switch (which) {
577 case ONE_STRUCT:
578 extern_out (outfile, ext);
579 break;
580 case UNION_STRUCT:
581 nice_printf (outfile, "(");
582 extern_out (outfile, ext);
583 nice_printf(outfile, "._%d)", count);
584 break;
585 case INIT_STRUCT:
586 nice_printf (outfile, "(*(struct ");
587 extern_out (outfile, ext);
588 nice_printf (outfile, "%d_ *) &", count);
589 extern_out (outfile, ext);
590 nice_printf (outfile, ")");
591 break;
592 } /* switch */
593 nice_printf (outfile, "\n");
594 } /* for count = 1, comm = ext -> allextp */
595 nice_printf (outfile, "\n");
596 } /* if ext -> extstg == STGCOMMON */
597 } /* for ext = extsymtab */
598 } /* wr_common_decls */
599
600 void
601 #ifdef KR_headers
wr_struct(outfile,var_list)602 wr_struct(outfile, var_list)
603 FILE *outfile;
604 chainp var_list;
605 #else
606 wr_struct(FILE *outfile, chainp var_list)
607 #endif
608 {
609 int last_type = -1;
610 int did_one = 0;
611 chainp this_var;
612
613 for (this_var = var_list; this_var; this_var = this_var -> nextp) {
614 Namep var = (Namep) this_var -> datap;
615 int type;
616 char *comment = NULL;
617
618 if (var == (Namep) NULL)
619 err ("wr_struct: null variable");
620 else if (var -> tag != TNAME)
621 erri ("wr_struct: bad tag on variable '%d'",
622 var -> tag);
623
624 type = var -> vtype;
625
626 if (last_type == type && did_one)
627 nice_printf (outfile, ", ");
628 else {
629 if (did_one)
630 nice_printf (outfile, ";\n");
631 nice_printf (outfile, "%s ",
632 c_type_decl (type, var -> vclass == CLPROC));
633 } /* else */
634
635 /* Character type is really a string type. Put out a '*' for parameters
636 with unknown length and functions returning character */
637
638 if (var -> vtype == TYCHAR && (!ISICON ((var -> vleng))
639 || var -> vclass == CLPROC))
640 nice_printf (outfile, "*");
641
642 var -> vstg = STGAUTO;
643 out_name (outfile, var);
644 if (var -> vclass == CLPROC)
645 nice_printf (outfile, "()");
646 else if (var -> vdim)
647 comment = wr_ardecls(outfile, var->vdim,
648 var->vtype == TYCHAR && ISICON(var->vleng)
649 ? var->vleng->constblock.Const.ci : 1L);
650 else if (var -> vtype == TYCHAR && var -> vclass != CLPROC &&
651 ISICON ((var -> vleng)))
652 nice_printf (outfile, "[%ld]",
653 var -> vleng -> constblock.Const.ci);
654
655 if (comment)
656 nice_printf (outfile, "%s", comment);
657 did_one = 1;
658 last_type = type;
659 } /* for this_var */
660
661 if (did_one)
662 nice_printf (outfile, ";\n");
663 } /* wr_struct */
664
665
666 char *
667 #ifdef KR_headers
user_label(stateno)668 user_label(stateno)
669 ftnint stateno;
670 #else
671 user_label(ftnint stateno)
672 #endif
673 {
674 static char buf[USER_LABEL_MAX + 1];
675 static char *Lfmt[2] = { "L_%ld", "L%ld" };
676
677 if (stateno >= 0)
678 sprintf(buf, Lfmt[shiftcase], stateno);
679 else
680 sprintf(buf, "L_%s", extsymtab[-1-stateno].fextname);
681 return buf;
682 } /* user_label */
683
684
685 char *
686 #ifdef KR_headers
temp_name(starter,num,storage)687 temp_name(starter, num, storage)
688 char *starter;
689 int num;
690 char *storage;
691 #else
692 temp_name(char *starter, int num, char *storage)
693 #endif
694 {
695 static char buf[IDENT_LEN];
696 char *pointer = buf;
697 char *prefix = "t";
698
699 if (storage)
700 pointer = storage;
701
702 if (starter && *starter)
703 prefix = starter;
704
705 sprintf (pointer, "%s__%d", prefix, num);
706 return pointer;
707 } /* temp_name */
708
709
710 char *
711 #ifdef KR_headers
equiv_name(memno,store)712 equiv_name(memno, store)
713 int memno;
714 char *store;
715 #else
716 equiv_name(int memno, char *store)
717 #endif
718 {
719 static char buf[IDENT_LEN];
720 char *pointer = buf;
721
722 if (store)
723 pointer = store;
724
725 sprintf (pointer, "%s_%d", EQUIV_INIT_NAME, memno);
726 return pointer;
727 } /* equiv_name */
728
729 void
730 #ifdef KR_headers
def_commons(of)731 def_commons(of)
732 FILE *of;
733 #else
734 def_commons(FILE *of)
735 #endif
736 {
737 Extsym *ext;
738 int c, onefile, Union;
739 chainp comm;
740 extern int ext1comm;
741 FILE *c_filesave = c_file;
742
743 if (ext1comm == 1) {
744 onefile = 1;
745 c_file = of;
746 fprintf(of, "/*>>>'/dev/null'<<<*/\n\
747 #ifdef Define_COMMONs\n\
748 /*<<</dev/null>>>*/\n");
749 }
750 else
751 onefile = 0;
752 for(ext = extsymtab; ext < nextext; ext++)
753 if (ext->extstg == STGCOMMON
754 && !ext->extinit && (comm = ext->allextp)) {
755 sprintf(outbtail, "%scom.c", ext->cextname);
756 if (onefile)
757 fprintf(of, "/*>>>'%s'<<<*/\n",
758 outbtail);
759 else {
760 c_file = of = fopen(outbuf,textwrite);
761 if (!of)
762 fatalstr("can't open %s", outbuf);
763 }
764 fprintf(of, "#include \"f2c.h\"\n");
765 if (Ansi == 2)
766 fprintf(of,
767 "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n");
768 if (comm->nextp) {
769 Union = 1;
770 nice_printf(of, "union {\n");
771 next_tab(of);
772 }
773 else
774 Union = 0;
775 for(c = 1; comm; comm = comm->nextp) {
776 nice_printf(of, "struct {\n");
777 next_tab(of);
778 wr_struct(of, (chainp)comm->datap);
779 prev_tab(of);
780 if (Union)
781 nice_printf(of, "} _%d;\n", c++);
782 }
783 if (Union)
784 prev_tab(of);
785 nice_printf(of, "} %s;\n", ext->cextname);
786 if (Ansi == 2)
787 fprintf(of,
788 "\n#ifdef __cplusplus\n}\n#endif\n");
789 if (onefile)
790 fprintf(of, "/*<<<%s>>>*/\n", outbtail);
791 else
792 fclose(of);
793 }
794 if (onefile)
795 fprintf(of, "/*>>>'/dev/null'<<<*/\n#endif\n\
796 /*<<</dev/null>>>*/\n");
797 c_file = c_filesave;
798 }
799
800 /* C Language keywords. Needed to filter unwanted fortran identifiers like
801 * "int", etc. Source: Kernighan & Ritchie, eds. 1 and 2; Stroustrup.
802 * Also includes C++ keywords and types used for I/O in f2c.h .
803 * These keywords must be in alphabetical order (as defined by strcmp()).
804 */
805
806 char *c_keywords[] = {
807 "Long", "Multitype", "Namelist", "Vardesc", "abs", "acos",
808 "addr", "address", "aerr", "alist", "asin", "asm", "atan",
809 "atan2", "aunit", "auto", "break", "c", "case", "catch", "cdecl",
810 "cerr", "char", "ciend", "cierr", "cifmt", "cilist", "cirec",
811 "ciunit", "class", "cllist", "complex", "const", "continue", "cos",
812 "cosh", "csta", "cunit", "d", "dabs", "default", "defined",
813 "delete", "dims", "dmax", "dmin", "do", "double",
814 "doublecomplex", "doublereal", "else", "entry", "enum", "exp",
815 "extern", "false", "far", "flag", "float", "for", "friend",
816 "ftnint", "ftnlen", "goto", "h", "huge", "i", "iciend", "icierr",
817 "icifmt", "icilist", "icirlen", "icirnum", "iciunit", "if",
818 "inacc", "inacclen", "inblank", "inblanklen", "include",
819 "indir", "indirlen", "inerr", "inex", "infile", "infilen",
820 "infmt", "infmtlen", "inform", "informlen", "inline", "inlist",
821 "inname", "innamed", "innamlen", "innrec", "innum", "inopen",
822 "inrecl", "inseq", "inseqlen", "int", "integer", "integer1",
823 "inunf", "inunflen", "inunit", "log", "logical", "logical1",
824 "long", "longint", "max", "min", "name", "near", "new", "nvars",
825 "oacc", "oblnk", "oerr", "ofm", "ofnm", "ofnmlen", "olist",
826 "operator", "orl", "osta", "ounit", "overload", "private",
827 "protected", "public", "r", "real", "register", "return",
828 "short", "shortint", "shortlogical", "signed", "sin", "sinh",
829 "sizeof", "sqrt", "static", "struct", "switch", "tan", "tanh",
830 "template", "this", "true", "try", "type", "typedef", "uinteger",
831 "ulongint", "union", "unsigned", "vars", "virtual", "void",
832 "volatile", "while", "z"
833 }; /* c_keywords */
834
835 int n_keywords = sizeof(c_keywords)/sizeof(char *);
836