Commit | Line | Data |
---|---|---|
dd27c76e | 1 | /* STARTUP PROCEDURE FOR UNIX FORTRAN PROGRAMS */ |
51c60894 | 2 | char id_libF77[] = "@(#)main.c 2.17 %G%"; |
dd27c76e DW |
3 | |
4 | #include <stdio.h> | |
5 | #include <signal.h> | |
d2397273 | 6 | #include "../libI77/fiodefs.h" |
dd27c76e | 7 | |
d1485af3 DL |
8 | extern int errno; |
9 | char *getenv(); | |
d1485af3 | 10 | |
dd27c76e DW |
11 | int xargc; |
12 | char **xargv; | |
13 | ||
14 | main(argc, argv, arge) | |
15 | int argc; | |
16 | char **argv; | |
17 | char **arge; | |
18 | { | |
be7a6737 | 19 | int sigdie(); |
dd27c76e | 20 | long int (*sigf)(); |
66aca6b3 | 21 | int signum; |
dd27c76e DW |
22 | |
23 | xargc = argc; | |
24 | xargv = argv; | |
66aca6b3 DW |
25 | |
26 | for (signum=1; signum<=16; signum++) | |
27 | { | |
28 | if((sigf=signal(signum, sigdie)) != SIG_DFL) signal(signum, sigf); | |
29 | } | |
dd27c76e DW |
30 | |
31 | #ifdef pdp11 | |
32 | ldfps(01200); /* detect overflow as an exception */ | |
33 | #endif | |
34 | ||
35 | f_init(); | |
6e1c8476 | 36 | MAIN_(); |
dd27c76e | 37 | f_exit(); |
d1485af3 | 38 | return 0; |
dd27c76e DW |
39 | } |
40 | ||
be7a6737 DW |
41 | struct action { |
42 | char *mesg; | |
43 | int core; | |
44 | } sig_act[16] = { | |
66aca6b3 | 45 | {"Hangup", 0}, /* SIGHUP */ |
be7a6737 DW |
46 | {"Interrupt!", 0}, /* SIGINT */ |
47 | {"Quit!", 1}, /* SIGQUIT */ | |
f81417e8 | 48 | {"Illegal ", 1}, /* SIGILL */ |
66aca6b3 | 49 | {"Trace Trap", 1}, /* SIGTRAP */ |
be7a6737 | 50 | {"IOT Trap", 1}, /* SIGIOT */ |
e0eb2f2c | 51 | {"EMT Trap", 1}, /* SIGEMT */ |
eb5713ad | 52 | {"Arithmetic Exception", 1}, /* SIGFPE */ |
be7a6737 DW |
53 | { 0, 0}, /* SIGKILL */ |
54 | {"Bus error", 1}, /* SIGBUS */ | |
55 | {"Segmentation violation", 1}, /* SIGSEGV */ | |
66aca6b3 DW |
56 | {"Sys arg", 1}, /* SIGSYS */ |
57 | {"Open pipe", 0}, /* SIGPIPE */ | |
58 | {"Alarm", 0}, /* SIGALRM */ | |
be7a6737 | 59 | {"Terminated", 0}, /* SIGTERM */ |
66aca6b3 | 60 | {"Sig 16", 0}, /* unassigned */ |
be7a6737 DW |
61 | }; |
62 | ||
eb5713ad DW |
63 | struct action act_fpe[] = { |
64 | {"Integer overflow", 1}, | |
65 | {"Integer divide by 0", 1}, | |
7ba43308 DW |
66 | {"Floating point overflow trap", 1}, |
67 | {"Floating divide by zero trap", 1}, | |
68 | {"Floating point underflow trap", 1}, | |
eb5713ad DW |
69 | {"Decimal overflow", 1}, |
70 | {"Subscript range", 1}, | |
71 | {"Floating point overflow", 0}, | |
72 | {"Floating divide by zero", 0}, | |
73 | {"Floating point underflow", 0}, | |
74 | }; | |
f81417e8 DW |
75 | |
76 | struct action act_ill[] = { | |
77 | {"addr mode", 1}, | |
78 | {"instruction", 1}, | |
79 | {"operand", 0}, | |
80 | }; | |
be7a6737 | 81 | |
fc66b163 DW |
82 | #if vax |
83 | sigdie(s, t, sc) | |
84 | int s; int t; struct sigcontext *sc; | |
85 | ||
86 | #else pdp11 | |
eb5713ad DW |
87 | sigdie(s, t, pc) |
88 | int s; int t; long pc; | |
fc66b163 DW |
89 | |
90 | #endif | |
dd27c76e | 91 | { |
d2397273 | 92 | extern unit units[]; |
be7a6737 | 93 | register struct action *act = &sig_act[s-1]; |
2913b66e DW |
94 | /* print error message, then flush buffers */ |
95 | ||
04e8957b DW |
96 | if (s == SIGHUP || s == SIGINT || s == SIGQUIT) |
97 | signal(s, SIG_IGN); /* don't allow it again */ | |
98 | else | |
99 | signal(s, SIG_DFL); /* shouldn't happen again, but ... */ | |
100 | ||
eb5713ad DW |
101 | if (act->mesg) |
102 | { | |
511b0121 | 103 | fprintf(units[STDERR].ufd, "*** %s", act->mesg); |
eb5713ad | 104 | if (s == SIGFPE) |
66aca6b3 DW |
105 | { |
106 | if (t >= 1 && t <= 10) | |
107 | fprintf(units[STDERR].ufd, ": %s", act_fpe[t-1].mesg); | |
108 | else | |
109 | fprintf(units[STDERR].ufd, ": Type=%d?", t); | |
110 | } | |
111 | else if (s == SIGILL) | |
f81417e8 DW |
112 | { |
113 | if (t == 4) t = 2; /* 4.0bsd botch */ | |
114 | if (t >= 0 && t <= 2) | |
115 | fprintf(units[STDERR].ufd, "%s", act_ill[t].mesg); | |
116 | else | |
117 | fprintf(units[STDERR].ufd, "compat mode: Code=%d", t); | |
118 | } | |
66aca6b3 | 119 | putc('\n', units[STDERR].ufd); |
eb5713ad | 120 | } |
d1485af3 DL |
121 | f77_abort( s, act->core ); |
122 | } | |
123 | ||
51c60894 | 124 | extern int _dbsubc; /* dbsubc is non-zero if -lg was specified to ld */ |
d1485af3 DL |
125 | f77_abort( err_val, act_core ) |
126 | { | |
127 | char first_char, *env_var; | |
128 | int core_dump; | |
129 | ||
130 | env_var = getenv("f77_dump_flag"); | |
131 | first_char = (env_var == NULL) ? 0 : *env_var; | |
dd27c76e | 132 | |
eb5713ad | 133 | signal(SIGILL, SIG_DFL); |
d1485af3 DL |
134 | sigsetmask(0); /* don't block */ |
135 | ||
51c60894 DL |
136 | /* see if we want a core dump: |
137 | first line checks for signals like hangup - don't dump then. | |
138 | second line checks if -lg specified to ld (e.g. by saying | |
139 | -g to f77) and checks the f77_dump_flag var. */ | |
d1485af3 | 140 | core_dump = ((nargs() != 2) || act_core) && |
51c60894 | 141 | ( (_dbsubc && (first_char != 'n')) || first_char == 'y'); |
d1485af3 DL |
142 | |
143 | if( !core_dump ) | |
144 | fprintf(units[STDERR].ufd,"*** Execution terminated\n"); | |
145 | ||
146 | f_exit(); | |
147 | _cleanup(); | |
148 | if( nargs() ) errno = err_val; | |
149 | else errno = -2; /* prior value will be meaningless, | |
150 | so set it to undefined value */ | |
151 | ||
152 | if( core_dump ) abort(); | |
153 | else exit( errno ); | |
dd27c76e | 154 | } |