home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / f2csrc.zip / f2csrc / src / sysdep.c.dist < prev    next >
Text File  |  1994-03-05  |  13KB  |  520 lines
  1. /****************************************************************
  2. Copyright 1990 - 1994 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. #include "defs.h"
  24. #include "usignal.h"
  25.  
  26. char binread[] = "rb", textread[] = "r";
  27. char binwrite[] = "wb", textwrite[] = "w";
  28. char *c_functions    = "c_functions";
  29. char *coutput        = "c_output";
  30. char *initfname        = "raw_data";
  31. char *initbname        = "raw_data.b";
  32. char *blkdfname        = "block_data";
  33. char *p1_file        = "p1_file";
  34. char *p1_bakfile    = "p1_file.BAK";
  35. char *sortfname        = "init_file";
  36. char *proto_fname    = "proto_file";
  37.  
  38. char link_msg[]        = "-lf2c -lm"; /* was "-lF77 -lI77 -lm -lc"; */
  39.  
  40. char *outbuf = "", *outbtail;
  41.  
  42. #ifndef TMPDIR
  43. #ifdef MSDOS
  44. #define TMPDIR ""
  45. #else
  46. #define TMPDIR "/tmp"
  47. #endif
  48. #endif
  49.  
  50. char *tmpdir = TMPDIR;
  51. #ifndef MSDOS
  52. #ifndef KR_headers
  53. extern int getpid(void);
  54. #endif
  55. #endif
  56.  
  57.  void
  58. #ifdef KR_headers
  59. Un_link_all(cdelete)
  60.     int cdelete;
  61. #else
  62. Un_link_all(int cdelete)
  63. #endif
  64. {
  65. #ifndef KR_headers
  66.     extern int unlink(const char *);
  67. #endif
  68.     if (!debugflag) {
  69.         unlink(c_functions);
  70.         unlink(initfname);
  71.         unlink(p1_file);
  72.         unlink(sortfname);
  73.         unlink(blkdfname);
  74.         if (cdelete && coutput)
  75.             unlink(coutput);
  76.         }
  77.     }
  78.  
  79.  void
  80. set_tmp_names(Void)
  81. {
  82.     int k;
  83.     if (debugflag == 1)
  84.         return;
  85.     k = strlen(tmpdir) + 16;
  86.     c_functions = (char *)ckalloc(7*k);
  87.     initfname = c_functions + k;
  88.     initbname = initfname + k;
  89.     blkdfname = initbname + k;
  90.     p1_file = blkdfname + k;
  91.     p1_bakfile = p1_file + k;
  92.     sortfname = p1_bakfile + k;
  93.     {
  94. #ifdef MSDOS
  95.     char buf[64], *s, *t;
  96.     if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
  97.         t = "";
  98.     else {
  99.         /* substitute \ for / to avoid confusion with a
  100.          * switch indicator in the system("sort ...")
  101.          * call in formatdata.c
  102.          */
  103.         for(s = tmpdir, t = buf; *s; s++, t++)
  104.             if ((*t = *s) == '/')
  105.                 *t = '\\';
  106.         if (t[-1] != '\\')
  107.             *t++ = '\\';
  108.         *t = 0;
  109.         t = buf;
  110.         }
  111.     sprintf(c_functions, "%sf2c_func", t);
  112.     sprintf(initfname, "%sf2c_rd", t);
  113.     sprintf(blkdfname, "%sf2c_blkd", t);
  114.     sprintf(p1_file, "%sf2c_p1f", t);
  115.     sprintf(p1_bakfile, "%sf2c_p1fb", t);
  116.     sprintf(sortfname, "%sf2c_sort", t);
  117. #else
  118.     int pid = getpid();
  119.     sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid);
  120.     sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid);
  121.     sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid);
  122.     sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid);
  123.     sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid);
  124.     sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid);
  125. #endif
  126.     sprintf(initbname, "%s.b", initfname);
  127.     }
  128.     if (debugflag)
  129.         fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
  130.             initfname, blkdfname, p1_file, p1_bakfile, sortfname);
  131.     }
  132.  
  133.  char *
  134. #ifdef KR_headers
  135. c_name(s, ft)
  136.     char *s;
  137.     int ft;
  138. #else
  139. c_name(char *s, int ft)
  140. #endif
  141. {
  142.     char *b, *s0;
  143.     int c;
  144.  
  145.     b = s0 = s;
  146.     while(c = *s++)
  147.         if (c == '/')
  148.             b = s;
  149.     if (--s < s0 + 3 || s[-2] != '.'
  150.              || ((c = *--s) != 'f' && c != 'F')) {
  151.         infname = s0;
  152.         Fatal("file name must end in .f or .F");
  153.         }
  154.     strcpy(outbtail, b);
  155.     outbtail[s-b] = ft;
  156.     b = copys(outbuf);
  157.     return b;
  158.     }
  159.  
  160.  static void
  161. #ifdef KR_headers
  162. killed(sig)
  163.     int sig;
  164. #else
  165. killed(int sig)
  166. #endif
  167. {
  168.     sig = sig;    /* shut up warning */
  169.     signal(SIGINT, SIG_IGN);
  170. #ifdef SIGQUIT
  171.     signal(SIGQUIT, SIG_IGN);
  172. #endif
  173. #ifdef SIGHUP
  174.     signal(SIGHUP, SIG_IGN);
  175. #endif
  176.     signal(SIGTERM, SIG_IGN);
  177.     Un_link_all(1);
  178.     exit(126);
  179.     }
  180.  
  181.  static void
  182. #ifdef KR_headers
  183. sig1catch(sig)
  184.     int sig;
  185. #else
  186. sig1catch(int sig)
  187. #endif
  188. {
  189.     sig = sig;    /* shut up warning */
  190.     if (signal(sig, SIG_IGN) != SIG_IGN)
  191.         signal(sig, killed);
  192.     }
  193.  
  194.  static void
  195. #ifdef KR_headers
  196. flovflo(sig)
  197.     int sig;
  198. #else
  199. flovflo(int sig)
  200. #endif
  201. {
  202.     sig = sig;    /* shut up warning */
  203.     Fatal("floating exception during constant evaluation; cannot recover");
  204.     /* vax returns a reserved operand that generates
  205.        an illegal operand fault on next instruction,
  206.        which if ignored causes an infinite loop.
  207.     */
  208.     signal(SIGFPE, flovflo);
  209. }
  210.  
  211.  void
  212. #ifdef KR_headers
  213. sigcatch(sig)
  214.     int sig;
  215. #else
  216. sigcatch(int sig)
  217. #endif
  218. {
  219.     sig = sig;    /* shut up warning */
  220.     sig1catch(SIGINT);
  221. #ifdef SIGQUIT
  222.     sig1catch(SIGQUIT);
  223. #endif
  224. #ifdef SIGHUP
  225.     sig1catch(SIGHUP);
  226. #endif
  227.     sig1catch(SIGTERM);
  228.     signal(SIGFPE, flovflo);  /* catch overflows */
  229.     }
  230.  
  231.  
  232. dofork(Void)
  233. {
  234. #ifdef MSDOS
  235.     Fatal("Only one Fortran input file allowed under MS-DOS");
  236. #else
  237. #ifndef KR_headers
  238.     extern int fork(void), wait(int*);
  239. #endif
  240.     int pid, status, w;
  241.     extern int retcode;
  242.  
  243.     if (!(pid = fork()))
  244.         return 1;
  245.     if (pid == -1)
  246.         Fatal("bad fork");
  247.     while((w = wait(&status)) != pid)
  248.         if (w == -1)
  249.             Fatal("bad wait code");
  250.     retcode |= status >> 8;
  251. #endif
  252.     return 0;
  253.     }
  254.  
  255. /* Initialization of tables that change with the character set... */
  256.  
  257. char escapes[Table_size];
  258.  
  259. #ifdef non_ASCII
  260. char *str_fmt[Table_size];
  261. static char *str0fmt[127] = { /*}*/
  262. #else
  263. char *str_fmt[Table_size] = {
  264. #endif
  265.  "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
  266.    "\\b",   "\\t",   "\\n", "\\013",   "\\f",   "\\r", "\\016", "\\017",
  267.  "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
  268.  "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
  269.      " ",     "!",  "\\\"",     "#",     "$",     "%%",    "&",     "'",
  270.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  271.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  272.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  273.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  274.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  275.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  276.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  277.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  278.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  279.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  280.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  281.      };
  282.  
  283. #ifdef non_ASCII
  284. char *chr_fmt[Table_size];
  285. static char *chr0fmt[127] = {    /*}*/
  286. #else
  287. char *chr_fmt[Table_size] = {
  288. #endif
  289.    "\\0",   "\\1",   "\\2",   "\\3",   "\\4",   "\\5",   "\\6",   "\\7",
  290.    "\\b",   "\\t",   "\\n",  "\\13",   "\\f",   "\\r",  "\\16",  "\\17",
  291.   "\\20",  "\\21",  "\\22",  "\\23",  "\\24",  "\\25",  "\\26",  "\\27",
  292.   "\\30",  "\\31",  "\\32",  "\\33",  "\\34",  "\\35",  "\\36",  "\\37",
  293.      " ",     "!",    "\"",     "#",     "$",     "%%",    "&",   "\\'",
  294.      "(",     ")",     "*",     "+",     ",",     "-",     ".",     "/",
  295.      "0",     "1",     "2",     "3",     "4",     "5",     "6",     "7",
  296.      "8",     "9",     ":",     ";",     "<",     "=",     ">",     "?",
  297.      "@",     "A",     "B",     "C",     "D",     "E",     "F",     "G",
  298.      "H",     "I",     "J",     "K",     "L",     "M",     "N",     "O",
  299.      "P",     "Q",     "R",     "S",     "T",     "U",     "V",     "W",
  300.      "X",     "Y",     "Z",     "[",  "\\\\",     "]",     "^",     "_",
  301.      "`",     "a",     "b",     "c",     "d",     "e",     "f",     "g",
  302.      "h",     "i",     "j",     "k",     "l",     "m",     "n",     "o",
  303.      "p",     "q",     "r",     "s",     "t",     "u",     "v",     "w",
  304.      "x",     "y",     "z",     "{",     "|",     "}",     "~"
  305.      };
  306.  
  307.  void
  308. fmt_init(Void)
  309. {
  310.     static char *str1fmt[6] =
  311.         { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
  312.     register int i, j;
  313.     register char *s;
  314.  
  315.     /* str_fmt */
  316.  
  317. #ifdef non_ASCII
  318.     i = 0;
  319. #else
  320.     i = 127;
  321. #endif
  322.     for(; i < Table_size; i++)
  323.         str_fmt[i] = "\\%03o";
  324. #ifdef non_ASCII
  325.     for(i = 32; i < 127; i++) {
  326.         s = str0fmt[i];
  327.         str_fmt[*(unsigned char *)s] = s;
  328.         }
  329.     str_fmt['"'] = "\\\"";
  330. #else
  331.     if (Ansi == 1)
  332.         str_fmt[7] = chr_fmt[7] = "\\a";
  333. #endif
  334.  
  335.     /* chr_fmt */
  336.  
  337. #ifdef non_ASCII
  338.     for(i = 0; i < 32; i++)
  339.         chr_fmt[i] = chr0fmt[i];
  340. #else
  341.     i = 127;
  342. #endif
  343.     for(; i < Table_size; i++)
  344.         chr_fmt[i] = "\\%o";
  345. #ifdef non_ASCII
  346.     for(i = 32; i < 127; i++) {
  347.         s = chr0fmt[i];
  348.         j = *(unsigned char *)s;
  349.         if (j == '\\')
  350.             j = *(unsigned char *)(s+1);
  351.         chr_fmt[j] = s;
  352.         }
  353. #endif
  354.  
  355.     /* escapes (used in lex.c) */
  356.  
  357.     for(i = 0; i < Table_size; i++)
  358.         escapes[i] = i;
  359.     for(s = "btnfr0", i = 0; i < 6; i++)
  360.         escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
  361.     /* finish str_fmt and chr_fmt */
  362.  
  363.     if (Ansi)
  364.         str1fmt[5] = "\\v";
  365.     if ('\v' == 'v') { /* ancient C compiler */
  366.         str1fmt[5] = "v";
  367. #ifndef non_ASCII
  368.         escapes['v'] = 11;
  369. #endif
  370.         }
  371.     else
  372.         escapes['v'] = '\v';
  373.     for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
  374.         str_fmt[j] = chr_fmt[j] = str1fmt[i++];
  375.     /* '\v' = 11 for both EBCDIC and ASCII... */
  376.     chr_fmt[11] = Ansi ? "\\v" : "\\13";
  377.     }
  378.  
  379.  void
  380. outbuf_adjust(Void)
  381. {
  382.     int n, n1;
  383.     char *s;
  384.  
  385.     n = n1 = strlen(outbuf);
  386.     if (*outbuf && outbuf[n-1] != '/')
  387.         n1++;
  388.     s = Alloc(n+64);
  389.     outbtail = s + n1;
  390.     strcpy(s, outbuf);
  391.     if (n != n1)
  392.         strcpy(s+n, "/");
  393.     outbuf = s;
  394.     }
  395.  
  396.  
  397. /* Unless SYSTEM_SORT is defined, the following gives a simple
  398.  * in-core version of dsort().  On Fortran source with huge DATA
  399.  * statements, the in-core version may exhaust the available memory,
  400.  * in which case you might either recompile this source file with
  401.  * SYSTEM_SORT defined (if that's reasonable on your system), or
  402.  * replace the dsort below with a more elaborate version that
  403.  * does a merging sort with the help of auxiliary files.
  404.  */
  405.  
  406. #ifdef SYSTEM_SORT
  407.  
  408.  int
  409. #ifdef KR_headers
  410. dsort(from, to)
  411.     char *from;
  412.     char *to;
  413. #else
  414. dsort(char *from, char *to)
  415. #endif
  416. {
  417.     char buf[200];
  418.     sprintf(buf, "sort <%s >%s", from, to);
  419.     return system(buf) >> 8;
  420.     }
  421. #else
  422.  
  423.  static int
  424. #ifdef KR_headers
  425.  compare(a,b)
  426.   char *a, *b;
  427. #else
  428.  compare(const void *a, const void *b)
  429. #endif
  430. { return strcmp(*(char **)a, *(char **)b); }
  431.  
  432. #ifdef KR_headers
  433. dsort(from, to)
  434.     char *from;
  435.     char *to;
  436. #else
  437. dsort(char *from, char *to)
  438. #endif
  439. {
  440.     struct Memb {
  441.         struct Memb *next;
  442.         int n;
  443.         char buf[32000];
  444.         };
  445.     typedef struct Memb memb;
  446.     memb *mb, *mb1;
  447.     register char *x, *x0, *xe;
  448.     register int c, n;
  449.     FILE *f;
  450.     char **z, **z0;
  451.     int nn = 0;
  452.  
  453.     f = opf(from, textread);
  454.     mb = (memb *)Alloc(sizeof(memb));
  455.     mb->next = 0;
  456.     x0 = x = mb->buf;
  457.     xe = x + sizeof(mb->buf);
  458.     n = 0;
  459.     for(;;) {
  460.         c = getc(f);
  461.         if (x >= xe && (c != EOF || x != x0)) {
  462.             if (!n)
  463.                 return 126;
  464.             nn += n;
  465.             mb->n = n;
  466.             mb1 = (memb *)Alloc(sizeof(memb));
  467.             mb1->next = mb;
  468.             mb = mb1;
  469.             memcpy(mb->buf, x0, n = x-x0);
  470.             x0 = mb->buf;
  471.             x = x0 + n;
  472.             xe = x0 + sizeof(mb->buf);
  473.             n = 0;
  474.             }
  475.         if (c == EOF)
  476.             break;
  477.         if (c == '\n') {
  478.             ++n;
  479.             *x++ = 0;
  480.             x0 = x;
  481.             }
  482.         else
  483.             *x++ = c;
  484.         }
  485.     clf(&f, from, 1);
  486.     f = opf(to, textwrite);
  487.     if (x > x0) { /* shouldn't happen */
  488.         *x = 0;
  489.         ++n;
  490.         }
  491.     mb->n = n;
  492.     nn += n;
  493.     if (!nn) /* shouldn't happen */
  494.         goto done;
  495.     z = z0 = (char **)Alloc(nn*sizeof(char *));
  496.     for(mb1 = mb; mb1; mb1 = mb1->next) {
  497.         x = mb1->buf;
  498.         n = mb1->n;
  499.         for(;;) {
  500.             *z++ = x;
  501.             if (--n <= 0)
  502.                 break;
  503.             while(*x++);
  504.             }
  505.         }
  506.     qsort((char *)z0, nn, sizeof(char *), compare);
  507.     for(n = nn, z = z0; n > 0; n--)
  508.         fprintf(f, "%s\n", *z++);
  509.     free((char *)z0);
  510.  done:
  511.     clf(&f, to, 1);
  512.     do {
  513.         mb1 = mb->next;
  514.         free((char *)mb);
  515.         }
  516.         while(mb = mb1);
  517.     return 0;
  518.     }
  519. #endif
  520.