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