xref: /csrg-svn/usr.bin/f77/libF77/main.c (revision 22925)
1*22925Skre /*
2*22925Skre  * Copyright (c) 1980 Regents of the University of California.
3*22925Skre  * All rights reserved.  The Berkeley software License Agreement
4*22925Skre  * specifies the terms and conditions for redistribution.
5*22925Skre  *
6*22925Skre  *	@(#)main.c	5.1	06/07/85
7*22925Skre  */
84130Sdlw #include <stdio.h>
94130Sdlw #include <signal.h>
104131Sdlw #include "../libI77/fiodefs.h"
114130Sdlw 
1220197Slibs extern int errno;
1320197Slibs char *getenv();
1420197Slibs 
154130Sdlw int xargc;
164130Sdlw char **xargv;
174130Sdlw 
184130Sdlw main(argc, argv, arge)
194130Sdlw int argc;
204130Sdlw char **argv;
214130Sdlw char **arge;
224130Sdlw {
234134Sdlw int sigdie();
244130Sdlw long int (*sigf)();
254168Sdlw int signum;
264130Sdlw 
274130Sdlw xargc = argc;
284130Sdlw xargv = argv;
294130Sdlw 
304168Sdlw for (signum=1; signum<=16; signum++)
314168Sdlw {
324168Sdlw 	if((sigf=signal(signum, sigdie)) != SIG_DFL) signal(signum, sigf);
334168Sdlw }
344168Sdlw 
354130Sdlw #ifdef pdp11
364130Sdlw 	ldfps(01200); /* detect overflow as an exception */
374130Sdlw #endif
384130Sdlw 
394130Sdlw f_init();
4012580Sfortran MAIN_();
414130Sdlw f_exit();
4220197Slibs return 0;
434130Sdlw }
444130Sdlw 
454134Sdlw struct action {
464134Sdlw 	char *mesg;
474134Sdlw 	int   core;
484134Sdlw } sig_act[16] = {
494168Sdlw 	{"Hangup", 0},			/* SIGHUP  */
504134Sdlw 	{"Interrupt!", 0},		/* SIGINT  */
514134Sdlw 	{"Quit!", 1},			/* SIGQUIT */
524170Sdlw 	{"Illegal ", 1},		/* SIGILL  */
534168Sdlw 	{"Trace Trap", 1},		/* SIGTRAP */
544134Sdlw 	{"IOT Trap", 1},		/* SIGIOT  */
554140Sdlw 	{"EMT Trap", 1},		/* SIGEMT  */
564137Sdlw 	{"Arithmetic Exception", 1},	/* SIGFPE  */
574134Sdlw 	{ 0, 0},			/* SIGKILL */
584134Sdlw 	{"Bus error", 1},		/* SIGBUS  */
594134Sdlw 	{"Segmentation violation", 1},	/* SIGSEGV */
604168Sdlw 	{"Sys arg", 1},			/* SIGSYS  */
614168Sdlw 	{"Open pipe", 0},		/* SIGPIPE */
624168Sdlw 	{"Alarm", 0},			/* SIGALRM */
634134Sdlw 	{"Terminated", 0},		/* SIGTERM */
644168Sdlw 	{"Sig 16", 0},			/* unassigned */
654134Sdlw };
664130Sdlw 
674137Sdlw struct action act_fpe[] = {
684137Sdlw 	{"Integer overflow", 1},
694137Sdlw 	{"Integer divide by 0", 1},
7013232Sdlw 	{"Floating point overflow trap", 1},
7113232Sdlw 	{"Floating divide by zero trap", 1},
7213232Sdlw 	{"Floating point underflow trap", 1},
734137Sdlw 	{"Decimal overflow", 1},
744137Sdlw 	{"Subscript range", 1},
754137Sdlw 	{"Floating point overflow", 0},
764137Sdlw 	{"Floating divide by zero", 0},
774137Sdlw 	{"Floating point underflow", 0},
784137Sdlw };
794170Sdlw 
804170Sdlw struct action act_ill[] = {
814170Sdlw 	{"addr mode", 1},
824170Sdlw 	{"instruction", 1},
834170Sdlw 	{"operand", 0},
844170Sdlw };
854130Sdlw 
8614399Sdlw #if	vax
8714399Sdlw sigdie(s, t, sc)
8814399Sdlw int s; int t; struct sigcontext *sc;
8914399Sdlw 
9014399Sdlw #else	pdp11
914137Sdlw sigdie(s, t, pc)
924137Sdlw int s; int t; long pc;
9314399Sdlw 
9414399Sdlw #endif
954130Sdlw {
964131Sdlw extern unit units[];
974134Sdlw register struct action *act = &sig_act[s-1];
984726Sdlw /* print error message, then flush buffers */
994726Sdlw 
10014840Sdlw if (s == SIGHUP || s == SIGINT || s == SIGQUIT)
10114840Sdlw 	signal(s, SIG_IGN);	/* don't allow it again */
10214840Sdlw else
10314840Sdlw 	signal(s, SIG_DFL);	/* shouldn't happen again, but ... */
10414840Sdlw 
1054137Sdlw if (act->mesg)
1064137Sdlw 	{
1074173Sdlw 	fprintf(units[STDERR].ufd, "*** %s", act->mesg);
1084137Sdlw 	if (s == SIGFPE)
1094168Sdlw 		{
1104168Sdlw 		if (t >= 1 && t <= 10)
1114168Sdlw 			fprintf(units[STDERR].ufd, ": %s", act_fpe[t-1].mesg);
1124168Sdlw 		else
1134168Sdlw 			fprintf(units[STDERR].ufd, ": Type=%d?", t);
1144168Sdlw 		}
1154168Sdlw 	else if (s == SIGILL)
1164170Sdlw 		{
1174170Sdlw 		if (t == 4) t = 2;	/* 4.0bsd botch */
1184170Sdlw 		if (t >= 0 && t <= 2)
1194170Sdlw 			fprintf(units[STDERR].ufd, "%s", act_ill[t].mesg);
1204170Sdlw 		else
1214170Sdlw 			fprintf(units[STDERR].ufd, "compat mode: Code=%d", t);
1224170Sdlw 		}
1234168Sdlw 	putc('\n', units[STDERR].ufd);
1244137Sdlw 	}
12520197Slibs f77_abort( s, act->core );
12620197Slibs }
1274130Sdlw 
12822021Slibs extern int _dbsubc;	/* dbsubc is non-zero if -lg was specified to ld */
12920197Slibs f77_abort( err_val, act_core )
13020197Slibs {
13120197Slibs 	char first_char, *env_var;
13220197Slibs 	int core_dump;
13320197Slibs 
13420197Slibs 	env_var = getenv("f77_dump_flag");
13520197Slibs 	first_char = (env_var == NULL) ? 0 : *env_var;
13620197Slibs 
1374137Sdlw 	signal(SIGILL, SIG_DFL);
13820197Slibs 	sigsetmask(0);			/* don't block */
13920197Slibs 
14022021Slibs 	/* see if we want a core dump:
14122021Slibs 		first line checks for signals like hangup - don't dump then.
14222021Slibs 		second line checks if -lg specified to ld (e.g. by saying
14322021Slibs 			-g to f77) and checks the f77_dump_flag var. */
14420197Slibs 	core_dump = ((nargs() != 2) || act_core) &&
14522021Slibs 	    ( (_dbsubc && (first_char != 'n')) || first_char == 'y');
14620197Slibs 
14720197Slibs 	if( !core_dump )
14820197Slibs 		fprintf(units[STDERR].ufd,"*** Execution terminated\n");
14920197Slibs 
15020197Slibs 	f_exit();
15120197Slibs 	_cleanup();
15220197Slibs 	if( nargs() ) errno = err_val;
15320197Slibs 	else errno = -2;   /* prior value will be meaningless,
15420197Slibs 				so set it to undefined value */
15520197Slibs 
15620197Slibs 	if( core_dump ) abort();
15720197Slibs 	else  exit( errno );
1584130Sdlw }
159