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