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