00141 {
00142         char *b, *s0;
00143         int c;
00144 
00145         b = s0 = s;
00146         while(c = *s++)
00147                 if (c == '/')
00148                         b = s;
00149         if (--s < s0 + 3 || s[-2] != '.'
00150                          || ((c = *--s) != 'f' && c != 'F')) {
00151                 infname = s0;
00152                 Fatal("file name must end in .f or .F");
00153                 }
00154         strcpy(outbtail, b);
00155         outbtail[s-b] = ft;
00156         b = copys(outbuf);
00157         return b;
00158         }

00430 { return strcmp(*(char **)a, *(char **)b); }

00233 {
00234 #ifdef MSDOS
00235         Fatal("Only one Fortran input file allowed under MS-DOS");
00236 #else
00237 #ifndef KR_headers
00238         extern int fork(void), wait(int*);
00239 #endif
00240         int pid, status, w;
00241         extern int retcode;
00242 
00243         if (!(pid = fork()))
00244                 return 1;
00245         if (pid == -1)
00246                 Fatal("bad fork");
00247         while((w = wait(&status)) != pid)
00248                 if (w == -1)
00249                         Fatal("bad wait code");
00250         retcode |= status >> 8;
00251 #endif
00252         return 0;
00253         }

00439 {
00440         struct Memb {
00441                 struct Memb *next;
00442                 int n;
00443                 char buf[32000];
00444                 };
00445         typedef struct Memb memb;
00446         memb *mb, *mb1;
00447         register char *x, *x0, *xe;
00448         register int c, n;
00449         FILE *f;
00450         char **z, **z0;
00451         int nn = 0;
00452 
00453         f = opf(from, textread);
00454         mb = (memb *)Alloc(sizeof(memb));
00455         mb->next = 0;
00456         x0 = x = mb->buf;
00457         xe = x + sizeof(mb->buf);
00458         n = 0;
00459         for(;;) {
00460                 c = getc(f);
00461                 if (x >= xe && (c != EOF || x != x0)) {
00462                         if (!n)
00463                                 return 126;
00464                         nn += n;
00465                         mb->n = n;
00466                         mb1 = (memb *)Alloc(sizeof(memb));
00467                         mb1->next = mb;
00468                         mb = mb1;
00469                         memcpy(mb->buf, x0, n = x-x0);
00470                         x0 = mb->buf;
00471                         x = x0 + n;
00472                         xe = x0 + sizeof(mb->buf);
00473                         n = 0;
00474                         }
00475                 if (c == EOF)
00476                         break;
00477                 if (c == '\n') {
00478                         ++n;
00479                         *x++ = 0;
00480                         x0 = x;
00481                         }
00482                 else
00483                         *x++ = c;
00484                 }
00485         clf(&f, from, 1);
00486         f = opf(to, textwrite);
00487         if (x > x0) { /* shouldn't happen */
00488                 *x = 0;
00489                 ++n;
00490                 }
00491         mb->n = n;
00492         nn += n;
00493         if (!nn) /* shouldn't happen */
00494                 goto done;
00495         z = z0 = (char **)Alloc(nn*sizeof(char *));
00496         for(mb1 = mb; mb1; mb1 = mb1->next) {
00497                 x = mb1->buf;
00498                 n = mb1->n;
00499                 for(;;) {
00500                         *z++ = x;
00501                         if (--n <= 0)
00502                                 break;
00503                         while(*x++);
00504                         }
00505                 }
00506         qsort((char *)z0, nn, sizeof(char *), compare);
00507         for(n = nn, z = z0; n > 0; n--)
00508                 fprintf(f, "%s\n", *z++);
00509         free((char *)z0);
00510  done:
00511         clf(&f, to, 1);
00512         do {
00513                 mb1 = mb->next;
00514                 free((char *)mb);
00515                 }
00516                 while(mb = mb1);
00517         return 0;
00518         }

00201 {
00202         sig = sig;      /* shut up warning */
00203         Fatal("floating exception during constant evaluation; cannot recover");
00204         /* vax returns a reserved operand that generates
00205            an illegal operand fault on next instruction,
00206            which if ignored causes an infinite loop.
00207         */
00208         signal(SIGFPE, flovflo);
00209 }

00309 {
00310         static char *str1fmt[6] =
00311                 { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
00312         register int i, j;
00313         register char *s;
00314 
00315         /* str_fmt */
00316 
00317 #ifdef non_ASCII
00318         i = 0;
00319 #else
00320         i = 127;
00321 #endif
00322         for(; i < Table_size; i++)
00323                 str_fmt[i] = "\\%03o";
00324 #ifdef non_ASCII
00325         for(i = 32; i < 127; i++) {
00326                 s = str0fmt[i];
00327                 str_fmt[*(unsigned char *)s] = s;
00328                 }
00329         str_fmt['"'] = "\\\"";
00330 #else
00331         if (Ansi == 1)
00332                 str_fmt[7] = chr_fmt[7] = "\\a";
00333 #endif
00334 
00335         /* chr_fmt */
00336 
00337 #ifdef non_ASCII
00338         for(i = 0; i < 32; i++)
00339                 chr_fmt[i] = chr0fmt[i];
00340 #else
00341         i = 127;
00342 #endif
00343         for(; i < Table_size; i++)
00344                 chr_fmt[i] = "\\%o";
00345 #ifdef non_ASCII
00346         for(i = 32; i < 127; i++) {
00347                 s = chr0fmt[i];
00348                 j = *(unsigned char *)s;
00349                 if (j == '\\')
00350                         j = *(unsigned char *)(s+1);
00351                 chr_fmt[j] = s;
00352                 }
00353 #endif
00354 
00355         /* escapes (used in lex.c) */
00356 
00357         for(i = 0; i < Table_size; i++)
00358                 escapes[i] = i;
00359         for(s = "btnfr0", i = 0; i < 6; i++)
00360                 escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
00361         /* finish str_fmt and chr_fmt */
00362 
00363         if (Ansi)
00364                 str1fmt[5] = "\\v";
00365         if ('\v' == 'v') { /* ancient C compiler */
00366                 str1fmt[5] = "v";
00367 #ifndef non_ASCII
00368                 escapes['v'] = 11;
00369 #endif
00370                 }
00371         else
00372                 escapes['v'] = '\v';
00373         for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
00374                 str_fmt[j] = chr_fmt[j] = str1fmt[i++];
00375         /* '\v' = 11 for both EBCDIC and ASCII... */
00376         chr_fmt[11] = Ansi ? "\\v" : "\\13";
00377         }

00167 {
00168         sig = sig;      /* shut up warning */
00169         signal(SIGINT, SIG_IGN);
00170 #ifdef SIGQUIT
00171         signal(SIGQUIT, SIG_IGN);
00172 #endif
00173 #ifdef SIGHUP
00174         signal(SIGHUP, SIG_IGN);
00175 #endif
00176         signal(SIGTERM, SIG_IGN);
00177         Un_link_all(1);
00178         exit(126);
00179         }

00381 {
00382         int n, n1;
00383         char *s;
00384 
00385         n = n1 = strlen(outbuf);
00386         if (*outbuf && outbuf[n-1] != '/')
00387                 n1++;
00388         s = Alloc(n+64);
00389         outbtail = s + n1;
00390         strcpy(s, outbuf);
00391         if (n != n1)
00392                 strcpy(s+n, "/");
00393         outbuf = s;
00394         }

00081 {
00082         int k;
00083         if (debugflag == 1)
00084                 return;
00085         k = strlen(tmpdir) + 24;
00086         c_functions = (char *)ckalloc(7*k);
00087         initfname = c_functions + k;
00088         initbname = initfname + k;
00089         blkdfname = initbname + k;
00090         p1_file = blkdfname + k;
00091         p1_bakfile = p1_file + k;
00092         sortfname = p1_bakfile + k;
00093         {
00094 #ifdef MSDOS
00095         char buf[64], *s, *t;
00096         if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
00097                 t = "";
00098         else {
00099                 /* substitute \ for / to avoid confusion with a
00100                  * switch indicator in the system("sort ...")
00101                  * call in formatdata.c
00102                  */
00103                 for(s = tmpdir, t = buf; *s; s++, t++)
00104                         if ((*t = *s) == '/')
00105                                 *t = '\\';
00106                 if (t[-1] != '\\')
00107                         *t++ = '\\';
00108                 *t = 0;
00109                 t = buf;
00110                 }
00111         sprintf(c_functions, "%sf2c_func", t);
00112         sprintf(initfname, "%sf2c_rd", t);
00113         sprintf(blkdfname, "%sf2c_blkd", t);
00114         sprintf(p1_file, "%sf2c_p1f", t);
00115         sprintf(p1_bakfile, "%sf2c_p1fb", t);
00116         sprintf(sortfname, "%sf2c_sort", t);
00117 #else
00118         long pid = getpid();
00119         sprintf(c_functions, "%s/f2c%ld_func", tmpdir, pid);
00120         sprintf(initfname, "%s/f2c%ld_rd", tmpdir, pid);
00121         sprintf(blkdfname, "%s/f2c%ld_blkd", tmpdir, pid);
00122         sprintf(p1_file, "%s/f2c%ld_p1f", tmpdir, pid);
00123         sprintf(p1_bakfile, "%s/f2c%ld_p1fb", tmpdir, pid);
00124         sprintf(sortfname, "%s/f2c%ld_sort", tmpdir, pid);
00125 #endif
00126         sprintf(initbname, "%s.b", initfname);
00127         }
00128         if (debugflag)
00129                 fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
00130                         initfname, blkdfname, p1_file, p1_bakfile, sortfname);
00131         }

00188 {
00189         sig = sig;      /* shut up warning */
00190         if (signal(sig, SIG_IGN) != SIG_IGN)
00191                 signal(sig, killed);
00192         }

00218 {
00219         sig = sig;      /* shut up warning */
00220         sig1catch(SIGINT);
00221 #ifdef SIGQUIT
00222         sig1catch(SIGQUIT);
00223 #endif
00224 #ifdef SIGHUP
00225         sig1catch(SIGHUP);
00226 #endif
00227         sig1catch(SIGTERM);
00228         signal(SIGFPE, flovflo);  /* catch overflows */
00229         }

00064 {
00065 #ifndef KR_headers
00066         extern int unlink(const char *);
00067 #endif
00068         if (!debugflag) {
00069                 unlink(c_functions);
00070                 unlink(initfname);
00071                 unlink(p1_file);
00072                 unlink(sortfname);
00073                 unlink(blkdfname);
00074                 if (cdelete && coutput)
00075                         unlink(coutput);
00076                 }
00077         }

 {

   "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
   "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
  "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
  "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
     " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
     "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
     "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
     "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
     "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
     "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
     "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
     "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
     "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
     "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
     "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
     "x",     "y",     "z",     "{",     "|",     "}",     "~"
     }

 {

 "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
   "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
 "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
 "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
     " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
     "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
     "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
     "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
     "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
     "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
     "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
     "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
     "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
     "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
     "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
     "x",     "y",     "z",     "{",     "|",     "}",     "~"
     }