1 /****************************************************************
2 Copyright 1990 by AT&T Bell Laboratories and Bellcore.
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 or
10 Bellcore or any of their entities not be used in advertising or
11 publicity pertaining to distribution of the software without
12 specific, written prior permission.
14 AT&T and Bellcore disclaim all warranties with regard to this
15 software, including all implied warranties of merchantability
16 and fitness. In no event shall AT&T or Bellcore be liable for
17 any special, indirect or consequential damages or any damages
18 whatsoever resulting from loss of use, data or profits, whether
19 in an action of contract, negligence or other tortious action,
20 arising out of or in connection with the use or performance of
22 ****************************************************************/
29 #define MAX_INIT_LINE 100
32 static int memno2info();
35 extern char *str_fmt[], *initbname;
36 extern void def_start();
38 void list_init_data(Infile, Inname, outfile)
39 FILE **Infile, *outfile;
48 if (status = dsort(Inname, sortfname))
49 fatali ("sort failed, status %d", status);
51 if ((sortfp = fopen(sortfname, textread)) == NULL)
52 Fatal("Couldn't open sorted initialization data");
54 do_init_data(outfile, sortfp);
57 /* Insert a blank line after any initialized data */
59 nice_printf (outfile, "\n");
61 if (debugflag && infname)
62 /* don't back block data file up -- it won't be overwritten */
63 backup(initfname, initbname);
64 } /* list_init_data */
68 /* do_init_data -- returns YES when at least one declaration has been
71 int do_init_data(outfile, infile)
72 FILE *outfile, *infile;
74 char varname[NAME_MAX], ovarname[NAME_MAX];
77 int vargroup; /* 0 --> init, 1 --> equiv, 2 --> common */
78 int did_one = 0; /* True when one has been output */
79 chainp values = CHNULL; /* Actual data values */
85 while (rdname (infile, &vargroup, varname) && rdlong (infile, &offset)
86 && rdlong (infile, &type)) {
87 if (strcmp (varname, ovarname)) {
89 /* If this is a new variable name, the old initialization has been
92 wr_one_init(outfile, ovarname, &values, keepit);
94 strcpy (ovarname, varname);
97 if (memno2info(atoi(varname+2), &np)) {
98 if (((Addrp)np)->uname_tag != UNAM_NAME) {
99 err("do_init_data: expected NAME");
102 np = ((Addrp)np)->user.name;
104 if (!(keepit = np->visused) && !np->vimpldovar)
105 warn1("local variable %s never used",
112 if (keepit && !did_one) {
113 nice_printf (outfile, "/* Initialized data */\n\n");
118 values = mkchain((char *)data_value(infile, offset, (int)type), values);
121 /* Write out the last declaration */
123 wr_one_init (outfile, ovarname, &values, keepit);
130 wr_char_len(outfile, dimp, n, extra1)
133 struct Dimblock *dimp;
140 nice_printf (outfile, extra1 ? "[%d+1]" : "[%d]", n);
143 nice_printf(outfile, "[%d", n);
145 for(i = 0; i < nd; i++) {
146 e = dimp->dims[i].dimsize;
148 err ("wr_char_len: nonconstant array size");
150 nice_printf(outfile, "*%ld", e->constblock.Const.ci);
152 /* extra1 allows for stupid C compilers that complain about
153 * too many initializers in
156 nice_printf(outfile, extra1 ? "+1]" : "]");
159 static int ch_ar_dim = -1; /* length of each element of char string array */
160 static int eqvmemno; /* kludge */
163 write_char_init(outfile, Values, namep)
168 struct Equivblock *eqv;
170 struct Dimblock *dimp;
176 if(nequiv >= maxequiv)
177 many("equivalences", 'q', maxequiv);
178 eqv = &eqvclass[nequiv];
181 size = type == TYCHAR
182 ? namep->vleng->constblock.Const.ci
184 if (dimp = namep->vdim)
185 for(i = 0, nd = dimp->ndim; i < nd; i++) {
186 ds = dimp->dims[i].dimsize;
188 err("write_char_values: nonconstant array size");
190 size *= ds->constblock.Const.ci;
192 *Values = revchain(*Values);
194 eqvmemno = ++lastvarno;
196 wr_equiv_init(outfile, nequiv, Values, 0);
197 def_start(outfile, namep->cvarname, CNULL, "");
199 ind_printf(0, outfile, "((char *)&equiv_%d)\n\n", eqvmemno);
201 ind_printf(0, outfile, dimp
202 ? "((%s *)&equiv_%d)\n\n" : "(*(%s *)&equiv_%d)\n\n",
203 c_type_decl(type,0), eqvmemno);
206 /* wr_one_init -- outputs the initialization of the variable pointed to
207 by info. When is_addr is true, info is an Addrp; otherwise,
208 treat it as a Namep */
210 void wr_one_init (outfile, varname, Values, keepit)
225 char *array_comment = NULL;
227 extern char datachar[];
228 static int e1[3] = {1, 0, 1};
232 if (varname == NULL || varname[1] != '.')
235 /* Get back to a meaningful representation; find the given memno in one
236 of the appropriate tables (user-generated variables in the hash table,
237 system-generated variables in a separate list */
239 memno = atoi(varname + 2);
242 /* Must subtract eqvstart when the source file
243 * contains more than one procedure.
245 wr_equiv_init(outfile, eqvmemno = memno - eqvstart, Values, 0);
248 /* COMMON initialization (BLOCK DATA) */
249 wr_equiv_init(outfile, memno, Values, 1);
255 errstr("wr_one_init: unknown variable name '%s'", varname);
259 is_addr = memno2info (memno, &info.name);
260 if (info.name == (Namep) NULL) {
261 err ("wr_one_init -- unknown variable");
265 if (info.addr -> uname_tag != UNAM_NAME) {
266 erri ("wr_one_init -- couldn't get name pointer; tag is %d",
267 info.addr -> uname_tag);
268 namep = (Namep) NULL;
269 nice_printf (outfile, " /* bad init data */");
271 namep = info.addr -> user.name;
275 /* check for character initialization */
277 *Values = values = revchain(*Values);
278 if (info.name->vtype == TYCHAR) {
279 for(last = 1; values; values = values->nextp) {
280 cp = (chainp)values->datap;
281 loc = (ftnint)cp->datap;
283 write_char_init(outfile, Values, namep);
286 last = (int)cp->nextp->datap == TYBLANK
287 ? loc + (int)cp->nextp->nextp->datap
292 size = typesize[info.name->vtype];
294 for(; values; values = values->nextp) {
295 if ((int)((chainp)values->datap)->nextp->datap == TYCHAR) {
296 write_char_init(outfile, Values, namep);
299 last = ((long) ((chainp) values->datap)->datap) / size;
300 if (last - loc > 4) {
301 write_char_init(outfile, Values, namep);
309 nice_printf (outfile, "static %s ", c_type_decl (info.name -> vtype, 0));
312 write_nv_ident (outfile, info.addr);
314 out_name (outfile, info.name);
317 is_scalar = namep -> vdim == (struct Dimblock *) NULL;
319 if (namep && !is_scalar)
320 array_comment = info.name->vtype == TYCHAR
321 ? 0 : wr_ardecls(outfile, namep->vdim, 1L);
323 if (info.name -> vtype == TYCHAR)
324 if (ISICON (info.name -> vleng))
326 /* We'll make single strings one character longer, so that we can use the
327 standard C initialization. All this does is pad an extra zero onto the
329 wr_char_len(outfile, namep->vdim, ch_ar_dim =
330 info.name -> vleng -> constblock.Const.ci, e1[Ansi]);
332 err ("variable length character initialization");
335 nice_printf (outfile, "%s", array_comment);
337 nice_printf (outfile, " = ");
338 wr_output_values (outfile, namep, values);
340 nice_printf (outfile, ";\n");
348 chainp data_value (infile, offset, type)
353 char line[MAX_INIT_LINE + 1], *pointer;
354 chainp vals, prev_val;
358 if (fgets (line, MAX_INIT_LINE, infile) == NULL) {
359 err ("data_value: error reading from intermediate file");
363 /* Get rid of the trailing newline */
366 line[strlen (line) - 1] = '\0';
368 #define iswhite(x) (isspace (x) || (x) == ',')
371 prev_val = vals = CHNULL;
374 register char *end_ptr, old_val;
376 /* Move pointer to the start of the next word */
378 while (*pointer && iswhite (*pointer))
380 if (*pointer == '\0')
383 /* Move end_ptr to the end of the current word */
385 for (end_ptr = pointer + 1; *end_ptr && !iswhite (*end_ptr);
392 /* Add this value to the end of the list */
394 if (ONEOF(type, MSKREAL|MSKCOMPLEX))
395 newval = cpstring(pointer);
397 newval = (char *)atol(pointer);
399 prev_val->nextp = mkchain(newval, CHNULL);
400 prev_val = prev_val -> nextp;
402 prev_val = vals = mkchain(newval, CHNULL);
405 } /* while *pointer */
407 return mkchain((char *)offset, mkchain((char *)type, vals));
413 extern char *filename0;
414 static int warned = 0;
420 fprintf(stderr, "Error");
422 fprintf(stderr, " in file %s", filename0);
423 fprintf(stderr, ": overlapping initializations\n");
427 static void make_one_const();
430 void wr_output_values (outfile, namep, values)
435 int type = TYUNKNOWN;
436 struct Constblock Const;
440 type = namep -> vtype;
442 /* Handle array initializations away from scalars */
444 if (namep && namep -> vdim)
445 wr_array_init (outfile, namep -> vtype, values);
447 else if (values->nextp && type != TYCHAR)
451 make_one_const(type, &Const.Const, values);
453 Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX);
458 Vlen->constblock.Const.ci = charlen;
459 out_const (outfile, &Const);
460 free (Const.Const.ccp);
463 out_const (outfile, &Const);
468 wr_array_init (outfile, type, values)
473 int size = typesize[type];
474 long index, main_index = 0;
477 if (type == TYCHAR) {
478 nice_printf(outfile, "\"");
485 nice_printf (outfile, "{ ");
487 struct Constblock Const;
489 index = ((long) ((chainp) values->datap)->datap) / size;
490 while (index > main_index) {
492 /* Fill with zeros. The structure shorthand works because the compiler
493 will expand the "0" in braces to fill the size of the entire structure
499 nice_printf (outfile, "0.0,");
503 nice_printf (outfile, "{0},");
506 nice_printf(outfile, " ");
509 nice_printf (outfile, "0,");
513 } /* while index > main_index */
515 if (index < main_index)
521 if (k == ch_ar_dim) {
522 nice_printf(outfile, "\"");
524 nice_printf(outfile, " \"");
528 this_char = (int) ((chainp) values->datap)->
530 if ((int)((chainp)values->datap)->nextp->datap == TYBLANK) {
531 main_index += this_char;
533 while(--this_char >= 0)
534 nice_printf(outfile, " ");
535 values = values -> nextp;
539 str_fmt[this_char & 0x7f],
552 make_one_const(type, &Const.Const, values);
554 Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX);
555 out_const(outfile, &Const);
558 erri("wr_array_init: bad type '%d'", type);
561 values = values->nextp;
564 if (values && type != TYCHAR)
565 nice_printf (outfile, ",");
568 if (type == TYCHAR) {
569 nice_printf(outfile, "\"");
573 nice_printf (outfile, " }");
574 } /* wr_array_init */
578 make_one_const(type, storage, values)
580 union Constant *storage;
583 union Constant *Const;
586 if (type == TYCHAR) {
587 char *str, *str_ptr, *Alloc ();
589 int b = 0, k, main_index = 0;
591 /* Find the max length of init string, by finding the highest offset
592 value stored in the list of initial values */
594 for(k = 1, prev = CHNULL, v = values; v; prev = v, v = v->nextp)
597 k = ((int) (((chainp) prev->datap)->datap)) + 2;
598 /* + 2 above for null char at end */
600 for (str_ptr = str; values; str_ptr++) {
601 int index = (int) (((chainp) values->datap)->datap);
603 if (index < main_index)
605 while (index > main_index++)
608 k = (int) (((chainp) values->datap)->nextp->nextp->datap);
609 if ((int)((chainp)values->datap)->nextp->datap == TYBLANK) {
614 values = values -> nextp;
619 Const -> ccp1.blanks = b;
620 charlen = str_ptr - str;
625 vals = ((chainp)values->datap)->nextp->nextp;
627 L = (char **)storage;
628 do L[i++] = vals->datap;
629 while(vals = vals->nextp);
634 } /* make_one_const */
638 rdname (infile, vargroupp, name)
650 *vargroupp = c - '0';
653 Fatal("rdname: oversize name");
671 for (c = getc (infile); !feof (infile) && isspace (c); c = getc (infile))
677 for (*n = 0; isdigit (c); c = getc (infile))
678 *n = 10 * (*n) + c - '0';
684 memno2info (memno, info)
689 extern chainp new_vars;
690 extern struct Hashentry *hashtab, *lasthash;
691 struct Hashentry *entry;
693 for (this_var = new_vars; this_var; this_var = this_var -> nextp) {
694 Addrp var = (Addrp) this_var->datap;
696 if (var == (Addrp) NULL)
697 Fatal("memno2info: null variable");
698 else if (var -> tag != TADDR)
699 Fatal("memno2info: bad tag");
700 if (memno == var -> memno) {
703 } /* if memno == var -> memno */
704 } /* for this_var = new_vars */
706 for (entry = hashtab; entry < lasthash; ++entry) {
707 Namep var = entry -> varp;
709 if (var && var -> vardesc.varno == memno && var -> vstg == STGINIT) {
712 } /* if entry -> vardesc.varno == memno */
713 } /* for entry = hashtab */
715 Fatal("memno2info: couldn't find memno");
720 do_string(outfile, v, nloc)
725 register chainp cp, v0;
727 extern char *chr_fmt[];
731 nice_printf(outfile, "{");
732 cp = (chainp)v->datap;
733 loc = (ftnint)cp->datap;
736 switch((int)cp->nextp->datap) {
738 k = (ftnint)cp->nextp->nextp->datap;
741 nice_printf(outfile, "%s' '", comma);
746 uk = (ftnint)cp->nextp->nextp->datap;
747 sprintf(buf, chr_fmt[uk < 0x7f ? uk : 0x7f], uk);
748 nice_printf(outfile, "%s'%s'", comma, buf);
758 cp = (chainp)v->datap;
759 dloc = (ftnint)cp->datap;
764 nice_printf(outfile, "}");
770 Ado_string(outfile, v, nloc)
775 register chainp cp, v0;
778 nice_printf(outfile, "\"");
780 cp = (chainp)v->datap;
781 loc = (ftnint)cp->datap;
783 switch((int)cp->nextp->datap) {
785 k = (ftnint)cp->nextp->nextp->datap;
788 nice_printf(outfile, " ");
791 k = (ftnint)cp->nextp->nextp->datap;
792 nice_printf(outfile, str_fmt[k & 0x7f], k);
801 cp = (chainp)v->datap;
802 dloc = (ftnint)cp->datap;
807 nice_printf(outfile, "\"");
820 sprintf(buf, "[%ld]", L);
824 wr_equiv_init(outfile, memno, Values, iscomm)
830 struct Equivblock *eqv;
832 int curtype, dtype, filltype, filltype1, j, k, wasblank, xtype;
833 static char Blank[] = "";
834 register char *comma = Blank;
835 register chainp cp, v;
836 chainp sentinel, values, v1;
837 ftnint L, L1, dL, dloc, loc, loc0;
838 union Constant Const;
839 char imag_buf[50], real_buf[50];
840 int szshort = typesize[TYSHORT];
841 static char typepref[] = {0, 0, TYSHORT, TYLONG, TYREAL, TYDREAL,
842 TYREAL, TYDREAL, TYLOGICAL, TYCHAR};
847 L = extsymtab[memno].maxleng;
848 xtype = extsymtab[memno].extype;
851 eqv = &eqvclass[memno];
852 L = eqv->eqvtop - eqv->eqvbottom;
853 xtype = eqv->eqvtype;
856 if (xtype != TYCHAR) {
858 /* unless the data include a value of the appropriate
859 * type, we add an extra element in an attempt
860 * to force correct alignment */
862 for(v = *Values;;v = v->nextp) {
864 dtype = typepref[xtype];
865 z = ISREAL(dtype) ? cpstring("0.") : (char *)0;
869 v = mkchain((char *)L,
870 mkchain((char *)dtype,
871 mkchain(z, CHNULL)));
872 *Values = mkchain((char *)v, *Values);
876 if ((int)((chainp)v->datap)->nextp->datap == xtype)
881 sentinel = mkchain((char *)L, mkchain((char *)TYERROR,CHNULL));
882 *Values = values = revchain(mkchain((char *)sentinel, *Values));
884 /* use doublereal fillers only if there are doublereal values */
887 for(v = values; v; v = v->nextp)
888 if (ONEOF((int)((chainp)v->datap)->nextp->datap,
889 M(TYDREAL)|M(TYDCOMPLEX))) {
895 nice_printf(outfile, "%sstruct {\n", iscomm ? "" : "static ");
899 for(v = values; v; v = v->nextp) {
900 cp = (chainp)v->datap;
901 dloc = (ftnint)cp->datap;
910 dtype = (int)cp->nextp->datap;
911 if (dtype == TYBLANK) {
917 if (curtype != dtype || L > 0) {
919 L1 = (loc - loc0)/dL;
920 nice_printf(outfile, "%s e_%d%s;\n",
921 typename[curtype], ++k, Len(L1));
930 filltype = L % szshort ? TYCHAR
931 : type_choice[L/szshort % 4];
932 filltype1 = loc % szshort ? TYCHAR
933 : type_choice[loc/szshort % 4];
934 if (typesize[filltype] > typesize[filltype1])
935 filltype = filltype1;
937 nice_printf(outfile, "struct { %s filler%s; } e_%d;\n",
939 Len(L/typesize[filltype]), ++k);
943 loc += (ftnint)cp->nextp->nextp->datap;
947 dL = typesize[dtype];
951 nice_printf(outfile, "} %s = { ", iscomm
952 ? extsymtab[memno].cextname
953 : equiv_name(eqvmemno, CNULL));
955 for(v = values; ; v = v->nextp) {
956 cp = (chainp)v->datap;
959 dtype = (int)cp->nextp->datap;
960 if (dtype == TYERROR)
962 dloc = (ftnint)cp->datap;
964 nice_printf(outfile, "%s{0}", comma);
969 nice_printf(outfile, ", ");
971 if (dtype == TYCHAR || dtype == TYBLANK) {
972 v = Ansi == 1 ? Ado_string(outfile, v, &loc)
973 : do_string(outfile, v, &loc);
976 make_one_const(dtype, &Const, v);
979 if (Const.ci < 0 || Const.ci > 1)
981 "wr_equiv_init: unexpected logical value %ld",
984 Const.ci ? "TRUE_" : "FALSE_");
988 nice_printf(outfile, "%ld", Const.ci);
991 nice_printf(outfile, "%s",
992 flconst(real_buf, Const.cds[0]));
995 nice_printf(outfile, "%s", Const.cds[0]);
998 nice_printf(outfile, "%s, %s",
999 flconst(real_buf, Const.cds[0]),
1000 flconst(imag_buf, Const.cds[1]));
1003 nice_printf(outfile, "%s, %s",
1004 Const.cds[0], Const.cds[1]);
1007 erri("unexpected type %d in wr_equiv_init",
1010 loc += typesize[dtype];
1012 nice_printf(outfile, " };\n\n");