sources/f2c/sysdep.c

   1 /****************************************************************
   2 Copyright 1990 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
  37 #ifndef TMPDIR
  38 #ifdef MSDOS
  39 #define TMPDIR ""
  40 #else
  41 #define TMPDIR "/tmp"
  42 #endif
  43 #endif
  44
  45 char *tmpdir = TMPDIR;
  46
  47  void
  48 Un_link_all(cdelete)
  49 {
  50         if (!debugflag) {
  51                 unlink(c_functions);
  52                 unlink(initfname);
  53                 unlink(p1_file);
  54                 unlink(sortfname);
  55                 unlink(blkdfname);
  56                 if (cdelete && coutput)
  57                         unlink(coutput);
  58                 }
  59         }
  60
  61  void
  62 set_tmp_names()
  63 {
  64         int k;
  65         if (debugflag == 1)
  66                 return;
  67         k = strlen(tmpdir) + 16;
  68         c_functions = (char *)ckalloc(7*k);
  69         initfname = c_functions + k;
  70         initbname = initfname + k;
  71         blkdfname = initbname + k;
  72         p1_file = blkdfname + k;
  73         p1_bakfile = p1_file + k;
  74         sortfname = p1_bakfile + k;
  75         {
  76 #ifdef MSDOS
  77         char buf[64], *s, *t;
  78         if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
  79                 t = "";
  80         else {
  81                 /* substitute \ for / to avoid confusion with a
  82                  * switch indicator in the system("sort ...")
  83                  * call in formatdata.c
  84                  */
  85                 for(s = tmpdir, t = buf; *s; s++, t++)
  86                         if ((*t = *s) == '/')
  87                                 *t = '\\';
  88                 if (t[-1] != '\\')
  89                         *t++ = '\\';
  90                 *t = 0;
  91                 t = buf;
  92                 }
  93         sprintf(c_functions, "%sf2c_func", t);
  94         sprintf(initfname, "%sf2c_rd", t);
  95         sprintf(blkdfname, "%sf2c_blkd", t);
  96         sprintf(p1_file, "%sf2c_p1f", t);
  97         sprintf(p1_bakfile, "%sf2c_p1fb", t);
  98         sprintf(sortfname, "%sf2c_sort", t);
  99 #else
 100         int pid = getpid();
 101         sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid);
 102         sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid);
 103         sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid);
 104         sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid);
 105         sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid);
 106         sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid);
 107 #endif
 108         sprintf(initbname, "%s.b", initfname);
 109         }
 110         if (debugflag)
 111                 fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
 112                         initfname, blkdfname, p1_file, p1_bakfile, sortfname);
 113         }
 114
 115  char *
 116 c_name(s,ft)char *s;
 117 {
 118         char *b, *s0;
 119         int c;
 120
 121         b = s0 = s;
 122         while(c = *s++)
 123                 if (c == '/')
 124                         b = s;
 125         if (--s < s0 + 3 || s[-2] != '.'
 126                          || ((c = *--s) != 'f' && c != 'F')) {
 127                 infname = s0;
 128                 Fatal("file name must end in .f or .F");
 129                 }
 130         *s = ft;
 131         b = copys(b);
 132         *s = c;
 133         return b;
 134         }
 135
 136  static void
 137 killed()
 138 {
 139         signal(SIGINT, SIG_IGN);
 140 #ifdef SIGQUIT
 141         signal(SIGQUIT, SIG_IGN);
 142 #endif
 143 #ifdef SIGHUP
 144         signal(SIGHUP, SIG_IGN);
 145 #endif
 146         signal(SIGTERM, SIG_IGN);
 147         Un_link_all(1);
 148         exit(126);
 149         }
 150
 151  static void
 152 sig1catch(sig) int sig;
 153 {
 154         if (signal(sig, SIG_IGN) != SIG_IGN)
 155                 signal(sig, killed);
 156         }
 157
 158  static void
 159 flovflo()
 160 {
 161         Fatal("floating exception during constant evaluation; cannot recover");
 162         /* vax returns a reserved operand that generates
 163            an illegal operand fault on next instruction,
 164            which if ignored causes an infinite loop.
 165         */
 166         signal(SIGFPE, flovflo);
 167 }
 168
 169  void
 170 sigcatch()
 171 {
 172         sig1catch(SIGINT);
 173 #ifdef SIGQUIT
 174         sig1catch(SIGQUIT);
 175 #endif
 176 #ifdef SIGHUP
 177         sig1catch(SIGHUP);
 178 #endif
 179         sig1catch(SIGTERM);
 180         signal(SIGFPE, flovflo);  /* catch overflows */
 181         }
 182
 183
 184 dofork()
 185 {
 186 #ifdef MSDOS
 187         Fatal("Only one Fortran input file allowed under MS-DOS");
 188 #else
 189         int pid, status, w;
 190         extern int retcode;
 191
 192         if (!(pid = fork()))
 193                 return 1;
 194         if (pid == -1)
 195                 Fatal("bad fork");
 196         while((w = wait(&status)) != pid)
 197                 if (w == -1)
 198                         Fatal("bad wait code");
 199         retcode |= status >> 8;
 200 #endif
 201         return 0;
 202         }
 203
 204
 205 /* Unless SYSTEM_SORT is defined, the following gives a simple
 206  * in-core version of dsort().  On Fortran source with huge DATA
 207  * statements, the in-core version may exhaust the available memory,
 208  * in which case you might either recompile this source file with
 209  * SYSTEM_SORT defined (if that's reasonable on your system), or
 210  * replace the dsort below with a more elaborate version that
 211  * does a merging sort with the help of auxiliary files.
 212  */
 213
 214 #ifdef SYSTEM_SORT
 215
 216 dsort(from, to)
 217  char *from, *to;
 218 {
 219         char buf[200];
 220         sprintf(buf, "sort <%s >%s", from, to);
 221         return system(buf) >> 8;
 222         }
 223 #else
 224
 225  static int
 226 compare(a,b)
 227  char *a, *b;
 228 { return strcmp(*(char **)a, *(char **)b); }
 229
 230 dsort(from, to)
 231  char *from, *to;
 232 {
 233         extern char *Alloc();
 234
 235         struct Memb {
 236                 struct Memb *next;
 237                 int n;
 238                 char buf[32000];
 239                 };
 240         typedef struct Memb memb;
 241         memb *mb, *mb1;
 242         register char *x, *x0, *xe;
 243         register int c, n;
 244         FILE *f;
 245         char **z, **z0;
 246         int nn = 0;
 247
 248         f = opf(from, textread);
 249         mb = (memb *)Alloc(sizeof(memb));
 250         mb->next = 0;
 251         x0 = x = mb->buf;
 252         xe = x + sizeof(mb->buf);
 253         n = 0;
 254         for(;;) {
 255                 c = getc(f);
 256                 if (x >= xe && (c != EOF || x != x0)) {
 257                         if (!n)
 258                                 return 126;
 259                         nn += n;
 260                         mb->n = n;
 261                         mb1 = (memb *)Alloc(sizeof(memb));
 262                         mb1->next = mb;
 263                         mb = mb1;
 264                         memcpy(mb->buf, x0, n = x-x0);
 265                         x0 = mb->buf;
 266                         x = x0 + n;
 267                         xe = x0 + sizeof(mb->buf);
 268                         n = 0;
 269                         }
 270                 if (c == EOF)
 271                         break;
 272                 if (c == '\n') {
 273                         ++n;
 274                         *x++ = 0;
 275                         x0 = x;
 276                         }
 277                 else
 278                         *x++ = c;
 279                 }
 280         clf(&f, from, 1);
 281         f = opf(to, textwrite);
 282         if (x > x0) { /* shouldn't happen */
 283                 *x = 0;
 284                 ++n;
 285                 }
 286         mb->n = n;
 287         nn += n;
 288         if (!nn) /* shouldn't happen */
 289                 goto done;
 290         z = z0 = (char **)Alloc(nn*sizeof(char *));
 291         for(mb1 = mb; mb1; mb1 = mb1->next) {
 292                 x = mb1->buf;
 293                 n = mb1->n;
 294                 for(;;) {
 295                         *z++ = x;
 296                         if (--n <= 0)
 297                                 break;
 298                         while(*x++);
 299                         }
 300                 }
 301         qsort((char *)z0, nn, sizeof(char *), compare);
 302         for(n = nn, z = z0; n > 0; n--)
 303                 fprintf(f, "%s\n", *z++);
 304         free((char *)z0);
 305  done:
 306         clf(&f, to, 1);
 307         do {
 308                 mb1 = mb->next;
 309                 free((char *)mb);
 310                 }
 311                 while(mb = mb1);
 312         return 0;
 313         }
 314 #endif