00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023 #include "defs.h"
00024 #include "usignal.h"
00025
00026 char binread[] = "rb", textread[] = "r";
00027 char binwrite[] = "wb", textwrite[] = "w";
00028 char *c_functions = "c_functions";
00029 char *coutput = "c_output";
00030 char *initfname = "raw_data";
00031 char *initbname = "raw_data.b";
00032 char *blkdfname = "block_data";
00033 char *p1_file = "p1_file";
00034 char *p1_bakfile = "p1_file.BAK";
00035 char *sortfname = "init_file";
00036 char *proto_fname = "proto_file";
00037
00038 char link_msg[] = "-lf2c -lm";
00039
00040 char *outbuf = "", *outbtail;
00041
00042 #ifndef TMPDIR
00043 #ifdef MSDOS
00044 #define TMPDIR ""
00045 #else
00046 #define TMPDIR "/tmp"
00047 #endif
00048 #endif
00049
00050 char *tmpdir = TMPDIR;
00051 #ifndef MSDOS
00052 #ifndef KR_headers
00053 extern int getpid(void);
00054 #endif
00055 #endif
00056
00057 void
00058 #ifdef KR_headers
00059 Un_link_all(cdelete)
00060 int cdelete;
00061 #else
00062 Un_link_all(int cdelete)
00063 #endif
00064 {
00065 #ifndef KR_headers
00066 extern int unlink(const char *);
00067 #endif
00068 if (!debugflag) {
00069 unlink(c_functions);
00070 unlink(initfname);
00071 unlink(p1_file);
00072 unlink(sortfname);
00073 unlink(blkdfname);
00074 if (cdelete && coutput)
00075 unlink(coutput);
00076 }
00077 }
00078
00079 void
00080 set_tmp_names(Void)
00081 {
00082 int k;
00083 if (debugflag == 1)
00084 return;
00085 k = strlen(tmpdir) + 24;
00086 c_functions = (char *)ckalloc(7*k);
00087 initfname = c_functions + k;
00088 initbname = initfname + k;
00089 blkdfname = initbname + k;
00090 p1_file = blkdfname + k;
00091 p1_bakfile = p1_file + k;
00092 sortfname = p1_bakfile + k;
00093 {
00094 #ifdef MSDOS
00095 char buf[64], *s, *t;
00096 if (!*tmpdir || *tmpdir == '.' && !tmpdir[1])
00097 t = "";
00098 else {
00099
00100
00101
00102
00103 for(s = tmpdir, t = buf; *s; s++, t++)
00104 if ((*t = *s) == '/')
00105 *t = '\\';
00106 if (t[-1] != '\\')
00107 *t++ = '\\';
00108 *t = 0;
00109 t = buf;
00110 }
00111 sprintf(c_functions, "%sf2c_func", t);
00112 sprintf(initfname, "%sf2c_rd", t);
00113 sprintf(blkdfname, "%sf2c_blkd", t);
00114 sprintf(p1_file, "%sf2c_p1f", t);
00115 sprintf(p1_bakfile, "%sf2c_p1fb", t);
00116 sprintf(sortfname, "%sf2c_sort", t);
00117 #else
00118 long pid = getpid();
00119 sprintf(c_functions, "%s/f2c%ld_func", tmpdir, pid);
00120 sprintf(initfname, "%s/f2c%ld_rd", tmpdir, pid);
00121 sprintf(blkdfname, "%s/f2c%ld_blkd", tmpdir, pid);
00122 sprintf(p1_file, "%s/f2c%ld_p1f", tmpdir, pid);
00123 sprintf(p1_bakfile, "%s/f2c%ld_p1fb", tmpdir, pid);
00124 sprintf(sortfname, "%s/f2c%ld_sort", tmpdir, pid);
00125 #endif
00126 sprintf(initbname, "%s.b", initfname);
00127 }
00128 if (debugflag)
00129 fprintf(diagfile, "%s %s %s %s %s %s\n", c_functions,
00130 initfname, blkdfname, p1_file, p1_bakfile, sortfname);
00131 }
00132
00133 char *
00134 #ifdef KR_headers
00135 c_name(s, ft)
00136 char *s;
00137 int ft;
00138 #else
00139 c_name(char *s, int ft)
00140 #endif
00141 {
00142 char *b, *s0;
00143 int c;
00144
00145 b = s0 = s;
00146 while(c = *s++)
00147 if (c == '/')
00148 b = s;
00149 if (--s < s0 + 3 || s[-2] != '.'
00150 || ((c = *--s) != 'f' && c != 'F')) {
00151 infname = s0;
00152 Fatal("file name must end in .f or .F");
00153 }
00154 strcpy(outbtail, b);
00155 outbtail[s-b] = ft;
00156 b = copys(outbuf);
00157 return b;
00158 }
00159
00160 static void
00161 #ifdef KR_headers
00162 killed(sig)
00163 int sig;
00164 #else
00165 killed(int sig)
00166 #endif
00167 {
00168 sig = sig;
00169 signal(SIGINT, SIG_IGN);
00170 #ifdef SIGQUIT
00171 signal(SIGQUIT, SIG_IGN);
00172 #endif
00173 #ifdef SIGHUP
00174 signal(SIGHUP, SIG_IGN);
00175 #endif
00176 signal(SIGTERM, SIG_IGN);
00177 Un_link_all(1);
00178 exit(126);
00179 }
00180
00181 static void
00182 #ifdef KR_headers
00183 sig1catch(sig)
00184 int sig;
00185 #else
00186 sig1catch(int sig)
00187 #endif
00188 {
00189 sig = sig;
00190 if (signal(sig, SIG_IGN) != SIG_IGN)
00191 signal(sig, killed);
00192 }
00193
00194 static void
00195 #ifdef KR_headers
00196 flovflo(sig)
00197 int sig;
00198 #else
00199 flovflo(int sig)
00200 #endif
00201 {
00202 sig = sig;
00203 Fatal("floating exception during constant evaluation; cannot recover");
00204
00205
00206
00207
00208 signal(SIGFPE, flovflo);
00209 }
00210
00211 void
00212 #ifdef KR_headers
00213 sigcatch(sig)
00214 int sig;
00215 #else
00216 sigcatch(int sig)
00217 #endif
00218 {
00219 sig = sig;
00220 sig1catch(SIGINT);
00221 #ifdef SIGQUIT
00222 sig1catch(SIGQUIT);
00223 #endif
00224 #ifdef SIGHUP
00225 sig1catch(SIGHUP);
00226 #endif
00227 sig1catch(SIGTERM);
00228 signal(SIGFPE, flovflo);
00229 }
00230
00231
00232 dofork(Void)
00233 {
00234 #ifdef MSDOS
00235 Fatal("Only one Fortran input file allowed under MS-DOS");
00236 #else
00237 #ifndef KR_headers
00238 extern int fork(void), wait(int*);
00239 #endif
00240 int pid, status, w;
00241 extern int retcode;
00242
00243 if (!(pid = fork()))
00244 return 1;
00245 if (pid == -1)
00246 Fatal("bad fork");
00247 while((w = wait(&status)) != pid)
00248 if (w == -1)
00249 Fatal("bad wait code");
00250 retcode |= status >> 8;
00251 #endif
00252 return 0;
00253 }
00254
00255
00256
00257 char escapes[Table_size];
00258
00259 #ifdef non_ASCII
00260 char *str_fmt[Table_size];
00261 static char *str0fmt[127] = {
00262 #else
00263 char *str_fmt[Table_size] = {
00264 #endif
00265 "\\000", "\\001", "\\002", "\\003", "\\004", "\\005", "\\006", "\\007",
00266 "\\b", "\\t", "\\n", "\\013", "\\f", "\\r", "\\016", "\\017",
00267 "\\020", "\\021", "\\022", "\\023", "\\024", "\\025", "\\026", "\\027",
00268 "\\030", "\\031", "\\032", "\\033", "\\034", "\\035", "\\036", "\\037",
00269 " ", "!", "\\\"", "#", "$", "%%", "&", "'",
00270 "(", ")", "*", "+", ",", "-", ".", "/",
00271 "0", "1", "2", "3", "4", "5", "6", "7",
00272 "8", "9", ":", ";", "<", "=", ">", "?",
00273 "@", "A", "B", "C", "D", "E", "F", "G",
00274 "H", "I", "J", "K", "L", "M", "N", "O",
00275 "P", "Q", "R", "S", "T", "U", "V", "W",
00276 "X", "Y", "Z", "[", "\\\\", "]", "^", "_",
00277 "`", "a", "b", "c", "d", "e", "f", "g",
00278 "h", "i", "j", "k", "l", "m", "n", "o",
00279 "p", "q", "r", "s", "t", "u", "v", "w",
00280 "x", "y", "z", "{", "|", "}", "~"
00281 };
00282
00283 #ifdef non_ASCII
00284 char *chr_fmt[Table_size];
00285 static char *chr0fmt[127] = {
00286 #else
00287 char *chr_fmt[Table_size] = {
00288 #endif
00289 "\\0", "\\1", "\\2", "\\3", "\\4", "\\5", "\\6", "\\7",
00290 "\\b", "\\t", "\\n", "\\13", "\\f", "\\r", "\\16", "\\17",
00291 "\\20", "\\21", "\\22", "\\23", "\\24", "\\25", "\\26", "\\27",
00292 "\\30", "\\31", "\\32", "\\33", "\\34", "\\35", "\\36", "\\37",
00293 " ", "!", "\"", "#", "$", "%%", "&", "\\'",
00294 "(", ")", "*", "+", ",", "-", ".", "/",
00295 "0", "1", "2", "3", "4", "5", "6", "7",
00296 "8", "9", ":", ";", "<", "=", ">", "?",
00297 "@", "A", "B", "C", "D", "E", "F", "G",
00298 "H", "I", "J", "K", "L", "M", "N", "O",
00299 "P", "Q", "R", "S", "T", "U", "V", "W",
00300 "X", "Y", "Z", "[", "\\\\", "]", "^", "_",
00301 "`", "a", "b", "c", "d", "e", "f", "g",
00302 "h", "i", "j", "k", "l", "m", "n", "o",
00303 "p", "q", "r", "s", "t", "u", "v", "w",
00304 "x", "y", "z", "{", "|", "}", "~"
00305 };
00306
00307 void
00308 fmt_init(Void)
00309 {
00310 static char *str1fmt[6] =
00311 { "\\b", "\\t", "\\n", "\\f", "\\r", "\\%03o" };
00312 register int i, j;
00313 register char *s;
00314
00315
00316
00317 #ifdef non_ASCII
00318 i = 0;
00319 #else
00320 i = 127;
00321 #endif
00322 for(; i < Table_size; i++)
00323 str_fmt[i] = "\\%03o";
00324 #ifdef non_ASCII
00325 for(i = 32; i < 127; i++) {
00326 s = str0fmt[i];
00327 str_fmt[*(unsigned char *)s] = s;
00328 }
00329 str_fmt['"'] = "\\\"";
00330 #else
00331 if (Ansi == 1)
00332 str_fmt[7] = chr_fmt[7] = "\\a";
00333 #endif
00334
00335
00336
00337 #ifdef non_ASCII
00338 for(i = 0; i < 32; i++)
00339 chr_fmt[i] = chr0fmt[i];
00340 #else
00341 i = 127;
00342 #endif
00343 for(; i < Table_size; i++)
00344 chr_fmt[i] = "\\%o";
00345 #ifdef non_ASCII
00346 for(i = 32; i < 127; i++) {
00347 s = chr0fmt[i];
00348 j = *(unsigned char *)s;
00349 if (j == '\\')
00350 j = *(unsigned char *)(s+1);
00351 chr_fmt[j] = s;
00352 }
00353 #endif
00354
00355
00356
00357 for(i = 0; i < Table_size; i++)
00358 escapes[i] = i;
00359 for(s = "btnfr0", i = 0; i < 6; i++)
00360 escapes[*(unsigned char *)s++] = "\b\t\n\f\r"[i];
00361
00362
00363 if (Ansi)
00364 str1fmt[5] = "\\v";
00365 if ('\v' == 'v') {
00366 str1fmt[5] = "v";
00367 #ifndef non_ASCII
00368 escapes['v'] = 11;
00369 #endif
00370 }
00371 else
00372 escapes['v'] = '\v';
00373 for(s = "\b\t\n\f\r\v", i = 0; j = *(unsigned char *)s++;)
00374 str_fmt[j] = chr_fmt[j] = str1fmt[i++];
00375
00376 chr_fmt[11] = Ansi ? "\\v" : "\\13";
00377 }
00378
00379 void
00380 outbuf_adjust(Void)
00381 {
00382 int n, n1;
00383 char *s;
00384
00385 n = n1 = strlen(outbuf);
00386 if (*outbuf && outbuf[n-1] != '/')
00387 n1++;
00388 s = Alloc(n+64);
00389 outbtail = s + n1;
00390 strcpy(s, outbuf);
00391 if (n != n1)
00392 strcpy(s+n, "/");
00393 outbuf = s;
00394 }
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406 #ifdef SYSTEM_SORT
00407
00408 int
00409 #ifdef KR_headers
00410 dsort(from, to)
00411 char *from;
00412 char *to;
00413 #else
00414 dsort(char *from, char *to)
00415 #endif
00416 {
00417 char buf[200];
00418 sprintf(buf, "sort <%s >%s", from, to);
00419 return system(buf) >> 8;
00420 }
00421 #else
00422
00423 static int
00424 #ifdef KR_headers
00425 compare(a,b)
00426 char *a, *b;
00427 #else
00428 compare(const void *a, const void *b)
00429 #endif
00430 { return strcmp(*(char **)a, *(char **)b); }
00431
00432 #ifdef KR_headers
00433 dsort(from, to)
00434 char *from;
00435 char *to;
00436 #else
00437 dsort(char *from, char *to)
00438 #endif
00439 {
00440 struct Memb {
00441 struct Memb *next;
00442 int n;
00443 char buf[32000];
00444 };
00445 typedef struct Memb memb;
00446 memb *mb, *mb1;
00447 register char *x, *x0, *xe;
00448 register int c, n;
00449 FILE *f;
00450 char **z, **z0;
00451 int nn = 0;
00452
00453 f = opf(from, textread);
00454 mb = (memb *)Alloc(sizeof(memb));
00455 mb->next = 0;
00456 x0 = x = mb->buf;
00457 xe = x + sizeof(mb->buf);
00458 n = 0;
00459 for(;;) {
00460 c = getc(f);
00461 if (x >= xe && (c != EOF || x != x0)) {
00462 if (!n)
00463 return 126;
00464 nn += n;
00465 mb->n = n;
00466 mb1 = (memb *)Alloc(sizeof(memb));
00467 mb1->next = mb;
00468 mb = mb1;
00469 memcpy(mb->buf, x0, n = x-x0);
00470 x0 = mb->buf;
00471 x = x0 + n;
00472 xe = x0 + sizeof(mb->buf);
00473 n = 0;
00474 }
00475 if (c == EOF)
00476 break;
00477 if (c == '\n') {
00478 ++n;
00479 *x++ = 0;
00480 x0 = x;
00481 }
00482 else
00483 *x++ = c;
00484 }
00485 clf(&f, from, 1);
00486 f = opf(to, textwrite);
00487 if (x > x0) {
00488 *x = 0;
00489 ++n;
00490 }
00491 mb->n = n;
00492 nn += n;
00493 if (!nn)
00494 goto done;
00495 z = z0 = (char **)Alloc(nn*sizeof(char *));
00496 for(mb1 = mb; mb1; mb1 = mb1->next) {
00497 x = mb1->buf;
00498 n = mb1->n;
00499 for(;;) {
00500 *z++ = x;
00501 if (--n <= 0)
00502 break;
00503 while(*x++);
00504 }
00505 }
00506 qsort((char *)z0, nn, sizeof(char *), compare);
00507 for(n = nn, z = z0; n > 0; n--)
00508 fprintf(f, "%s\n", *z++);
00509 free((char *)z0);
00510 done:
00511 clf(&f, to, 1);
00512 do {
00513 mb1 = mb->next;
00514 free((char *)mb);
00515 }
00516 while(mb = mb1);
00517 return 0;
00518 }
00519 #endif