diff options
Diffstat (limited to 'ghc/interpreter')
| -rw-r--r-- | ghc/interpreter/compiler.c | 26 | ||||
| -rw-r--r-- | ghc/interpreter/storage.c | 21 | ||||
| -rw-r--r-- | ghc/interpreter/storage.h | 6 |
3 files changed, 44 insertions, 9 deletions
diff --git a/ghc/interpreter/compiler.c b/ghc/interpreter/compiler.c index ac85831778..c6b1cce8f0 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.26 $ - * $Date: 2000/04/06 14:23:55 $ + * $Revision: 1.27 $ + * $Date: 2000/04/11 16:36:53 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -1490,6 +1490,27 @@ Void evalExp ( void ) { /* compile and run input expression */ unless doRevertCAFs below is permanently TRUE. */ /* initScheduler(); */ + + /* Further comments, JRS 000411. + When control returns to Hugs, you have to be pretty careful about + the state of the heap. In particular, hugs.c may subsequently call + nukeModule() in storage.c, which removes modules from the system. + If a module defines a particular data constructor, the relevant + info table is also free()d. That gives a problem if there are + still closures hanging round in the heap with references to that + info table. + + The solution is to firstly to revert CAFs, and then force a major + collection in between transitions from the mutation, ie actually + running Haskell, and nukeModule. Since major GCs are potentially + expensive, we don't want to do one at every call to nukeModule, + so the flag nukeModule_needs_major_gc is used to signal when one + is needed. + + This all also seems to imply that doRevertCAFs should always + be TRUE. + */ + # ifdef CRUDE_PROFILING cp_init(); # endif @@ -1499,6 +1520,7 @@ Void evalExp ( void ) { /* compile and run input expression */ SchedulerStatus status; Bool doRevertCAFs = TRUE; /* do not change -- comment above */ HugsBreakAction brkOld = setBreakAction ( HugsRtsInterrupt ); + nukeModule_needs_major_gc = TRUE; status = rts_eval_(closureOfVar(v),10000,&result); setBreakAction ( brkOld ); fflush (stderr); diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 401168f0c7..95627f4912 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.68 $ - * $Date: 2000/04/07 16:25:19 $ + * $Revision: 1.69 $ + * $Date: 2000/04/11 16:36:53 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -19,6 +19,7 @@ #include "errors.h" #include "object.h" #include <setjmp.h> +#include "Stg.h" /*#define DEBUG_SHOWUSE*/ @@ -1628,13 +1629,25 @@ Module newModule ( Text t ) /* add new module to module table */ return mod; } + +Bool nukeModule_needs_major_gc = TRUE; + void nukeModule ( Module m ) { ObjectCode* oc; ObjectCode* oc2; Int i; -assert(isModule(m)); -/*fprintf(stderr, "NUKEMODULE `%s'\n", textToStr(module(m).text)); */ + + if (!isModule(m)) internal("nukeModule"); + + /* see comment in compiler.c about this, + and interaction with info tables */ + if (nukeModule_needs_major_gc) { + /* fprintf ( stderr, "doing major GC in nukeModule\n"); */ + performMajorGC(); + nukeModule_needs_major_gc = FALSE; + } + oc = module(m).object; while (oc) { oc2 = oc->next; diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h index 4949a40d0d..881d2730ce 100644 --- a/ghc/interpreter/storage.h +++ b/ghc/interpreter/storage.h @@ -10,8 +10,8 @@ * included in the distribution. * * $RCSfile: storage.h,v $ - * $Revision: 1.42 $ - * $Date: 2000/04/07 16:25:20 $ + * $Revision: 1.43 $ + * $Date: 2000/04/11 16:36:53 $ * ------------------------------------------------------------------------*/ #define DEBUG_STORAGE /* a moderate level of sanity checking */ @@ -619,7 +619,7 @@ extern Module currentModule; /* Module currently being processed */ extern List moduleGraph; /* :: [GRP_REC | GRP_NONREC] */ extern List prelModules; /* :: [CONID] */ extern List targetModules; /* :: [CONID] */ - +extern Bool nukeModule_needs_major_gc; /* see comment in compiler.c */ extern Bool isValidModule ( Module ); extern Module newModule ( Text ); |