![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to formatdata.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / f2c|
Return to formatdata.c CVS log | Up to [Research Unix] / researchv10no / cmd / f2c |
1.1 ! root 1: /**************************************************************** ! 2: Copyright 1990, 1991, 1993 by AT&T Bell Laboratories 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 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. ! 13: ! 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 ! 21: this software. ! 22: ****************************************************************/ ! 23: ! 24: #include "defs.h" ! 25: #include "output.h" ! 26: #include "names.h" ! 27: #include "format.h" ! 28: ! 29: #define MAX_INIT_LINE 100 ! 30: #define NAME_MAX 64 ! 31: ! 32: static int memno2info(); ! 33: ! 34: extern char *initbname; ! 35: extern void def_start(); ! 36: ! 37: void list_init_data(Infile, Inname, outfile) ! 38: FILE **Infile, *outfile; ! 39: char *Inname; ! 40: { ! 41: FILE *sortfp; ! 42: int status; ! 43: ! 44: fclose(*Infile); ! 45: *Infile = 0; ! 46: ! 47: if (status = dsort(Inname, sortfname)) ! 48: fatali ("sort failed, status %d", status); ! 49: ! 50: scrub(Inname); /* optionally unlink Inname */ ! 51: ! 52: if ((sortfp = fopen(sortfname, textread)) == NULL) ! 53: Fatal("Couldn't open sorted initialization data"); ! 54: ! 55: do_init_data(outfile, sortfp); ! 56: fclose(sortfp); ! 57: scrub(sortfname); ! 58: ! 59: /* Insert a blank line after any initialized data */ ! 60: ! 61: nice_printf (outfile, "\n"); ! 62: ! 63: if (debugflag && infname) ! 64: /* don't back block data file up -- it won't be overwritten */ ! 65: backup(initfname, initbname); ! 66: } /* list_init_data */ ! 67: ! 68: ! 69: ! 70: /* do_init_data -- returns YES when at least one declaration has been ! 71: written */ ! 72: ! 73: int do_init_data(outfile, infile) ! 74: FILE *outfile, *infile; ! 75: { ! 76: char varname[NAME_MAX], ovarname[NAME_MAX]; ! 77: ftnint offset; ! 78: ftnint type; ! 79: int vargroup; /* 0 --> init, 1 --> equiv, 2 --> common */ ! 80: int did_one = 0; /* True when one has been output */ ! 81: chainp values = CHNULL; /* Actual data values */ ! 82: int keepit = 0; ! 83: Namep np; ! 84: ! 85: ovarname[0] = '\0'; ! 86: ! 87: while (rdname (infile, &vargroup, varname) && rdlong (infile, &offset) ! 88: && rdlong (infile, &type)) { ! 89: if (strcmp (varname, ovarname)) { ! 90: ! 91: /* If this is a new variable name, the old initialization has been ! 92: completed */ ! 93: ! 94: wr_one_init(outfile, ovarname, &values, keepit); ! 95: ! 96: strcpy (ovarname, varname); ! 97: values = CHNULL; ! 98: if (vargroup == 0) { ! 99: if (memno2info(atoi(varname+2), &np)) { ! 100: if (((Addrp)np)->uname_tag != UNAM_NAME) { ! 101: err("do_init_data: expected NAME"); ! 102: goto Keep; ! 103: } ! 104: np = ((Addrp)np)->user.name; ! 105: } ! 106: if (!(keepit = np->visused) && !np->vimpldovar) ! 107: warn1("local variable %s never used", ! 108: np->fvarname); ! 109: } ! 110: else { ! 111: Keep: ! 112: keepit = 1; ! 113: } ! 114: if (keepit && !did_one) { ! 115: nice_printf (outfile, "/* Initialized data */\n\n"); ! 116: did_one = YES; ! 117: } ! 118: } /* if strcmp */ ! 119: ! 120: values = mkchain((char *)data_value(infile, offset, (int)type), values); ! 121: } /* while */ ! 122: ! 123: /* Write out the last declaration */ ! 124: ! 125: wr_one_init (outfile, ovarname, &values, keepit); ! 126: ! 127: return did_one; ! 128: } /* do_init_data */ ! 129: ! 130: ! 131: ftnint ! 132: wr_char_len(outfile, dimp, n, extra1) ! 133: FILE *outfile; ! 134: int n; ! 135: struct Dimblock *dimp; ! 136: int extra1; ! 137: { ! 138: int i, nd; ! 139: expptr e; ! 140: ftnint rv; ! 141: ! 142: if (!dimp) { ! 143: nice_printf (outfile, extra1 ? "[%d+1]" : "[%d]", n); ! 144: return n + extra1; ! 145: } ! 146: nice_printf(outfile, "[%d", n); ! 147: nd = dimp->ndim; ! 148: rv = n; ! 149: for(i = 0; i < nd; i++) { ! 150: e = dimp->dims[i].dimsize; ! 151: if (!ISICON (e)) ! 152: err ("wr_char_len: nonconstant array size"); ! 153: else { ! 154: nice_printf(outfile, "*%ld", e->constblock.Const.ci); ! 155: rv *= e->constblock.Const.ci; ! 156: } ! 157: } ! 158: /* extra1 allows for stupid C compilers that complain about ! 159: * too many initializers in ! 160: * char x[2] = "ab"; ! 161: */ ! 162: nice_printf(outfile, extra1 ? "+1]" : "]"); ! 163: return extra1 ? rv+1 : rv; ! 164: } ! 165: ! 166: static int ch_ar_dim = -1; /* length of each element of char string array */ ! 167: static int eqvmemno; /* kludge */ ! 168: ! 169: static void ! 170: write_char_init(outfile, Values, namep) ! 171: FILE *outfile; ! 172: chainp *Values; ! 173: Namep namep; ! 174: { ! 175: struct Equivblock *eqv; ! 176: long size; ! 177: struct Dimblock *dimp; ! 178: int i, nd, type; ! 179: expptr ds; ! 180: ! 181: if (!namep) ! 182: return; ! 183: if(nequiv >= maxequiv) ! 184: many("equivalences", 'q', maxequiv); ! 185: eqv = &eqvclass[nequiv]; ! 186: eqv->eqvbottom = 0; ! 187: type = namep->vtype; ! 188: size = type == TYCHAR ! 189: ? namep->vleng->constblock.Const.ci ! 190: : typesize[type]; ! 191: if (dimp = namep->vdim) ! 192: for(i = 0, nd = dimp->ndim; i < nd; i++) { ! 193: ds = dimp->dims[i].dimsize; ! 194: if (!ISICON(ds)) ! 195: err("write_char_values: nonconstant array size"); ! 196: else ! 197: size *= ds->constblock.Const.ci; ! 198: } ! 199: *Values = revchain(*Values); ! 200: eqv->eqvtop = size; ! 201: eqvmemno = ++lastvarno; ! 202: eqv->eqvtype = type; ! 203: wr_equiv_init(outfile, nequiv, Values, 0); ! 204: def_start(outfile, namep->cvarname, CNULL, ""); ! 205: if (type == TYCHAR) ! 206: ind_printf(0, outfile, "((char *)&equiv_%d)\n\n", eqvmemno); ! 207: else ! 208: ind_printf(0, outfile, dimp ! 209: ? "((%s *)&equiv_%d)\n\n" : "(*(%s *)&equiv_%d)\n\n", ! 210: c_type_decl(type,0), eqvmemno); ! 211: } ! 212: ! 213: /* wr_one_init -- outputs the initialization of the variable pointed to ! 214: by info. When is_addr is true, info is an Addrp; otherwise, ! 215: treat it as a Namep */ ! 216: ! 217: void wr_one_init (outfile, varname, Values, keepit) ! 218: FILE *outfile; ! 219: char *varname; ! 220: chainp *Values; ! 221: int keepit; ! 222: { ! 223: static int memno; ! 224: static union { ! 225: Namep name; ! 226: Addrp addr; ! 227: } info; ! 228: Namep namep; ! 229: int is_addr, size, type; ! 230: ftnint last, loc; ! 231: int is_scalar = 0; ! 232: char *array_comment = NULL, *name; ! 233: chainp cp, values; ! 234: extern char datachar[]; ! 235: static int e1[3] = {1, 0, 1}; ! 236: ftnint x; ! 237: extern int hsize; ! 238: ! 239: if (!keepit) ! 240: goto done; ! 241: if (varname == NULL || varname[1] != '.') ! 242: goto badvar; ! 243: ! 244: /* Get back to a meaningful representation; find the given memno in one ! 245: of the appropriate tables (user-generated variables in the hash table, ! 246: system-generated variables in a separate list */ ! 247: ! 248: memno = atoi(varname + 2); ! 249: switch(varname[0]) { ! 250: case 'q': ! 251: /* Must subtract eqvstart when the source file ! 252: * contains more than one procedure. ! 253: */ ! 254: wr_equiv_init(outfile, eqvmemno = memno - eqvstart, Values, 0); ! 255: goto done; ! 256: case 'Q': ! 257: /* COMMON initialization (BLOCK DATA) */ ! 258: wr_equiv_init(outfile, memno, Values, 1); ! 259: goto done; ! 260: case 'v': ! 261: break; ! 262: default: ! 263: badvar: ! 264: errstr("wr_one_init: unknown variable name '%s'", varname); ! 265: goto done; ! 266: } ! 267: ! 268: is_addr = memno2info (memno, &info.name); ! 269: if (info.name == (Namep) NULL) { ! 270: err ("wr_one_init -- unknown variable"); ! 271: return; ! 272: } ! 273: if (is_addr) { ! 274: if (info.addr -> uname_tag != UNAM_NAME) { ! 275: erri ("wr_one_init -- couldn't get name pointer; tag is %d", ! 276: info.addr -> uname_tag); ! 277: namep = (Namep) NULL; ! 278: nice_printf (outfile, " /* bad init data */"); ! 279: } else ! 280: namep = info.addr -> user.name; ! 281: } else ! 282: namep = info.name; ! 283: ! 284: /* check for character initialization */ ! 285: ! 286: *Values = values = revchain(*Values); ! 287: type = info.name->vtype; ! 288: if (type == TYCHAR) { ! 289: for(last = 0; values; values = values->nextp) { ! 290: cp = (chainp)values->datap; ! 291: loc = (ftnint)cp->datap; ! 292: if (loc > last) { ! 293: write_char_init(outfile, Values, namep); ! 294: goto done; ! 295: } ! 296: last = (int)cp->nextp->datap == TYBLANK ! 297: ? loc + (int)cp->nextp->nextp->datap ! 298: : loc + 1; ! 299: } ! 300: if (halign && info.name->tag == TNAME) { ! 301: nice_printf(outfile, "static struct { %s fill; char val", ! 302: halign); ! 303: x = wr_char_len(outfile, namep->vdim, ch_ar_dim = ! 304: info.name -> vleng -> constblock.Const.ci, 1); ! 305: if (x %= hsize) ! 306: nice_printf(outfile, "; char fill2[%ld]", hsize - x); ! 307: name = info.name->cvarname; ! 308: nice_printf(outfile, "; } %s_st = { 0,", name); ! 309: wr_output_values(outfile, namep, *Values); ! 310: nice_printf(outfile, " };\n"); ! 311: ch_ar_dim = -1; ! 312: def_start(outfile, name, CNULL, name); ! 313: ind_printf(0, outfile, "_st.val\n"); ! 314: goto done; ! 315: } ! 316: } ! 317: else { ! 318: size = typesize[type]; ! 319: loc = 0; ! 320: for(; values; values = values->nextp) { ! 321: if ((int)((chainp)values->datap)->nextp->datap == TYCHAR) { ! 322: write_char_init(outfile, Values, namep); ! 323: goto done; ! 324: } ! 325: last = ((long) ((chainp) values->datap)->datap) / size; ! 326: if (last - loc > 4) { ! 327: write_char_init(outfile, Values, namep); ! 328: goto done; ! 329: } ! 330: loc = last; ! 331: } ! 332: } ! 333: values = *Values; ! 334: ! 335: nice_printf (outfile, "static %s ", c_type_decl (type, 0)); ! 336: ! 337: if (is_addr) ! 338: write_nv_ident (outfile, info.addr); ! 339: else ! 340: out_name (outfile, info.name); ! 341: ! 342: if (namep) ! 343: is_scalar = namep -> vdim == (struct Dimblock *) NULL; ! 344: ! 345: if (namep && !is_scalar) ! 346: array_comment = type == TYCHAR ! 347: ? 0 : wr_ardecls(outfile, namep->vdim, 1L); ! 348: ! 349: if (type == TYCHAR) ! 350: if (ISICON (info.name -> vleng)) ! 351: ! 352: /* We'll make single strings one character longer, so that we can use the ! 353: standard C initialization. All this does is pad an extra zero onto the ! 354: end of the string */ ! 355: wr_char_len(outfile, namep->vdim, ch_ar_dim = ! 356: info.name -> vleng -> constblock.Const.ci, e1[Ansi]); ! 357: else ! 358: err ("variable length character initialization"); ! 359: ! 360: if (array_comment) ! 361: nice_printf (outfile, "%s", array_comment); ! 362: ! 363: nice_printf (outfile, " = "); ! 364: wr_output_values (outfile, namep, values); ! 365: ch_ar_dim = -1; ! 366: nice_printf (outfile, ";\n"); ! 367: done: ! 368: frchain(Values); ! 369: } /* wr_one_init */ ! 370: ! 371: ! 372: ! 373: ! 374: chainp data_value (infile, offset, type) ! 375: FILE *infile; ! 376: ftnint offset; ! 377: int type; ! 378: { ! 379: char line[MAX_INIT_LINE + 1], *pointer; ! 380: chainp vals, prev_val; ! 381: long atol(); ! 382: char *newval; ! 383: ! 384: if (fgets (line, MAX_INIT_LINE, infile) == NULL) { ! 385: err ("data_value: error reading from intermediate file"); ! 386: return CHNULL; ! 387: } /* if fgets */ ! 388: ! 389: /* Get rid of the trailing newline */ ! 390: ! 391: if (line[0]) ! 392: line[strlen (line) - 1] = '\0'; ! 393: ! 394: #define iswhite(x) (isspace (x) || (x) == ',') ! 395: ! 396: pointer = line; ! 397: prev_val = vals = CHNULL; ! 398: ! 399: while (*pointer) { ! 400: register char *end_ptr, old_val; ! 401: ! 402: /* Move pointer to the start of the next word */ ! 403: ! 404: while (*pointer && iswhite (*pointer)) ! 405: pointer++; ! 406: if (*pointer == '\0') ! 407: break; ! 408: ! 409: /* Move end_ptr to the end of the current word */ ! 410: ! 411: for (end_ptr = pointer + 1; *end_ptr && !iswhite (*end_ptr); ! 412: end_ptr++) ! 413: ; ! 414: ! 415: old_val = *end_ptr; ! 416: *end_ptr = '\0'; ! 417: ! 418: /* Add this value to the end of the list */ ! 419: ! 420: if (ONEOF(type, MSKREAL|MSKCOMPLEX)) ! 421: newval = cpstring(pointer); ! 422: else ! 423: newval = (char *)atol(pointer); ! 424: if (vals) { ! 425: prev_val->nextp = mkchain(newval, CHNULL); ! 426: prev_val = prev_val -> nextp; ! 427: } else ! 428: prev_val = vals = mkchain(newval, CHNULL); ! 429: *end_ptr = old_val; ! 430: pointer = end_ptr; ! 431: } /* while *pointer */ ! 432: ! 433: return mkchain((char *)offset, mkchain((char *)LONG_CAST type, vals)); ! 434: } /* data_value */ ! 435: ! 436: static void ! 437: overlapping() ! 438: { ! 439: extern char *filename0; ! 440: static int warned = 0; ! 441: ! 442: if (warned) ! 443: return; ! 444: warned = 1; ! 445: ! 446: fprintf(stderr, "Error"); ! 447: if (filename0) ! 448: fprintf(stderr, " in file %s", filename0); ! 449: fprintf(stderr, ": overlapping initializations\n"); ! 450: nerr++; ! 451: } ! 452: ! 453: static void make_one_const(); ! 454: static long charlen; ! 455: ! 456: void wr_output_values (outfile, namep, values) ! 457: FILE *outfile; ! 458: Namep namep; ! 459: chainp values; ! 460: { ! 461: int type = TYUNKNOWN; ! 462: struct Constblock Const; ! 463: static expptr Vlen; ! 464: ! 465: if (namep) ! 466: type = namep -> vtype; ! 467: ! 468: /* Handle array initializations away from scalars */ ! 469: ! 470: if (namep && namep -> vdim) ! 471: wr_array_init (outfile, namep -> vtype, values); ! 472: ! 473: else if (values->nextp && type != TYCHAR) ! 474: overlapping(); ! 475: ! 476: else { ! 477: make_one_const(type, &Const.Const, values); ! 478: Const.vtype = type; ! 479: Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX) != 0; ! 480: if (type== TYCHAR) { ! 481: if (!Vlen) ! 482: Vlen = ICON(0); ! 483: Const.vleng = Vlen; ! 484: Vlen->constblock.Const.ci = charlen; ! 485: out_const (outfile, &Const); ! 486: free (Const.Const.ccp); ! 487: } ! 488: else ! 489: out_const (outfile, &Const); ! 490: } ! 491: } ! 492: ! 493: ! 494: wr_array_init (outfile, type, values) ! 495: FILE *outfile; ! 496: int type; ! 497: chainp values; ! 498: { ! 499: int size = typesize[type]; ! 500: long index, main_index = 0; ! 501: int k; ! 502: ! 503: if (type == TYCHAR) { ! 504: nice_printf(outfile, "\""); ! 505: k = 0; ! 506: if (Ansi != 1) ! 507: ch_ar_dim = -1; ! 508: } ! 509: else ! 510: nice_printf (outfile, "{ "); ! 511: while (values) { ! 512: struct Constblock Const; ! 513: ! 514: index = ((long) ((chainp) values->datap)->datap) / size; ! 515: while (index > main_index) { ! 516: ! 517: /* Fill with zeros. The structure shorthand works because the compiler ! 518: will expand the "0" in braces to fill the size of the entire structure ! 519: */ ! 520: ! 521: switch (type) { ! 522: case TYREAL: ! 523: case TYDREAL: ! 524: nice_printf (outfile, "0.0,"); ! 525: break; ! 526: case TYCOMPLEX: ! 527: case TYDCOMPLEX: ! 528: nice_printf (outfile, "{0},"); ! 529: break; ! 530: case TYCHAR: ! 531: nice_printf(outfile, " "); ! 532: break; ! 533: default: ! 534: nice_printf (outfile, "0,"); ! 535: break; ! 536: } /* switch */ ! 537: main_index++; ! 538: } /* while index > main_index */ ! 539: ! 540: if (index < main_index) ! 541: overlapping(); ! 542: else switch (type) { ! 543: case TYCHAR: ! 544: { int this_char; ! 545: ! 546: if (k == ch_ar_dim) { ! 547: nice_printf(outfile, "\" \""); ! 548: k = 0; ! 549: } ! 550: this_char = (int) ((chainp) values->datap)-> ! 551: nextp->nextp->datap; ! 552: if ((int)((chainp)values->datap)->nextp->datap == TYBLANK) { ! 553: main_index += this_char; ! 554: k += this_char; ! 555: while(--this_char >= 0) ! 556: nice_printf(outfile, " "); ! 557: values = values -> nextp; ! 558: continue; ! 559: } ! 560: nice_printf(outfile, str_fmt[this_char], this_char); ! 561: k++; ! 562: } /* case TYCHAR */ ! 563: break; ! 564: ! 565: case TYINT1: ! 566: case TYSHORT: ! 567: case TYLONG: ! 568: #ifdef TYQUAD ! 569: case TYQUAD: ! 570: #endif ! 571: case TYREAL: ! 572: case TYDREAL: ! 573: case TYLOGICAL: ! 574: case TYLOGICAL1: ! 575: case TYLOGICAL2: ! 576: case TYCOMPLEX: ! 577: case TYDCOMPLEX: ! 578: make_one_const(type, &Const.Const, values); ! 579: Const.vtype = type; ! 580: Const.vstg = ONEOF(type, MSKREAL|MSKCOMPLEX) != 0; ! 581: out_const(outfile, &Const); ! 582: break; ! 583: default: ! 584: erri("wr_array_init: bad type '%d'", type); ! 585: break; ! 586: } /* switch */ ! 587: values = values->nextp; ! 588: ! 589: main_index++; ! 590: if (values && type != TYCHAR) ! 591: nice_printf (outfile, ","); ! 592: } /* while values */ ! 593: ! 594: if (type == TYCHAR) { ! 595: nice_printf(outfile, "\""); ! 596: } ! 597: else ! 598: nice_printf (outfile, " }"); ! 599: } /* wr_array_init */ ! 600: ! 601: ! 602: static void ! 603: make_one_const(type, storage, values) ! 604: int type; ! 605: union Constant *storage; ! 606: chainp values; ! 607: { ! 608: union Constant *Const; ! 609: register char **L; ! 610: ! 611: if (type == TYCHAR) { ! 612: char *str, *str_ptr; ! 613: chainp v, prev; ! 614: int b = 0, k, main_index = 0; ! 615: ! 616: /* Find the max length of init string, by finding the highest offset ! 617: value stored in the list of initial values */ ! 618: ! 619: for(k = 1, prev = CHNULL, v = values; v; prev = v, v = v->nextp) ! 620: ; ! 621: if (prev != CHNULL) ! 622: k = ((int) (((chainp) prev->datap)->datap)) + 2; ! 623: /* + 2 above for null char at end */ ! 624: str = Alloc (k); ! 625: for (str_ptr = str; values; str_ptr++) { ! 626: int index = (int) (((chainp) values->datap)->datap); ! 627: ! 628: if (index < main_index) ! 629: overlapping(); ! 630: while (index > main_index++) ! 631: *str_ptr++ = ' '; ! 632: ! 633: k = (int) (((chainp) values->datap)->nextp->nextp->datap); ! 634: if ((int)((chainp)values->datap)->nextp->datap == TYBLANK) { ! 635: b = k; ! 636: break; ! 637: } ! 638: *str_ptr = k; ! 639: values = values -> nextp; ! 640: } /* for str_ptr */ ! 641: *str_ptr = '\0'; ! 642: Const = storage; ! 643: Const -> ccp = str; ! 644: Const -> ccp1.blanks = b; ! 645: charlen = str_ptr - str; ! 646: } else { ! 647: int i = 0; ! 648: chainp vals; ! 649: ! 650: vals = ((chainp)values->datap)->nextp->nextp; ! 651: if (vals) { ! 652: L = (char **)storage; ! 653: do L[i++] = vals->datap; ! 654: while(vals = vals->nextp); ! 655: } ! 656: ! 657: } /* else */ ! 658: ! 659: } /* make_one_const */ ! 660: ! 661: ! 662: ! 663: rdname (infile, vargroupp, name) ! 664: FILE *infile; ! 665: int *vargroupp; ! 666: char *name; ! 667: { ! 668: register int i, c; ! 669: ! 670: c = getc (infile); ! 671: ! 672: if (feof (infile)) ! 673: return NO; ! 674: ! 675: *vargroupp = c - '0'; ! 676: for (i = 1;; i++) { ! 677: if (i >= NAME_MAX) ! 678: Fatal("rdname: oversize name"); ! 679: c = getc (infile); ! 680: if (feof (infile)) ! 681: return NO; ! 682: if (c == '\t') ! 683: break; ! 684: *name++ = c; ! 685: } ! 686: *name = 0; ! 687: return YES; ! 688: } /* rdname */ ! 689: ! 690: rdlong (infile, n) ! 691: FILE *infile; ! 692: ftnint *n; ! 693: { ! 694: register int c; ! 695: ! 696: for (c = getc (infile); !feof (infile) && isspace (c); c = getc (infile)) ! 697: ; ! 698: ! 699: if (feof (infile)) ! 700: return NO; ! 701: ! 702: for (*n = 0; isdigit (c); c = getc (infile)) ! 703: *n = 10 * (*n) + c - '0'; ! 704: return YES; ! 705: } /* rdlong */ ! 706: ! 707: ! 708: static int ! 709: memno2info (memno, info) ! 710: int memno; ! 711: Namep *info; ! 712: { ! 713: chainp this_var; ! 714: extern chainp new_vars; ! 715: extern struct Hashentry *hashtab, *lasthash; ! 716: struct Hashentry *entry; ! 717: ! 718: for (this_var = new_vars; this_var; this_var = this_var -> nextp) { ! 719: Addrp var = (Addrp) this_var->datap; ! 720: ! 721: if (var == (Addrp) NULL) ! 722: Fatal("memno2info: null variable"); ! 723: else if (var -> tag != TADDR) ! 724: Fatal("memno2info: bad tag"); ! 725: if (memno == var -> memno) { ! 726: *info = (Namep) var; ! 727: return 1; ! 728: } /* if memno == var -> memno */ ! 729: } /* for this_var = new_vars */ ! 730: ! 731: for (entry = hashtab; entry < lasthash; ++entry) { ! 732: Namep var = entry -> varp; ! 733: ! 734: if (var && var -> vardesc.varno == memno && var -> vstg == STGINIT) { ! 735: *info = (Namep) var; ! 736: return 0; ! 737: } /* if entry -> vardesc.varno == memno */ ! 738: } /* for entry = hashtab */ ! 739: ! 740: Fatal("memno2info: couldn't find memno"); ! 741: return 0; ! 742: } /* memno2info */ ! 743: ! 744: static chainp ! 745: do_string(outfile, v, nloc) ! 746: FILEP outfile; ! 747: register chainp v; ! 748: ftnint *nloc; ! 749: { ! 750: register chainp cp, v0; ! 751: ftnint dloc, k, loc; ! 752: unsigned long uk; ! 753: char buf[8], *comma; ! 754: ! 755: nice_printf(outfile, "{"); ! 756: cp = (chainp)v->datap; ! 757: loc = (ftnint)cp->datap; ! 758: comma = ""; ! 759: for(v0 = v;;) { ! 760: switch((int)cp->nextp->datap) { ! 761: case TYBLANK: ! 762: k = (ftnint)cp->nextp->nextp->datap; ! 763: loc += k; ! 764: while(--k >= 0) { ! 765: nice_printf(outfile, "%s' '", comma); ! 766: comma = ", "; ! 767: } ! 768: break; ! 769: case TYCHAR: ! 770: uk = (ftnint)cp->nextp->nextp->datap; ! 771: sprintf(buf, chr_fmt[uk], uk); ! 772: nice_printf(outfile, "%s'%s'", comma, buf); ! 773: comma = ", "; ! 774: loc++; ! 775: break; ! 776: default: ! 777: goto done; ! 778: } ! 779: v0 = v; ! 780: if (!(v = v->nextp)) ! 781: break; ! 782: cp = (chainp)v->datap; ! 783: dloc = (ftnint)cp->datap; ! 784: if (loc != dloc) ! 785: break; ! 786: } ! 787: done: ! 788: nice_printf(outfile, "}"); ! 789: *nloc = loc; ! 790: return v0; ! 791: } ! 792: ! 793: static chainp ! 794: Ado_string(outfile, v, nloc) ! 795: FILEP outfile; ! 796: register chainp v; ! 797: ftnint *nloc; ! 798: { ! 799: register chainp cp, v0; ! 800: ftnint dloc, k, loc; ! 801: ! 802: nice_printf(outfile, "\""); ! 803: cp = (chainp)v->datap; ! 804: loc = (ftnint)cp->datap; ! 805: for(v0 = v;;) { ! 806: switch((int)cp->nextp->datap) { ! 807: case TYBLANK: ! 808: k = (ftnint)cp->nextp->nextp->datap; ! 809: loc += k; ! 810: while(--k >= 0) ! 811: nice_printf(outfile, " "); ! 812: break; ! 813: case TYCHAR: ! 814: k = (ftnint)cp->nextp->nextp->datap; ! 815: nice_printf(outfile, str_fmt[k], k); ! 816: loc++; ! 817: break; ! 818: default: ! 819: goto done; ! 820: } ! 821: v0 = v; ! 822: if (!(v = v->nextp)) ! 823: break; ! 824: cp = (chainp)v->datap; ! 825: dloc = (ftnint)cp->datap; ! 826: if (loc != dloc) ! 827: break; ! 828: } ! 829: done: ! 830: nice_printf(outfile, "\""); ! 831: *nloc = loc; ! 832: return v0; ! 833: } ! 834: ! 835: static char * ! 836: Len(L,type) ! 837: long L; ! 838: int type; ! 839: { ! 840: static char buf[24]; ! 841: if (L == 1 && type != TYCHAR) ! 842: return ""; ! 843: sprintf(buf, "[%ld]", L); ! 844: return buf; ! 845: } ! 846: ! 847: wr_equiv_init(outfile, memno, Values, iscomm) ! 848: FILE *outfile; ! 849: int memno; ! 850: chainp *Values; ! 851: int iscomm; ! 852: { ! 853: struct Equivblock *eqv; ! 854: char *equiv_name (); ! 855: int curtype, dtype, filltype, filltype1, j, k, wasblank, xtype; ! 856: static char Blank[] = ""; ! 857: register char *comma = Blank; ! 858: register chainp cp, v; ! 859: chainp sentinel, values, v1; ! 860: ftnint L, L1, dL, dloc, loc, loc0; ! 861: union Constant Const; ! 862: char imag_buf[50], real_buf[50]; ! 863: int szshort = typesize[TYSHORT]; ! 864: static char typepref[] = {0, 0, TYINT1, TYSHORT, TYLONG, ! 865: #ifdef TYQUAD ! 866: TYQUAD, ! 867: #endif ! 868: TYREAL, TYDREAL, TYREAL, TYDREAL, ! 869: TYLOGICAL1, TYLOGICAL2, ! 870: TYLOGICAL, TYCHAR}; ! 871: extern int htype; ! 872: char *z; ! 873: ! 874: /* add sentinel */ ! 875: if (iscomm) { ! 876: L = extsymtab[memno].maxleng; ! 877: xtype = extsymtab[memno].extype; ! 878: } ! 879: else { ! 880: eqv = &eqvclass[memno]; ! 881: L = eqv->eqvtop - eqv->eqvbottom; ! 882: xtype = eqv->eqvtype; ! 883: } ! 884: ! 885: if (halign && typealign[typepref[xtype]] < typealign[htype]) ! 886: xtype = htype; ! 887: ! 888: if (xtype != TYCHAR) { ! 889: ! 890: /* unless the data include a value of the appropriate ! 891: * type, we add an extra element in an attempt ! 892: * to force correct alignment */ ! 893: ! 894: for(v = *Values;;v = v->nextp) { ! 895: if (!v) { ! 896: dtype = typepref[xtype]; ! 897: z = ISREAL(dtype) ? cpstring("0.") : (char *)0; ! 898: k = typesize[dtype]; ! 899: if (j = L % k) ! 900: L += k - j; ! 901: v = mkchain((char *)L, ! 902: mkchain((char *)LONG_CAST dtype, ! 903: mkchain(z, CHNULL))); ! 904: *Values = mkchain((char *)v, *Values); ! 905: L += k; ! 906: break; ! 907: } ! 908: if ((int)((chainp)v->datap)->nextp->datap == xtype) ! 909: break; ! 910: } ! 911: } ! 912: ! 913: sentinel = mkchain((char *)L, mkchain((char *)TYERROR,CHNULL)); ! 914: *Values = values = revchain(mkchain((char *)sentinel, *Values)); ! 915: ! 916: /* use doublereal fillers only if there are doublereal values */ ! 917: ! 918: k = TYLONG; ! 919: for(v = values; v; v = v->nextp) ! 920: if (ONEOF((int)((chainp)v->datap)->nextp->datap, ! 921: M(TYDREAL)|M(TYDCOMPLEX))) { ! 922: k = TYDREAL; ! 923: break; ! 924: } ! 925: type_choice[0] = k; ! 926: ! 927: nice_printf(outfile, "%sstruct {\n", iscomm ? "" : "static "); ! 928: next_tab(outfile); ! 929: loc = loc0 = k = 0; ! 930: curtype = -1; ! 931: for(v = values; v; v = v->nextp) { ! 932: cp = (chainp)v->datap; ! 933: dloc = (ftnint)cp->datap; ! 934: L = dloc - loc; ! 935: if (L < 0) { ! 936: overlapping(); ! 937: if ((int)cp->nextp->datap != TYERROR) { ! 938: v1 = cp; ! 939: frchain(&v1); ! 940: v->datap = 0; ! 941: } ! 942: continue; ! 943: } ! 944: dtype = (int)cp->nextp->datap; ! 945: if (dtype == TYBLANK) { ! 946: dtype = TYCHAR; ! 947: wasblank = 1; ! 948: } ! 949: else ! 950: wasblank = 0; ! 951: if (curtype != dtype || L > 0) { ! 952: if (curtype != -1) { ! 953: L1 = (loc - loc0)/dL; ! 954: nice_printf(outfile, "%s e_%d%s;\n", ! 955: typename[curtype], ++k, ! 956: Len(L1,curtype)); ! 957: } ! 958: curtype = dtype; ! 959: loc0 = dloc; ! 960: } ! 961: if (L > 0) { ! 962: if (xtype == TYCHAR) ! 963: filltype = TYCHAR; ! 964: else { ! 965: filltype = L % szshort ? TYCHAR ! 966: : type_choice[L/szshort % 4]; ! 967: filltype1 = loc % szshort ? TYCHAR ! 968: : type_choice[loc/szshort % 4]; ! 969: if (typesize[filltype] > typesize[filltype1]) ! 970: filltype = filltype1; ! 971: } ! 972: L1 = L / typesize[filltype]; ! 973: nice_printf(outfile, "%s fill_%d[%ld];\n", ! 974: typename[filltype], ++k, L1); ! 975: loc = dloc; ! 976: } ! 977: if (wasblank) { ! 978: loc += (ftnint)cp->nextp->nextp->datap; ! 979: dL = 1; ! 980: } ! 981: else { ! 982: dL = typesize[dtype]; ! 983: loc += dL; ! 984: } ! 985: } ! 986: nice_printf(outfile, "} %s = { ", iscomm ! 987: ? extsymtab[memno].cextname ! 988: : equiv_name(eqvmemno, CNULL)); ! 989: loc = 0; ! 990: for(v = values; ; v = v->nextp) { ! 991: cp = (chainp)v->datap; ! 992: if (!cp) ! 993: continue; ! 994: dtype = (int)cp->nextp->datap; ! 995: if (dtype == TYERROR) ! 996: break; ! 997: dloc = (ftnint)cp->datap; ! 998: if (dloc > loc) { ! 999: nice_printf(outfile, "%s{0}", comma); ! 1000: comma = ", "; ! 1001: loc = dloc; ! 1002: } ! 1003: if (comma != Blank) ! 1004: nice_printf(outfile, ", "); ! 1005: comma = ", "; ! 1006: if (dtype == TYCHAR || dtype == TYBLANK) { ! 1007: v = Ansi == 1 ? Ado_string(outfile, v, &loc) ! 1008: : do_string(outfile, v, &loc); ! 1009: continue; ! 1010: } ! 1011: make_one_const(dtype, &Const, v); ! 1012: switch(dtype) { ! 1013: case TYLOGICAL: ! 1014: case TYLOGICAL2: ! 1015: case TYLOGICAL1: ! 1016: if (Const.ci < 0 || Const.ci > 1) ! 1017: errl( ! 1018: "wr_equiv_init: unexpected logical value %ld", ! 1019: Const.ci); ! 1020: nice_printf(outfile, ! 1021: Const.ci ? "TRUE_" : "FALSE_"); ! 1022: break; ! 1023: case TYINT1: ! 1024: case TYSHORT: ! 1025: case TYLONG: ! 1026: #ifdef TYQUAD ! 1027: case TYQUAD: ! 1028: #endif ! 1029: nice_printf(outfile, "%ld", Const.ci); ! 1030: break; ! 1031: case TYREAL: ! 1032: nice_printf(outfile, "%s", ! 1033: flconst(real_buf, Const.cds[0])); ! 1034: break; ! 1035: case TYDREAL: ! 1036: nice_printf(outfile, "%s", Const.cds[0]); ! 1037: break; ! 1038: case TYCOMPLEX: ! 1039: nice_printf(outfile, "%s, %s", ! 1040: flconst(real_buf, Const.cds[0]), ! 1041: flconst(imag_buf, Const.cds[1])); ! 1042: break; ! 1043: case TYDCOMPLEX: ! 1044: nice_printf(outfile, "%s, %s", ! 1045: Const.cds[0], Const.cds[1]); ! 1046: break; ! 1047: default: ! 1048: erri("unexpected type %d in wr_equiv_init", ! 1049: dtype); ! 1050: } ! 1051: loc += typesize[dtype]; ! 1052: } ! 1053: nice_printf(outfile, " };\n\n"); ! 1054: prev_tab(outfile); ! 1055: frchain(&sentinel); ! 1056: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.