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