From: sewardj Date: Fri, 24 Mar 2000 14:32:03 +0000 (+0000) Subject: [project @ 2000-03-24 14:32:03 by sewardj] X-Git-Tag: Approximately_9120_patches~4906 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=528a7d2cf1c90408d60028bb1fec85124d539476;p=ghc-hetmet.git [project @ 2000-03-24 14:32:03 by sewardj] Reimplement interrupt handling in a way compatible with the revised module chaser, etc. --- diff --git a/ghc/interpreter/compiler.c b/ghc/interpreter/compiler.c index f6e506e..4ab3144 100644 --- a/ghc/interpreter/compiler.c +++ b/ghc/interpreter/compiler.c @@ -11,8 +11,8 @@ * included in the distribution. * * $RCSfile: compiler.c,v $ - * $Revision: 1.24 $ - * $Date: 2000/03/23 14:54:20 $ + * $Revision: 1.25 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -1462,15 +1462,6 @@ static List addGlobals( List binds ) return binds; } -typedef void (*sighandler_t)(int); -void eval_ctrlbrk ( int dunnowhat ) -{ - interruptStgRts(); - /* reinstall the signal handler so that further interrupts which - happen before the thread can return to the scheduler, lead back - here rather than invoking the previous break handler. */ - signal(SIGINT, eval_ctrlbrk); -} Void evalExp ( void ) { /* compile and run input expression */ /* ToDo: this name (and other names generated during pattern match?) @@ -1494,19 +1485,17 @@ Void evalExp ( void ) { /* compile and run input expression */ unless doRevertCAFs below is permanently TRUE. */ /* initScheduler(); */ -#ifdef CRUDE_PROFILING +# ifdef CRUDE_PROFILING cp_init(); -#endif +# endif { HaskellObj result; /* ignored */ - sighandler_t old_ctrlbrk; SchedulerStatus status; Bool doRevertCAFs = TRUE; /* do not change -- comment above */ - old_ctrlbrk = signal(SIGINT, eval_ctrlbrk); - ASSERT(old_ctrlbrk != SIG_ERR); + HugsBreakAction brkOld = setBreakAction ( HugsRtsInterrupt ); status = rts_eval_(closureOfVar(v),10000,&result); - signal(SIGINT,old_ctrlbrk); + setBreakAction ( brkOld ); fflush (stderr); fflush (stdout); switch (status) { diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index ffd736a..3dacc5c 100644 --- a/ghc/interpreter/connect.h +++ b/ghc/interpreter/connect.h @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: connect.h,v $ - * $Revision: 1.32 $ - * $Date: 2000/03/22 18:14:22 $ + * $Revision: 1.33 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- @@ -312,7 +312,6 @@ extern Int whnfInt; /* integer value of term in whnf */ extern Float whnfFloat; /* float value of term in whnf */ extern Long numCells; /* number of cells allocated */ extern Int numGcs; /* number of garbage collections */ -extern Bool broken; /* indicates interrupt received */ extern Bool preludeLoaded; /* TRUE => prelude has been loaded */ extern Bool flagAssert; /* TRUE => assert False causes an assertion failure */ @@ -557,38 +556,31 @@ extern Bool stdcallAllowed ( void ); * Interrupting execution (signals, allowBreak): *-------------------------------------------------------------------------*/ -extern Bool breakOn ( Bool ); -extern Bool broken; /* indicates interrupt received */ +typedef + enum { HugsIgnoreBreak, HugsLongjmpOnBreak, HugsRtsInterrupt } + HugsBreakAction; + +extern HugsBreakAction currentBreakAction; +extern HugsBreakAction setBreakAction ( HugsBreakAction ); + #ifndef SIGBREAK /* Sigh, not defined in cygwin32 beta release 16 */ # define SIGBREAK 21 #endif -/* allowBreak: call to allow user to interrupt computation - * ctrlbrk: set control break handler - */ - -#if HAVE_SIGPROCMASK +/* ctrlbrk: set the interrupt handler. + Hugs relies on being able to do sigprocmask, since some of + the signal handlers do longjmps, and this zaps the previous + signal mask. So setHandler needs to do sigprocmask in order + to get the signal mask to a sane state each time. +*/ #include -#define ctrlbrk(bh) { sigset_t mask; \ - signal(SIGINT,bh); \ - sigemptyset(&mask); \ - sigaddset(&mask, SIGINT); \ - sigprocmask(SIG_UNBLOCK, &mask, NULL); \ - } -#else -# define ctrlbrk(bh) signal(SIGINT,bh) -#endif - -#if SYMANTEC_C -extern int time_release; -extern int allow_break_count; -# define allowBreak() if (time_release !=0 && \ - (++allow_break_count % time_release) == 0) \ - ProcessEvent(); -#else -# define allowBreak() if (broken) { broken=FALSE; sigRaise(breakHandler); } -#endif +#define setHandler(bh) { sigset_t mask; \ + signal(SIGINT,bh); \ + sigemptyset(&mask); \ + sigaddset(&mask, SIGINT); \ + sigprocmask(SIG_UNBLOCK, &mask, NULL); \ + } /*--------------------------------------------------------------------------- diff --git a/ghc/interpreter/errors.h b/ghc/interpreter/errors.h index e77f5c1..63f9325 100644 --- a/ghc/interpreter/errors.h +++ b/ghc/interpreter/errors.h @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: errors.h,v $ - * $Revision: 1.8 $ - * $Date: 2000/03/22 18:14:22 $ + * $Revision: 1.9 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ extern Void internal ( String) HUGS_noreturn; @@ -39,10 +39,6 @@ extern Void errFail_no_longjmp ( Void ); extern Void errAbort ( Void ); extern Cell errAssert ( Int ); -extern sigProto(breakHandler); - -extern Bool breakOn ( Bool ); /* in machdep.c */ - extern Void printExp ( FILE *,Cell ); /* in output.c */ extern Void printType ( FILE *,Cell ); extern Void printContext ( FILE *,List ); diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index d596aa9..c27ec7c 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: hugs.c,v $ - * $Revision: 1.48 $ - * $Date: 2000/03/24 12:36:43 $ + * $Revision: 1.49 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ #include @@ -733,13 +733,56 @@ static Void local changeDir() { /* change directory */ /* -------------------------------------------------------------------------- + * Interrupt handling + * ------------------------------------------------------------------------*/ + +static jmp_buf catch_error; /* jump buffer for error trapping */ + +HugsBreakAction currentBreakAction = HugsIgnoreBreak; + +static void handler_IgnoreBreak ( int sig ) +{ + setHandler ( handler_IgnoreBreak ); +} + +static void handler_LongjmpOnBreak ( int sig ) +{ + setHandler ( handler_LongjmpOnBreak ); + Printf("{Interrupted!}\n"); + longjmp(catch_error,1); +} + +static void handler_RtsInterrupt ( int sig ) +{ + setHandler ( handler_RtsInterrupt ); + interruptStgRts(); +} + +HugsBreakAction setBreakAction ( HugsBreakAction newAction ) +{ + HugsBreakAction tmp = currentBreakAction; + currentBreakAction = newAction; + switch (newAction) { + case HugsIgnoreBreak: + setHandler ( handler_IgnoreBreak ); break; + case HugsLongjmpOnBreak: + setHandler ( handler_LongjmpOnBreak ); break; + case HugsRtsInterrupt: + setHandler ( handler_RtsInterrupt ); break; + default: + internal("setBreakAction"); + } + return tmp; +} + + +/* -------------------------------------------------------------------------- * The new module chaser, loader, etc * ------------------------------------------------------------------------*/ List moduleGraph = NIL; List prelModules = NIL; List targetModules = NIL; -static jmp_buf catch_error; /* jump buffer for error trapping */ static void setCurrentFile ( Module mod ) { @@ -1204,6 +1247,8 @@ static void achieveTargetModules ( void ) volatile Cell grp; volatile List badMods; + setBreakAction ( HugsIgnoreBreak ); + /* First, examine timestamps to find out which modules are out of date with respect to the source/interface/object files. */ @@ -1338,6 +1383,7 @@ static void achieveTargetModules ( void ) if (!varIsMember(textOf(mc),modgList) && !varIsMember(textOf(mc),parsedButNotLoaded)) { + setBreakAction ( HugsLongjmpOnBreak ); if (setjmp(catch_error)==0) { /* try this; it may throw an exception */ mod = parseModuleOrInterface ( @@ -1345,6 +1391,7 @@ static void achieveTargetModules ( void ) } else { /* here's the exception handler, if parsing fails */ /* A parse error (or similar). Clean up and abort. */ + setBreakAction ( HugsIgnoreBreak ); mod = findModule(textOf(mc)); if (nonNull(mod)) nukeModule(mod); for (t = parsedButNotLoaded; nonNull(t); t=tl(t)) { @@ -1355,6 +1402,7 @@ static void achieveTargetModules ( void ) return; /* end of the exception handler */ } + setBreakAction ( HugsIgnoreBreak ); parsedButNotLoaded = cons(mc, parsedButNotLoaded); toChase = dupOnto(module(mod).uses,toChase); @@ -1417,6 +1465,7 @@ static void achieveTargetModules ( void ) if (!varIsMember(textOf(selectArbitrarilyFromGroup(grp)), parsedButNotLoaded)) continue; + setBreakAction ( HugsLongjmpOnBreak ); if (setjmp(catch_error)==0) { /* try this; it may throw an exception */ tryLoadGroup(grp); @@ -1424,6 +1473,7 @@ static void achieveTargetModules ( void ) /* here's the exception handler, if static/typecheck etc fails */ /* nuke the entire rest (ie, the unloaded part) of the module graph */ + setBreakAction ( HugsIgnoreBreak ); badMods = listFromSpecifiedMG ( mg ); for (t = badMods; nonNull(t); t=tl(t)) { mod = findModule(textOf(hd(t))); @@ -1442,12 +1492,13 @@ static void achieveTargetModules ( void ) return; /* end of the exception handler */ } - + setBreakAction ( HugsIgnoreBreak ); } /* Err .. I think that's it. If we get here, we've successfully achieved the target set. Phew! */ + setBreakAction ( HugsIgnoreBreak ); } @@ -1643,6 +1694,7 @@ static Void local evaluator() { /* evaluate expr and print value */ defaultDefns = combined ? stdDefaults : evalDefaults; + setBreakAction ( HugsLongjmpOnBreak ); if (setjmp(catch_error)==0) { /* try this */ parseExp(); @@ -1650,9 +1702,11 @@ static Void local evaluator() { /* evaluate expr and print value */ type = typeCheckExp(TRUE); } else { /* if an exception happens, we arrive here */ + setBreakAction ( HugsIgnoreBreak ); goto cleanup_and_return; } + setBreakAction ( HugsIgnoreBreak ); if (isPolyType(type)) { ks = polySigOf(type); bd = monotypeOf(type); @@ -1707,6 +1761,7 @@ static Void local evaluator() { /* evaluate expr and print value */ #endif cleanup_and_return: + setBreakAction ( HugsIgnoreBreak ); nukeModule(evalMod); setCurrModule(currMod); setCurrentFile(currMod); @@ -2258,8 +2313,9 @@ String argv[]; { Bool prelOK; String s; - breakOn(TRUE); /* enable break trapping */ + setBreakAction ( HugsIgnoreBreak ); modConIds = initialize(argc,argv); /* the initial modules to load */ + setBreakAction ( HugsIgnoreBreak ); prelOK = loadThePrelude(); if (combined) everybody(POSTPREL); @@ -2285,7 +2341,7 @@ String argv[]; { modConIds = NIL; /* initialize calls startupHaskell, which trashes our signal handlers */ - breakOn(TRUE); + setBreakAction ( HugsIgnoreBreak ); forHelp(); for (;;) { @@ -2364,7 +2420,6 @@ String argv[]; { if (autoMain) break; } - breakOn(FALSE); } /* -------------------------------------------------------------------------- @@ -2537,20 +2592,6 @@ String msg; { exit(1); } -sigHandler(breakHandler) { /* respond to break interrupt */ - Hilite(); - Printf("{Interrupted!}\n"); - Lolite(); - breakOn(TRUE); /* reinstall signal handler - redundant on BSD systems */ - /* but essential on POSIX (and other?) systems */ - everybody(BREAK); - failed(); - stopAnyPrinting(); - FlushStdout(); - clearerr(stdin); - longjmp(catch_error,1); - sigResume;/*NOTREACHED*/ -} /* -------------------------------------------------------------------------- * Read value from environment variable or registry: diff --git a/ghc/interpreter/hugsbasictypes.h b/ghc/interpreter/hugsbasictypes.h index d7c7101..a521fea 100644 --- a/ghc/interpreter/hugsbasictypes.h +++ b/ghc/interpreter/hugsbasictypes.h @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: hugsbasictypes.h,v $ - * $Revision: 1.1 $ - * $Date: 2000/03/23 14:54:21 $ + * $Revision: 1.2 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ #define NON_POSIX_SOURCE @@ -165,22 +165,6 @@ extern int stricmp Args((const char *, const char*)); #endif /*--------------------------------------------------------------------------- - * Interrupting execution (signals, allowBreak): - *-------------------------------------------------------------------------*/ - -#if !DOS && VOID_INT_SIGNALS -# define sigProto(nm) void nm ( int ) -# define sigRaise(nm) nm(1) -# define sigHandler(nm) void nm ( sig_arg ) int sig_arg; -# define sigResume return -#else -# define sigProto(nm) int nm ( Void ) -# define sigRaise(nm) nm() -# define sigHandler(nm) int nm ( Void ) -# define sigResume return 1 -#endif - -/*--------------------------------------------------------------------------- * Assertions *-------------------------------------------------------------------------*/ diff --git a/ghc/interpreter/input.c b/ghc/interpreter/input.c index 9d5298d..a21cc2b 100644 --- a/ghc/interpreter/input.c +++ b/ghc/interpreter/input.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: input.c,v $ - * $Revision: 1.23 $ - * $Date: 2000/03/23 14:54:21 $ + * $Revision: 1.24 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -562,7 +562,7 @@ static Void local skip() { /* move forward one char in input */ closeAnyInput(); } else if (reading==KEYBOARD) { - allowBreak(); + /* allowBreak(); */ if (c0=='\n') c1 = EOF; else { @@ -574,7 +574,7 @@ static Void local skip() { /* move forward one char in input */ * fail - returning "-1" to indicate an error. * This is one of the rare cases where "-1" does not mean EOF. */ - if (EOF == c1 && (!feof(stdin) || broken==TRUE)) { + if (EOF == c1 && (!feof(stdin) /* || broken==TRUE */)) { c1 = ' '; } } diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c index cdd1fc4..2ca5102 100644 --- a/ghc/interpreter/machdep.c +++ b/ghc/interpreter/machdep.c @@ -13,8 +13,8 @@ * included in the distribution. * * $RCSfile: machdep.c,v $ - * $Revision: 1.22 $ - * $Date: 2000/03/22 18:14:22 $ + * $Revision: 1.23 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ #ifdef HAVE_SIGNAL_H @@ -1166,63 +1166,7 @@ Int readTerminalChar() { /* read character from terminal */ * Interrupt handling: * ------------------------------------------------------------------------*/ -Bool broken = FALSE; -static Bool breakReqd = FALSE; -static sigProto(ignoreBreak); -static Void local installHandlers ( Void ); - -Bool breakOn(reqd) /* set break trapping on if reqd, */ -Bool reqd; { /* or off otherwise, returning old */ - Bool old = breakReqd; - - breakReqd = reqd; - if (reqd) { - if (broken) { /* repond to break signal received */ - broken = FALSE; /* whilst break trap disabled */ - sigRaise(breakHandler); - /* not reached */ - } -#if HANDLERS_CANT_LONGJMP - ctrlbrk(ignoreBreak); -#else - ctrlbrk(breakHandler); -#endif - } else { - ctrlbrk(ignoreBreak); - } - return old; -} - -static sigHandler(ignoreBreak) { /* record but don't respond to break*/ - ctrlbrk(ignoreBreak); /* reinstall signal handler */ - /* redundant on BSD systems but essential */ - /* on POSIX and other systems */ - broken = TRUE; - interruptStgRts(); - sigResume; -} - -#if !DONT_PANIC -static sigProto(panic); -static sigHandler(panic) { /* exit in a panic, on receipt of */ - everybody(EXIT); /* an unexpected signal */ - fprintf(stderr,"\nUnexpected signal\n"); - exit(1); - sigResume;/*NOTREACHED*/ -} -#endif /* !DONT_PANIC */ - -#if IS_WIN32 -BOOL WINAPI consoleHandler(DWORD dwCtrlType) { - switch (dwCtrlType) { /* Allows Hugs to be terminated */ - case CTRL_CLOSE_EVENT : /* from the window's close menu. */ - ExitProcess(0); - } - return FALSE; -} -#endif - -static Void local installHandlers() { /* Install handlers for all fatal */ +static Void installHandlers ( void ) { /* Install handlers for all fatal */ /* signals except SIGINT and SIGBREAK*/ #if IS_WIN32 SetConsoleCtrlHandler(consoleHandler,TRUE); diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 94a844d..c1497a6 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: storage.c,v $ - * $Revision: 1.54 $ - * $Date: 2000/03/24 12:36:43 $ + * $Revision: 1.55 $ + * $Date: 2000/03/24 14:32:03 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -1993,12 +1993,14 @@ Cell n; { /* it was a cell ref, but don't */ } Void garbageCollect() { /* Run garbage collector ... */ - Bool breakStat = breakOn(FALSE); /* disable break checking */ + /* disable break checking */ Int i,j; register Int mask; register Int place; Int recovered; jmp_buf regs; /* save registers on stack */ + HugsBreakAction oldBrk + = setBreakAction ( HugsIgnoreBreak ); fprintf ( stderr, "wa-hey! garbage collection! too difficult! bye!\n" ); exit(0); setjmp(regs); @@ -2032,7 +2034,7 @@ exit(0); } gcRecovered(recovered); - breakOn(breakStat); /* restore break trapping if nec. */ + setBreakAction ( oldBrk ); everybody(GCDONE);