![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to main.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 main.c CVS log | Up to [Research Unix] / researchv10no / cmd / f2c |
1.1 ! root 1: /**************************************************************** ! 2: Copyright 1990, 1991, 1992, 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: extern char F2C_version[]; ! 25: ! 26: #include "defs.h" ! 27: #include "parse.h" ! 28: ! 29: int complex_seen, dcomplex_seen; ! 30: ! 31: LOCAL int Max_ftn_files; ! 32: ! 33: char **ftn_files; ! 34: int current_ftn_file = 0; ! 35: ! 36: flag ftn66flag = NO; ! 37: flag nowarnflag = NO; ! 38: flag noextflag = NO; ! 39: flag no66flag = NO; /* Must also set noextflag to this ! 40: same value */ ! 41: flag zflag = YES; /* recognize double complex intrinsics */ ! 42: flag debugflag = NO; ! 43: flag onetripflag = NO; ! 44: flag shiftcase = YES; ! 45: flag undeftype = NO; ! 46: flag checksubs = NO; ! 47: flag r8flag = NO; ! 48: flag use_bs = YES; ! 49: flag keepsubs = NO; ! 50: #ifdef TYQUAD ! 51: flag use_tyquad = YES; ! 52: #endif ! 53: int tyreal = TYREAL; ! 54: int tycomplex = TYCOMPLEX; ! 55: extern void r8fix(), read_Pfiles(); ! 56: ! 57: int maxregvar = MAXREGVAR; /* if maxregvar > MAXREGVAR, error */ ! 58: int maxequiv = MAXEQUIV; ! 59: int maxext = MAXEXT; ! 60: int maxstno = MAXSTNO; ! 61: int maxctl = MAXCTL; ! 62: int maxhash = MAXHASH; ! 63: int maxliterals = MAXLITERALS; ! 64: int maxcontin = MAXCONTIN; ! 65: int maxlablist = MAXLABLIST; ! 66: int extcomm, ext1comm, useauto; ! 67: int can_include = YES; /* so we can disable includes for netlib */ ! 68: ! 69: static char *def_i2 = ""; ! 70: ! 71: static int useshortints = NO; /* YES => tyint = TYSHORT */ ! 72: static int uselongints = NO; /* YES => tyint = TYLONG */ ! 73: int addftnsrc = NO; /* Include ftn source in output */ ! 74: int usedefsforcommon = NO; /* Use #defines for common reference */ ! 75: int forcedouble = YES; /* force real functions to double */ ! 76: int Ansi = NO; ! 77: int def_equivs = YES; ! 78: int tyioint = TYLONG; ! 79: int szleng = SZLENG; ! 80: int inqmask = M(TYLONG)|M(TYLOGICAL); ! 81: int wordalign = NO; ! 82: int forcereal = NO; ! 83: int warn72 = NO; ! 84: static int skipC, skipversion; ! 85: char *file_name, *filename0, *parens; ! 86: int Castargs = 1; ! 87: static int Castargs1; ! 88: static int typedefs = 0; ! 89: int chars_per_wd, gflag, protostatus; ! 90: int infertypes = 1; ! 91: char used_rets[TYSUBR+1]; ! 92: extern char *tmpdir; ! 93: static int h0align = 0; ! 94: char *halign, *ohalign; ! 95: int krparens = NO; ! 96: int hsize; /* for padding under -h */ ! 97: int htype; /* for wr_equiv_init under -h */ ! 98: ! 99: #define f2c_entry(swit,count,type,store,size) \ ! 100: p_entry ("-", swit, 0, count, type, store, size) ! 101: ! 102: static arg_info table[] = { ! 103: f2c_entry ("w66", P_NO_ARGS, P_INT, &ftn66flag, YES), ! 104: f2c_entry ("w", P_NO_ARGS, P_INT, &nowarnflag, YES), ! 105: f2c_entry ("66", P_NO_ARGS, P_INT, &no66flag, YES), ! 106: f2c_entry ("d", P_ONE_ARG, P_INT, &debugflag, YES), ! 107: f2c_entry ("1", P_NO_ARGS, P_INT, &onetripflag, YES), ! 108: f2c_entry ("onetrip", P_NO_ARGS, P_INT, &onetripflag, YES), ! 109: f2c_entry ("I2", P_NO_ARGS, P_INT, &useshortints, YES), ! 110: f2c_entry ("I4", P_NO_ARGS, P_INT, &uselongints, YES), ! 111: f2c_entry ("U", P_NO_ARGS, P_INT, &shiftcase, NO), ! 112: f2c_entry ("u", P_NO_ARGS, P_INT, &undeftype, YES), ! 113: f2c_entry ("O", P_ONE_ARG, P_INT, &maxregvar, 0), ! 114: f2c_entry ("C", P_NO_ARGS, P_INT, &checksubs, YES), ! 115: f2c_entry ("Nq", P_ONE_ARG, P_INT, &maxequiv, 0), ! 116: f2c_entry ("Nx", P_ONE_ARG, P_INT, &maxext, 0), ! 117: f2c_entry ("Ns", P_ONE_ARG, P_INT, &maxstno, 0), ! 118: f2c_entry ("Nc", P_ONE_ARG, P_INT, &maxctl, 0), ! 119: f2c_entry ("Nn", P_ONE_ARG, P_INT, &maxhash, 0), ! 120: f2c_entry ("NL", P_ONE_ARG, P_INT, &maxliterals, 0), ! 121: f2c_entry ("NC", P_ONE_ARG, P_INT, &maxcontin, 0), ! 122: f2c_entry ("Nl", P_ONE_ARG, P_INT, &maxlablist, 0), ! 123: f2c_entry ("c", P_NO_ARGS, P_INT, &addftnsrc, YES), ! 124: f2c_entry ("p", P_NO_ARGS, P_INT, &usedefsforcommon, YES), ! 125: f2c_entry ("R", P_NO_ARGS, P_INT, &forcedouble, NO), ! 126: f2c_entry ("!R", P_NO_ARGS, P_INT, &forcedouble, YES), ! 127: f2c_entry ("A", P_NO_ARGS, P_INT, &Ansi, YES), ! 128: f2c_entry ("ext", P_NO_ARGS, P_INT, &noextflag, YES), ! 129: f2c_entry ("z", P_NO_ARGS, P_INT, &zflag, NO), ! 130: f2c_entry ("a", P_NO_ARGS, P_INT, &useauto, YES), ! 131: f2c_entry ("r8", P_NO_ARGS, P_INT, &r8flag, YES), ! 132: f2c_entry ("i2", P_NO_ARGS, P_INT, &tyioint, NO), ! 133: f2c_entry ("w8", P_NO_ARGS, P_INT, &wordalign, YES), ! 134: f2c_entry ("!I", P_NO_ARGS, P_INT, &can_include, NO), ! 135: f2c_entry ("W", P_ONE_ARG, P_INT, &chars_per_wd, 0), ! 136: f2c_entry ("g", P_NO_ARGS, P_INT, &gflag, YES), ! 137: f2c_entry ("T", P_ONE_ARG, P_STRING, &tmpdir, 0), ! 138: f2c_entry ("E", P_NO_ARGS, P_INT, &extcomm, 1), ! 139: f2c_entry ("e1c", P_NO_ARGS, P_INT, &ext1comm, 1), ! 140: f2c_entry ("ec", P_NO_ARGS, P_INT, &ext1comm, 2), ! 141: f2c_entry ("C++", P_NO_ARGS, P_INT, &Ansi, 2), ! 142: f2c_entry ("P", P_NO_ARGS, P_INT, &Castargs, 3), ! 143: f2c_entry ("Ps", P_NO_ARGS, P_INT, &protostatus, 1), ! 144: f2c_entry ("!P", P_NO_ARGS, P_INT, &Castargs, 0), ! 145: f2c_entry ("!c", P_NO_ARGS, P_INT, &skipC, 1), ! 146: f2c_entry ("!it", P_NO_ARGS, P_INT, &infertypes, 0), ! 147: f2c_entry ("h", P_NO_ARGS, P_INT, &h0align, 1), ! 148: f2c_entry ("hd", P_NO_ARGS, P_INT, &h0align, 2), ! 149: f2c_entry ("kr", P_NO_ARGS, P_INT, &krparens, 1), ! 150: f2c_entry ("krd", P_NO_ARGS, P_INT, &krparens, 2), ! 151: f2c_entry ("!bs", P_NO_ARGS, P_INT, &use_bs, NO), ! 152: f2c_entry ("r", P_NO_ARGS, P_INT, &forcereal, YES), ! 153: f2c_entry ("72", P_NO_ARGS, P_INT, &warn72, 1), ! 154: f2c_entry ("f", P_NO_ARGS, P_INT, &warn72, 2), ! 155: f2c_entry ("s", P_NO_ARGS, P_INT, &keepsubs, 1), ! 156: #ifdef TYQUAD ! 157: f2c_entry ("!i8", P_NO_ARGS, P_INT, &use_tyquad, NO), ! 158: #endif ! 159: ! 160: /* options omitted from man pages */ ! 161: ! 162: /* -ev ==> implement equivalence with initialized pointers */ ! 163: f2c_entry ("ev", P_NO_ARGS, P_INT, &def_equivs, NO), ! 164: ! 165: /* -!it used to be the default when -it was more agressive */ ! 166: ! 167: f2c_entry ("it", P_NO_ARGS, P_INT, &infertypes, 1), ! 168: ! 169: /* -Pd is similar to -P, but omits :ref: lines */ ! 170: f2c_entry ("Pd", P_NO_ARGS, P_INT, &Castargs, 2), ! 171: ! 172: /* -t ==> emit typedefs (under -A or -C++) for procedure ! 173: argument types used. This is meant for netlib's ! 174: f2c service, so -A and -C++ will work with older ! 175: versions of f2c.h ! 176: */ ! 177: f2c_entry ("t", P_NO_ARGS, P_INT, &typedefs, 1), ! 178: ! 179: /* -!V ==> omit version msg (to facilitate using diff in ! 180: regression testing) ! 181: */ ! 182: f2c_entry ("!V", P_NO_ARGS, P_INT, &skipversion, 1) ! 183: ! 184: }; /* table */ ! 185: ! 186: extern char *c_functions; /* "c_functions" */ ! 187: extern char *coutput; /* "c_output" */ ! 188: extern char *initfname; /* "raw_data" */ ! 189: extern char *blkdfname; /* "block_data" */ ! 190: extern char *p1_file; /* "p1_file" */ ! 191: extern char *p1_bakfile; /* "p1_file.BAK" */ ! 192: extern char *sortfname; /* "init_file" */ ! 193: extern char *proto_fname; /* "proto_file" */ ! 194: FILE *protofile; ! 195: ! 196: extern void list_init_data(), set_tmp_names(), sigcatch(), Un_link_all(); ! 197: extern char *c_name(); ! 198: ! 199: ! 200: set_externs () ! 201: { ! 202: static char *hset[3] = { 0, "integer", "doublereal" }; ! 203: ! 204: /* Adjust the global flags according to the command line parameters */ ! 205: ! 206: if (chars_per_wd > 0) { ! 207: typesize[TYADDR] = typesize[TYLONG] = typesize[TYREAL] = ! 208: typesize[TYLOGICAL] = chars_per_wd; ! 209: typesize[TYINT1] = typesize[TYLOGICAL1] = 1; ! 210: typesize[TYDREAL] = typesize[TYCOMPLEX] = chars_per_wd << 1; ! 211: typesize[TYDCOMPLEX] = chars_per_wd << 2; ! 212: typesize[TYSHORT] = typesize[TYLOGICAL2] = chars_per_wd >> 1; ! 213: typesize[TYCILIST] = 5*chars_per_wd; ! 214: typesize[TYICILIST] = 6*chars_per_wd; ! 215: typesize[TYOLIST] = 9*chars_per_wd; ! 216: typesize[TYCLLIST] = 3*chars_per_wd; ! 217: typesize[TYALIST] = 2*chars_per_wd; ! 218: typesize[TYINLIST] = 26*chars_per_wd; ! 219: } ! 220: ! 221: if (wordalign) ! 222: typealign[TYDREAL] = typealign[TYDCOMPLEX] = typealign[TYREAL]; ! 223: if (!tyioint) { ! 224: tyioint = TYSHORT; ! 225: szleng = typesize[TYSHORT]; ! 226: def_i2 = "#define f2c_i2 1\n"; ! 227: inqmask = M(TYSHORT)|M(TYLOGICAL); ! 228: goto checklong; ! 229: } ! 230: else ! 231: szleng = typesize[TYLONG]; ! 232: if (useshortints) { ! 233: inqmask = M(TYLONG); ! 234: checklong: ! 235: protorettypes[TYLOGICAL] = typename[TYLOGICAL] = "shortlogical"; ! 236: typesize[TYLOGICAL] = typesize[TYSHORT]; ! 237: casttypes[TYLOGICAL] = "K_fp"; ! 238: if (uselongints) ! 239: err ("Can't use both long and short ints"); ! 240: else { ! 241: tyint = tylogical = TYSHORT; ! 242: tylog = TYLOGICAL2; ! 243: } ! 244: } ! 245: else if (uselongints) ! 246: tyint = TYLONG; ! 247: ! 248: if (h0align) { ! 249: if (tyint == TYLONG && wordalign) ! 250: h0align = 1; ! 251: ohalign = halign = hset[h0align]; ! 252: htype = h0align == 1 ? tyint : TYDREAL; ! 253: hsize = typesize[htype]; ! 254: } ! 255: ! 256: if (no66flag) ! 257: noextflag = no66flag; ! 258: if (noextflag) ! 259: zflag = 0; ! 260: ! 261: if (r8flag) { ! 262: tyreal = TYDREAL; ! 263: tycomplex = TYDCOMPLEX; ! 264: r8fix(); ! 265: } ! 266: if (forcedouble) { ! 267: protorettypes[TYREAL] = "E_f"; ! 268: casttypes[TYREAL] = "E_fp"; ! 269: } ! 270: ! 271: if (maxregvar > MAXREGVAR) { ! 272: warni("-O%d: too many register variables", maxregvar); ! 273: maxregvar = MAXREGVAR; ! 274: } /* if maxregvar > MAXREGVAR */ ! 275: ! 276: /* Check the list of input files */ ! 277: ! 278: { ! 279: int bad, i, cur_max = Max_ftn_files; ! 280: ! 281: for (i = bad = 0; i < cur_max && ftn_files[i]; i++) ! 282: if (ftn_files[i][0] == '-') { ! 283: errstr ("Invalid flag '%s'", ftn_files[i]); ! 284: bad++; ! 285: } ! 286: if (bad) ! 287: exit(1); ! 288: ! 289: } /* block */ ! 290: } /* set_externs */ ! 291: ! 292: ! 293: static int ! 294: comm2dcl() ! 295: { ! 296: Extsym *ext; ! 297: if (ext1comm) ! 298: for(ext = extsymtab; ext < nextext; ext++) ! 299: if (ext->extstg == STGCOMMON && !ext->extinit) ! 300: return ext1comm; ! 301: return 0; ! 302: } ! 303: ! 304: static void ! 305: write_typedefs(outfile) ! 306: FILE *outfile; ! 307: { ! 308: register int i; ! 309: register char *s, *p = 0; ! 310: static char st[4] = { TYREAL, TYCOMPLEX, TYDCOMPLEX, TYCHAR }; ! 311: static char stl[4] = { 'E', 'C', 'Z', 'H' }; ! 312: ! 313: for(i = 0; i <= TYSUBR; i++) ! 314: if (s = usedcasts[i]) { ! 315: if (!p) { ! 316: p = Ansi == 1 ? "()" : "(...)"; ! 317: nice_printf(outfile, ! 318: "/* Types for casting procedure arguments: */\ ! 319: \n\n#ifndef F2C_proc_par_types\n"); ! 320: if (i == 0) { ! 321: nice_printf(outfile, ! 322: "typedef int /* Unknown procedure type */ (*%s)%s;\n", ! 323: s, p); ! 324: continue; ! 325: } ! 326: } ! 327: nice_printf(outfile, "typedef %s (*%s)%s;\n", ! 328: c_type_decl(i,1), s, p); ! 329: } ! 330: for(i = !forcedouble; i < 4; i++) ! 331: if (used_rets[st[i]]) ! 332: nice_printf(outfile, ! 333: "typedef %s %c_f; /* %s function */\n", ! 334: p = i ? "VOID" : "doublereal", ! 335: stl[i], ftn_types[st[i]]); ! 336: if (p) ! 337: nice_printf(outfile, "#endif\n\n"); ! 338: } ! 339: ! 340: static void ! 341: commonprotos(outfile) ! 342: register FILE *outfile; ! 343: { ! 344: register Extsym *e, *ee; ! 345: register Argtypes *at; ! 346: Atype *a, *ae; ! 347: int k; ! 348: extern int proc_protochanges; ! 349: ! 350: if (!outfile) ! 351: return; ! 352: for (e = extsymtab, ee = nextext; e < ee; e++) ! 353: if (e->extstg == STGCOMMON && e->allextp) ! 354: nice_printf(outfile, "/* comlen %s %ld */\n", ! 355: e->cextname, e->maxleng); ! 356: if (Castargs1 < 3) ! 357: return; ! 358: ! 359: /* -Pr: special comments conveying current knowledge ! 360: of external references */ ! 361: ! 362: k = proc_protochanges; ! 363: for (e = extsymtab, ee = nextext; e < ee; e++) ! 364: if (e->extstg == STGEXT ! 365: && e->cextname != e->fextname) /* not a library function */ ! 366: if (at = e->arginfo) { ! 367: if ((!e->extinit || at->changes & 1) ! 368: /* not defined here or ! 369: changed since definition */ ! 370: && at->nargs >= 0) { ! 371: nice_printf(outfile, "/*:ref: %s %d %d", ! 372: e->cextname, e->extype, at->nargs); ! 373: a = at->atypes; ! 374: for(ae = a + at->nargs; a < ae; a++) ! 375: nice_printf(outfile, " %d", a->type); ! 376: nice_printf(outfile, " */\n"); ! 377: if (at->changes & 1) ! 378: k++; ! 379: } ! 380: } ! 381: else if (e->extype) ! 382: /* typed external, never invoked */ ! 383: nice_printf(outfile, "/*:ref: %s %d :*/\n", ! 384: e->cextname, e->extype); ! 385: if (k) { ! 386: nice_printf(outfile, ! 387: "/* Rerunning f2c -P may change prototypes or declarations. */\n"); ! 388: if (nerr) ! 389: return; ! 390: if (protostatus) ! 391: done(4); ! 392: if (protofile != stdout) { ! 393: fprintf(diagfile, ! 394: "Rerunning \"f2c -P ... %s %s\" may change prototypes or declarations.\n", ! 395: filename0, proto_fname); ! 396: fflush(diagfile); ! 397: } ! 398: } ! 399: } ! 400: ! 401: int retcode = 0; ! 402: ! 403: main(argc, argv) ! 404: int argc; ! 405: char **argv; ! 406: { ! 407: int c2d, k; ! 408: FILE *c_output; ! 409: char *cdfilename; ! 410: static char stderrbuf[BUFSIZ]; ! 411: extern void def_commons(); ! 412: extern char **dfltproc, *dflt1proc[]; ! 413: extern char link_msg[]; ! 414: ! 415: diagfile = stderr; ! 416: setbuf(stderr, stderrbuf); /* arrange for fast error msgs */ ! 417: ! 418: Max_ftn_files = argc - 1; ! 419: ftn_files = (char **)ckalloc((argc+1)*sizeof(char *)); ! 420: ! 421: parse_args (argc, argv, table, sizeof(table)/sizeof(arg_info), ! 422: ftn_files, Max_ftn_files); ! 423: if (!can_include && ext1comm == 2) ! 424: ext1comm = 1; ! 425: if (ext1comm && !extcomm) ! 426: extcomm = 2; ! 427: if (protostatus) ! 428: Castargs = 3; ! 429: Castargs1 = Castargs; ! 430: if (!Ansi) { ! 431: Castargs = 0; ! 432: parens = "()"; ! 433: } ! 434: else if (!Castargs) ! 435: parens = Ansi == 1 ? "()" : "(...)"; ! 436: else ! 437: dfltproc = dflt1proc; ! 438: ! 439: set_externs(); ! 440: fileinit(); ! 441: read_Pfiles(ftn_files); ! 442: ! 443: for(k = 1; ftn_files[k]; k++) ! 444: if (dofork()) ! 445: break; ! 446: filename0 = file_name = ftn_files[current_ftn_file = k - 1]; ! 447: ! 448: set_tmp_names(); ! 449: sigcatch(); ! 450: ! 451: c_file = opf(c_functions, textwrite); ! 452: pass1_file=opf(p1_file, binwrite); ! 453: initkey(); ! 454: if (file_name && *file_name) { ! 455: if (debugflag != 1) { ! 456: coutput = c_name(file_name,'c'); ! 457: if (Castargs1 >= 2) ! 458: proto_fname = c_name(file_name,'P'); ! 459: } ! 460: cdfilename = coutput; ! 461: if (skipC) ! 462: coutput = 0; ! 463: else if (!(c_output = fopen(coutput, textwrite))) { ! 464: file_name = coutput; ! 465: coutput = 0; /* don't delete read-only .c file */ ! 466: fatalstr("can't open %.86s", file_name); ! 467: } ! 468: ! 469: if (Castargs1 >= 2 ! 470: && !(protofile = fopen(proto_fname, textwrite))) ! 471: fatalstr("Can't open %.84s\n", proto_fname); ! 472: } ! 473: else { ! 474: file_name = ""; ! 475: cdfilename = "f2c_out.c"; ! 476: c_output = stdout; ! 477: coutput = 0; ! 478: if (Castargs1 >= 2) { ! 479: protofile = stdout; ! 480: if (!skipC) ! 481: printf("#ifdef P_R_O_T_O_T_Y_P_E_S\n"); ! 482: } ! 483: } ! 484: ! 485: if(inilex( copys(file_name) )) ! 486: done(1); ! 487: if (filename0) { ! 488: fprintf(diagfile, "%s:\n", file_name); ! 489: fflush(diagfile); ! 490: } ! 491: ! 492: procinit(); ! 493: if(k = yyparse()) ! 494: { ! 495: fprintf(diagfile, "Bad parse, return code %d\n", k); ! 496: done(1); ! 497: } ! 498: ! 499: commonprotos(protofile); ! 500: if (protofile == stdout && !skipC) ! 501: printf("#endif\n\n"); ! 502: ! 503: if (nerr || skipC) ! 504: goto C_skipped; ! 505: ! 506: ! 507: /* Write out the declarations which are global to this file */ ! 508: ! 509: if ((c2d = comm2dcl()) == 1) ! 510: nice_printf(c_output, "/*>>>'/dev/null'<<<*/\n\n\ ! 511: /* Split this into several files by piping it through\n\n\ ! 512: sed \"s/^\\/\\*>>>'\\(.*\\)'<<<\\*\\/\\$/cat >'\\1' <<'\\/*<<<\\1>>>*\\/'/\" | /bin/sh\n\ ! 513: */\n\ ! 514: /*<<</dev/null>>>*/\n\ ! 515: /*>>>'%s'<<<*/\n", cdfilename); ! 516: if (gflag) ! 517: nice_printf (c_output, "#line 1 \"%s\"\n", file_name); ! 518: if (!skipversion) { ! 519: nice_printf (c_output, "/* %s -- translated by f2c ", file_name); ! 520: nice_printf (c_output, "(version of %s).\n", F2C_version); ! 521: nice_printf (c_output, ! 522: " You must link the resulting object file with the libraries:\n\ ! 523: %s (in that order)\n*/\n\n", link_msg); ! 524: } ! 525: if (Ansi == 2) ! 526: nice_printf(c_output, ! 527: "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"); ! 528: nice_printf (c_output, "%s#include \"f2c.h\"\n\n", def_i2); ! 529: if (gflag) ! 530: nice_printf (c_output, "#line 1 \"%s\"\n", file_name); ! 531: if (Castargs && typedefs) ! 532: write_typedefs(c_output); ! 533: nice_printf (c_file, "\n"); ! 534: fclose (c_file); ! 535: c_file = c_output; /* HACK to get the next indenting ! 536: to work */ ! 537: wr_common_decls (c_output); ! 538: if (blkdfile) ! 539: list_init_data(&blkdfile, blkdfname, c_output); ! 540: wr_globals (c_output); ! 541: if ((c_file = fopen (c_functions, textread)) == (FILE *) NULL) ! 542: Fatal("main - couldn't reopen c_functions"); ! 543: ffilecopy (c_file, c_output); ! 544: if (*main_alias) { ! 545: nice_printf (c_output, "/* Main program alias */ "); ! 546: nice_printf (c_output, "int %s () { MAIN__ ();%s }\n", ! 547: main_alias, Ansi ? " return 0;" : ""); ! 548: } ! 549: if (Ansi == 2) ! 550: nice_printf(c_output, ! 551: "#ifdef __cplusplus\n\t}\n#endif\n"); ! 552: if (c2d) { ! 553: if (c2d == 1) ! 554: fprintf(c_output, "/*<<<%s>>>*/\n", cdfilename); ! 555: else ! 556: fclose(c_output); ! 557: def_commons(c_output); ! 558: } ! 559: if (c2d != 2) ! 560: fclose (c_output); ! 561: ! 562: C_skipped: ! 563: if(parstate != OUTSIDE) ! 564: { ! 565: warn("missing final end statement"); ! 566: endproc(); ! 567: } ! 568: done(nerr ? 1 : 0); ! 569: } ! 570: ! 571: ! 572: FILEP opf(fn, mode) ! 573: char *fn, *mode; ! 574: { ! 575: FILEP fp; ! 576: if( fp = fopen(fn, mode) ) ! 577: return(fp); ! 578: ! 579: fatalstr("cannot open intermediate file %s", fn); ! 580: /* NOT REACHED */ return 0; ! 581: } ! 582: ! 583: ! 584: clf(p, what, quit) ! 585: FILEP *p; ! 586: char *what; ! 587: int quit; ! 588: { ! 589: if(p!=NULL && *p!=NULL && *p!=stdout) ! 590: { ! 591: if(ferror(*p)) { ! 592: fprintf(stderr, "I/O error on %s\n", what); ! 593: if (quit) ! 594: done(3); ! 595: retcode = 3; ! 596: } ! 597: fclose(*p); ! 598: } ! 599: *p = NULL; ! 600: } ! 601: ! 602: ! 603: done(k) ! 604: int k; ! 605: { ! 606: clf(&initfile, "initfile", 0); ! 607: clf(&c_file, "c_file", 0); ! 608: clf(&pass1_file, "pass1_file", 0); ! 609: Un_link_all(k); ! 610: exit(k|retcode); ! 611: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.