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