diff options
Diffstat (limited to 'usr.bin/f2c/sysdep.c')
-rw-r--r-- | usr.bin/f2c/sysdep.c | 442 |
1 files changed, 0 insertions, 442 deletions
diff --git a/usr.bin/f2c/sysdep.c b/usr.bin/f2c/sysdep.c deleted file mode 100644 index 81bc5af..0000000 --- a/usr.bin/f2c/sysdep.c +++ /dev/null @@ -1,442 +0,0 @@ -/**************************************************************** -Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories and Bellcore. - -Permission to use, copy, modify, and distribute this software -and its documentation for any purpose and without fee is hereby -granted, provided that the above copyright notice appear in all -copies and that both that the copyright notice and this -permission notice and warranty disclaimer appear in supporting -documentation, and that the names of AT&T Bell Laboratories or -Bellcore or any of their entities not be used in advertising or -publicity pertaining to distribution of the software without -specific, written prior permission. - -AT&T and Bellcore disclaim all warranties with regard to this -software, including all implied warranties of merchantability -and fitness. In no event shall AT&T or Bellcore be liable for -any special, indirect or consequential damages or any damages -whatsoever resulting from loss of use, data or profits, whether -in an action of contract, negligence or other tortious action, -arising out of or in connection with the use or performance of -this software. -****************************************************************/ -#include "defs.h" -#include "usignal.h" - -char binread[] = "rb", textread[] = "r"; -char binwrite[] = "wb", textwrite[] = "w"; -char *c_functions = "c_functions"; -char *coutput = "c_output"; -char *initfname = "raw_data"; -char *initbname = "raw_data.b"; -char *blkdfname = "block_data"; -char *p1_file = "p1_file"; -char *p1_bakfile = "p1_file.BAK"; -char *sortfname = "init_file"; -char *proto_fname = "proto_file"; - -char link_msg[] = "-lf2c -lm"; /* was "-lF77 -lI77 -lm -lc"; */ - -#ifndef TMPDIR -#ifdef MSDOS -#define TMPDIR "" -#else -#define TMPDIR "/tmp" -#endif -#endif - -char *tmpdir = TMPDIR; - - void -Un_link_all(cdelete) -{ - if (!debugflag) { - unlink(c_functions); - unlink(initfname); - unlink(p1_file); - unlink(sortfname); - unlink(blkdfname); - if (cdelete && coutput) - unlink(coutput); - } - } - - void -set_tmp_names() -{ - int k; - if (debugflag == 1) - return; - k = strlen(tmpdir) + 16; - c_functions = (char *)ckalloc(7*k); - initfname = c_functions + k; - initbname = initfname + k; - blkdfname = initbname + k; - p1_file = blkdfname + k; - p1_bakfile = p1_file + k; - sortfname = p1_bakfile + k; - { -#ifdef MSDOS - char buf[64], *s, *t; - if (!*tmpdir || *tmpdir == '.' && !tmpdir[1]) - t = ""; - else { - /* substitute \ for / to avoid confusion with a - * switch indicator in the system("sort ...") - * call in formatdata.c - */ - for(s = tmpdir, t = buf; *s; s++, t++) - if ((*t = *s) == '/') - *t = '\\'; - if (t[-1] != '\\') - *t++ = '\\'; - *t = 0; - t = buf; - } - sprintf(c_functions, "%sf2c_func", t); - sprintf(initfname, "%sf2c_rd", t); - sprintf(blkdfname, "%sf2c_blkd", t); - sprintf(p1_file, "%sf2c_p1f", t); - sprintf(p1_bakfile, "%sf2c_p1fb", t); - sprintf(sortfname, "%sf2c_sort", t); -#else - int pid = getpid(); - sprintf(c_functions, "%s/f2c%d_func", tmpdir, pid); - sprintf(initfname, "%s/f2c%d_rd", tmpdir, pid); - sprintf(blkdfname, "%s/f2c%d_blkd", tmpdir, pid); - sprintf(p1_file, "%s/f2c%d_p1f", tmpdir, pid); - sprintf(p1_bakfile, "%s/f2c%d_p1fb", tmpdir, pid); - sprintf(sortfname, "%s/f2c%d_sort", tmpdir, pid); -#endif - sprintf(initbname, "%s.b", initfname); - } - if (debugflag) - fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions, - initfname, blkdfname, p1_file, p1_bakfile, sortfname); - } - - char * -c_name(s,ft)char *s; -{ - char *b, *s0; - int c; - - b = s0 = s; - while(c = *s++) - if (c == '/') - b = s; - if (--s < s0 + 3 || s[-2] != '.' - || ((c = *--s) != 'f' && c != 'F')) { - infname = s0; - Fatal("file name must end in .f or .F"); - } - *s = ft; - b = copys(b); - *s = c; - return b; - } - - static void -killed(sig) -{ - signal(SIGINT, SIG_IGN); -#ifdef SIGQUIT - signal(SIGQUIT, SIG_IGN); -#endif -#ifdef SIGHUP - signal(SIGHUP, SIG_IGN); -#endif - signal(SIGTERM, SIG_IGN); - Un_link_all(1); - exit(126); - } - - static void -sig1catch(sig) -{ - if (signal(sig, SIG_IGN) != SIG_IGN) - signal(sig, killed); - } - - static void -flovflo(sig) -{ - Fatal("floating exception during constant evaluation; cannot recover"); - /* vax returns a reserved operand that generates - an illegal operand fault on next instruction, - which if ignored causes an infinite loop. - */ - signal(SIGFPE, flovflo); -} - - void -sigcatch(sig) -{ - sig1catch(SIGINT); -#ifdef SIGQUIT - sig1catch(SIGQUIT); -#endif -#ifdef SIGHUP - sig1catch(SIGHUP); -#endif - sig1catch(SIGTERM); - signal(SIGFPE, flovflo); /* catch overflows */ - } - - -dofork() -{ -#ifdef MSDOS - Fatal("Only one Fortran input file allowed under MS-DOS"); -#else - int pid, status, w; - extern int retcode; - - if (!(pid = fork())) - return 1; - if (pid == -1) - Fatal("bad fork"); - while((w = wait(&status)) != pid) - if (w == -1) - Fatal("bad wait code"); - retcode |= status >> 8; -#endif - return 0; - } - -/* Initialization of tables that change with the character set... */ - -char escapes[Table_size]; - -#ifdef non_ASCII -char *str_fmt[Table_size]; -static char *str0fmt[127] = { /*}*/ -#else -char *str_fmt[Table_size] = { -#endif - "\\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", "{", "|", "}", "~" - }; - -#ifdef non_ASCII -char *chr_fmt[Table_size]; -static char *chr0fmt[127] = { /*}*/ -#else -char *chr_fmt[Table_size] = { -#endif - "\\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", "{", "|", "}", "~" - }; - - void -fmt_init() -{ - static char *str1fmt[6] = - { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" }; - register int i, j; - register char *s; - - /* str_fmt */ - -#ifdef non_ASCII - i = 0; -#else - i = 127; -#endif - for(; i < Table_size; i++) - str_fmt[i] = "\\%03o"; -#ifdef non_ASCII - for(i = 32; i < 127; i++) { - s = str0fmt[i]; - str_fmt[*(unsigned char *)s] = s; - } - str_fmt['"'] = "\\\""; -#else - if (Ansi == 1) - str_fmt[7] = chr_fmt[7] = "\\a"; -#endif - - /* chr_fmt */ - -#ifdef non_ASCII - for(i = 0; i < 32; i++) - chr_fmt[i] = chr0fmt[i]; -#else - i = 127; -#endif - for(; i < Table_size; i++) - chr_fmt[i] = "\\%o"; -#ifdef non_ASCII - for(i = 32; i < 127; i++) { - s = chr0fmt[i]; - j = *(unsigned char *)s; - if (j == '\\') - j = *(unsigned char *)(s+1); - chr_fmt[j] = s; - } -#endif - - /* escapes (used in lex.c) */ - - for(i = 0; i < Table_size; i++) - escapes[i] = i; - for(s = "btnfr0", i = 0; i < 6; i++) - escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i]; - /* finish str_fmt and chr_fmt */ - - if (Ansi) - str1fmt[5] = "\\v"; - if ('\v' == 'v') { /* ancient C compiler */ - str1fmt[5] = "v"; -#ifndef non_ASCII - escapes['v'] = 11; -#endif - } - else - escapes['v'] = '\v'; - for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;) - str_fmt[j] = chr_fmt[j] = str1fmt[i++]; - /* '\v' = 11 for both EBCDIC and ASCII... */ - chr_fmt[11] = Ansi ? "\\v" : "\\13"; - } - - - -/* Unless SYSTEM_SORT is defined, the following gives a simple - * in-core version of dsort(). On Fortran source with huge DATA - * statements, the in-core version may exhaust the available memory, - * in which case you might either recompile this source file with - * SYSTEM_SORT defined (if that's reasonable on your system), or - * replace the dsort below with a more elaborate version that - * does a merging sort with the help of auxiliary files. - */ - -#ifdef SYSTEM_SORT - -dsort(from, to) - char *from, *to; -{ - char buf[200]; - sprintf(buf, "sort <%s >%s", from, to); - return system(buf) >> 8; - } -#else - - static int -compare(a,b) - char *a, *b; -{ return strcmp(*(char **)a, *(char **)b); } - -dsort(from, to) - char *from, *to; -{ - extern char *Alloc(); - - struct Memb { - struct Memb *next; - int n; - char buf[32000]; - }; - typedef struct Memb memb; - memb *mb, *mb1; - register char *x, *x0, *xe; - register int c, n; - FILE *f; - char **z, **z0; - int nn = 0; - - f = opf(from, textread); - mb = (memb *)Alloc(sizeof(memb)); - mb->next = 0; - x0 = x = mb->buf; - xe = x + sizeof(mb->buf); - n = 0; - for(;;) { - c = getc(f); - if (x >= xe && (c != EOF || x != x0)) { - if (!n) - return 126; - nn += n; - mb->n = n; - mb1 = (memb *)Alloc(sizeof(memb)); - mb1->next = mb; - mb = mb1; - memcpy(mb->buf, x0, n = x-x0); - x0 = mb->buf; - x = x0 + n; - xe = x0 + sizeof(mb->buf); - n = 0; - } - if (c == EOF) - break; - if (c == '\n') { - ++n; - *x++ = 0; - x0 = x; - } - else - *x++ = c; - } - clf(&f, from, 1); - f = opf(to, textwrite); - if (x > x0) { /* shouldn't happen */ - *x = 0; - ++n; - } - mb->n = n; - nn += n; - if (!nn) /* shouldn't happen */ - goto done; - z = z0 = (char **)Alloc(nn*sizeof(char *)); - for(mb1 = mb; mb1; mb1 = mb1->next) { - x = mb1->buf; - n = mb1->n; - for(;;) { - *z++ = x; - if (--n <= 0) - break; - while(*x++); - } - } - qsort((char *)z0, nn, sizeof(char *), compare); - for(n = nn, z = z0; n > 0; n--) - fprintf(f, "%s\n", *z++); - free((char *)z0); - done: - clf(&f, to, 1); - do { - mb1 = mb->next; - free((char *)mb); - } - while(mb = mb1); - return 0; - } -#endif |