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	7/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: }
Last modified: 1985-07-13
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 978
Valid CSS Valid XHTML 1.0 Strict