check directly for -lg.

[unix-history] / usr / src / usr.bin / f77 / libF77 / main.c

/* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */
char id_libF77[] = "@(#)main.c  2.17    %G%";

#include <stdio.h>
#include <signal.h>
#include "../libI77/fiodefs.h"

extern int errno;
char *getenv();

int xargc;
char **xargv;

main(argc, argv, arge)
int argc;
char **argv;
char **arge;
{
int sigdie();
long int (*sigf)();
int signum;

xargc = argc;
xargv = argv;

for (signum=1; signum<=16; signum++)
{
       if((sigf=signal(signum, sigdie)) != SIG_DFL) signal(signum, sigf);
}

#ifdef pdp11
       ldfps(01200); /* detect overflow as an exception */
#endif

f_init();
MAIN_();
f_exit();
return 0;
}

struct action {
       char *mesg;
       int   core;
} sig_act[16] = {
       {"Hangup", 0},                  /* SIGHUP  */
       {"Interrupt!", 0},              /* SIGINT  */
       {"Quit!", 1},                   /* SIGQUIT */
       {"Illegal ", 1},                /* SIGILL  */
       {"Trace Trap", 1},              /* SIGTRAP */
       {"IOT Trap", 1},                /* SIGIOT  */
       {"EMT Trap", 1},                /* SIGEMT  */
       {"Arithmetic Exception", 1},    /* SIGFPE  */
       { 0, 0},                        /* SIGKILL */
       {"Bus error", 1},               /* SIGBUS  */
       {"Segmentation violation", 1},  /* SIGSEGV */
       {"Sys arg", 1},                 /* SIGSYS  */
       {"Open pipe", 0},               /* SIGPIPE */
       {"Alarm", 0},                   /* SIGALRM */
       {"Terminated", 0},              /* SIGTERM */
       {"Sig 16", 0},                  /* unassigned */
};

struct action act_fpe[] = {
       {"Integer overflow", 1},
       {"Integer divide by 0", 1},
       {"Floating point overflow trap", 1},
       {"Floating divide by zero trap", 1},
       {"Floating point underflow trap", 1},
       {"Decimal overflow", 1},
       {"Subscript range", 1},
       {"Floating point overflow", 0},
       {"Floating divide by zero", 0},
       {"Floating point underflow", 0},
};

struct action act_ill[] = {
       {"addr mode", 1},
       {"instruction", 1},
       {"operand", 0},
};

#if     vax
sigdie(s, t, sc)
int s; int t; struct sigcontext *sc;

#else   pdp11
sigdie(s, t, pc)
int s; int t; long pc;

#endif
{
extern unit units[];
register struct action *act = &sig_act[s-1];
/* print error message, then flush buffers */

if (s == SIGHUP || s == SIGINT || s == SIGQUIT)
       signal(s, SIG_IGN);     /* don't allow it again */
else
       signal(s, SIG_DFL);     /* shouldn't happen again, but ... */

if (act->mesg)
       {
       fprintf(units[STDERR].ufd, "*** %s", act->mesg);
       if (s == SIGFPE)
               {
               if (t >= 1 && t <= 10)
                       fprintf(units[STDERR].ufd, ": %s", act_fpe[t-1].mesg);
               else
                       fprintf(units[STDERR].ufd, ": Type=%d?", t);
               }
       else if (s == SIGILL)
               {
               if (t == 4) t = 2;      /* 4.0bsd botch */
               if (t >= 0 && t <= 2)
                       fprintf(units[STDERR].ufd, "%s", act_ill[t].mesg);
               else
                       fprintf(units[STDERR].ufd, "compat mode: Code=%d", t);
               }
       putc('\n', units[STDERR].ufd);
       }
f77_abort( s, act->core );
}

extern int _dbsubc;     /* dbsubc is non-zero if -lg was specified to ld */
f77_abort( err_val, act_core )
{
       char first_char, *env_var;
       int core_dump;

       env_var = getenv("f77_dump_flag");
       first_char = (env_var == NULL) ? 0 : *env_var;

       signal(SIGILL, SIG_DFL);
       sigsetmask(0);                  /* don't block */

       /* see if we want a core dump:
               first line checks for signals like hangup - don't dump then.
               second line checks if -lg specified to ld (e.g. by saying
                       -g to f77) and checks the f77_dump_flag var. */
       core_dump = ((nargs() != 2) || act_core) &&
           ( (_dbsubc && (first_char != 'n')) || first_char == 'y');

       if( !core_dump )
               fprintf(units[STDERR].ufd,"*** Execution terminated\n");

       f_exit();
       _cleanup();
       if( nargs() ) errno = err_val;
       else errno = -2;   /* prior value will be meaningless,
                               so set it to undefined value */

       if( core_dump ) abort();
       else  exit( errno );
}