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