lang/fortran/comp/main.c

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