1*47943Sbostic /*- 2*47943Sbostic * Copyright (c) 1980 The Regents of the University of California. 3*47943Sbostic * All rights reserved. 4*47943Sbostic * 5*47943Sbostic * %sccs.include.proprietary.c% 6*47943Sbostic */ 7*47943Sbostic 8*47943Sbostic #ifndef lint 9*47943Sbostic static char sccsid[] = "@(#)f77_abort.c 5.3 (Berkeley) 04/12/91"; 10*47943Sbostic #endif /* not lint */ 11*47943Sbostic 1223774Sjerry /* 1323774Sjerry * all f77 aborts eventually call f77_abort. 1423774Sjerry * f77_abort cleans up open files and terminates with a dump if needed, 1523774Sjerry * with a message otherwise. 1623774Sjerry * 1723774Sjerry */ 1823774Sjerry 1923774Sjerry #include <signal.h> 2023774Sjerry #include "fio.h" 2123774Sjerry 2223774Sjerry char *getenv(); 2323774Sjerry extern int errno; 2423860Sjerry int _lg_flag; /* _lg_flag is non-zero if -lg was specified to ld */ 2523774Sjerry f77_abort(err_val,act_core)2623774Sjerryf77_abort( err_val, act_core ) 2723774Sjerry { 2823774Sjerry char first_char, *env_var; 2923774Sjerry int core_dump; 3023774Sjerry 3123774Sjerry env_var = getenv("f77_dump_flag"); 3223774Sjerry first_char = (env_var == NULL) ? 0 : *env_var; 3323774Sjerry 3423774Sjerry signal(SIGILL, SIG_DFL); 3523774Sjerry sigsetmask(0); /* don't block */ 3623774Sjerry 3723774Sjerry /* see if we want a core dump: 3823774Sjerry first line checks for signals like hangup - don't dump then. 3923774Sjerry second line checks if -lg specified to ld (e.g. by saying 4023774Sjerry -g to f77) and checks the f77_dump_flag var. */ 4123774Sjerry core_dump = ((nargs() != 2) || act_core) && 4223860Sjerry ( (_lg_flag && (first_char != 'n')) || first_char == 'y'); 4323774Sjerry 4423774Sjerry if( !core_dump ) 4523774Sjerry fprintf(units[STDERR].ufd,"*** Execution terminated\n"); 4623774Sjerry 4723774Sjerry f_exit(); 4823774Sjerry _cleanup(); 4923774Sjerry if( nargs() ) errno = err_val; 5023774Sjerry else errno = -2; /* prior value will be meaningless, 5123774Sjerry so set it to undefined value */ 5223774Sjerry 5323774Sjerry if( core_dump ) abort(); 5423774Sjerry else exit( errno ); 5523774Sjerry } 56