summaryrefslogtreecommitdiffstats
path: root/usr.bin/f2c/sysdep.c
diff options
context:
space:
mode:
Diffstat (limited to 'usr.bin/f2c/sysdep.c')
-rw-r--r--usr.bin/f2c/sysdep.c442
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
OpenPOWER on IntegriCloud