123774Sjerry /* 223774Sjerry * Copyright (c) 1980 Regents of the University of California. 323774Sjerry * All rights reserved. The Berkeley software License Agreement 423774Sjerry * specifies the terms and conditions for redistribution. 523774Sjerry * 6*23860Sjerry * @(#)f77_abort.c 5.2 07/12/85 723774Sjerry * 823774Sjerry * all f77 aborts eventually call f77_abort. 923774Sjerry * f77_abort cleans up open files and terminates with a dump if needed, 1023774Sjerry * with a message otherwise. 1123774Sjerry * 1223774Sjerry */ 1323774Sjerry 1423774Sjerry #include <signal.h> 1523774Sjerry #include "fio.h" 1623774Sjerry 1723774Sjerry char *getenv(); 1823774Sjerry extern int errno; 19*23860Sjerry int _lg_flag; /* _lg_flag is non-zero if -lg was specified to ld */ 2023774Sjerry 2123774Sjerry f77_abort( err_val, act_core ) 2223774Sjerry { 2323774Sjerry char first_char, *env_var; 2423774Sjerry int core_dump; 2523774Sjerry 2623774Sjerry env_var = getenv("f77_dump_flag"); 2723774Sjerry first_char = (env_var == NULL) ? 0 : *env_var; 2823774Sjerry 2923774Sjerry signal(SIGILL, SIG_DFL); 3023774Sjerry sigsetmask(0); /* don't block */ 3123774Sjerry 3223774Sjerry /* see if we want a core dump: 3323774Sjerry first line checks for signals like hangup - don't dump then. 3423774Sjerry second line checks if -lg specified to ld (e.g. by saying 3523774Sjerry -g to f77) and checks the f77_dump_flag var. */ 3623774Sjerry core_dump = ((nargs() != 2) || act_core) && 37*23860Sjerry ( (_lg_flag && (first_char != 'n')) || first_char == 'y'); 3823774Sjerry 3923774Sjerry if( !core_dump ) 4023774Sjerry fprintf(units[STDERR].ufd,"*** Execution terminated\n"); 4123774Sjerry 4223774Sjerry f_exit(); 4323774Sjerry _cleanup(); 4423774Sjerry if( nargs() ) errno = err_val; 4523774Sjerry else errno = -2; /* prior value will be meaningless, 4623774Sjerry so set it to undefined value */ 4723774Sjerry 4823774Sjerry if( core_dump ) abort(); 4923774Sjerry else exit( errno ); 5023774Sjerry } 51