1 /*- 2 * Copyright (c) 1980 The Regents of the University of California. 3 * All rights reserved. 4 * 5 * %sccs.include.proprietary.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)f77_abort.c 5.3 (Berkeley) 04/12/91"; 10 #endif /* not lint */ 11 12 /* 13 * all f77 aborts eventually call f77_abort. 14 * f77_abort cleans up open files and terminates with a dump if needed, 15 * with a message otherwise. 16 * 17 */ 18 19 #include <signal.h> 20 #include "fio.h" 21 22 char *getenv(); 23 extern int errno; 24 int _lg_flag; /* _lg_flag is non-zero if -lg was specified to ld */ 25 26 f77_abort( err_val, act_core ) 27 { 28 char first_char, *env_var; 29 int core_dump; 30 31 env_var = getenv("f77_dump_flag"); 32 first_char = (env_var == NULL) ? 0 : *env_var; 33 34 signal(SIGILL, SIG_DFL); 35 sigsetmask(0); /* don't block */ 36 37 /* see if we want a core dump: 38 first line checks for signals like hangup - don't dump then. 39 second line checks if -lg specified to ld (e.g. by saying 40 -g to f77) and checks the f77_dump_flag var. */ 41 core_dump = ((nargs() != 2) || act_core) && 42 ( (_lg_flag && (first_char != 'n')) || first_char == 'y'); 43 44 if( !core_dump ) 45 fprintf(units[STDERR].ufd,"*** Execution terminated\n"); 46 47 f_exit(); 48 _cleanup(); 49 if( nargs() ) errno = err_val; 50 else errno = -2; /* prior value will be meaningless, 51 so set it to undefined value */ 52 53 if( core_dump ) abort(); 54 else exit( errno ); 55 } 56