Annotation of researchv10no/cmd/f2c/main.c, revision 1.1.1.1

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: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.