From: sewardj Date: Wed, 5 Apr 2000 16:57:18 +0000 (+0000) Subject: [project @ 2000-04-05 16:57:18 by sewardj] X-Git-Tag: Approximately_9120_patches~4806 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6ceb8c2af6e6e844f7a0fbe513d5f25ff2b3fee4;p=ghc-hetmet.git [project @ 2000-04-05 16:57:18 by sewardj] Clean up the storage manager a little, and reinstate the compile time garbage collector. Then pray. --- diff --git a/ghc/includes/options.h b/ghc/includes/options.h index ff63fd4..aca0b1e 100644 --- a/ghc/includes/options.h +++ b/ghc/includes/options.h @@ -7,8 +7,8 @@ * Hugs version 1.4, December 1997 * * $RCSfile: options.h,v $ - * $Revision: 1.24 $ - * $Date: 2000/03/22 18:17:12 $ + * $Revision: 1.25 $ + * $Date: 2000/04/05 16:57:18 $ * ------------------------------------------------------------------------*/ @@ -95,13 +95,14 @@ #define MINIMUMHEAP 19000 #define MAXIMUMHEAP 0 -#define DEFAULTHEAP 1000000 /*350000*/ +#define DEFAULTHEAP 320000 #define TEXT_SIZE 100000 #define NUM_TEXTH 10 #define NUM_TYVARS 4000 #define NUM_STACK 16000 #define NUM_DTUPLES 5 +#define NUM_MSTACK 2000 #define MAXPOSINT 0x7fffffff #define MINNEGINT (-MAXPOSINT-1) diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index b772f0b..461b253 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.59 $ - * $Date: 2000/04/05 14:13:58 $ + * $Revision: 1.60 $ + * $Date: 2000/04/05 16:57:18 $ * ------------------------------------------------------------------------*/ #include @@ -244,12 +244,17 @@ String argv[]; { # endif /* Find out early on if we're in combined mode or not. - everybody(PREPREL) needs to know this. + everybody(PREPREL) needs to know this. Also, establish the + heap size; */ for (i=1; i < argc; ++i) { if (strcmp(argv[i], "--")==0) break; if (strcmp(argv[i], "-c")==0) combined = FALSE; if (strcmp(argv[i], "+c")==0) combined = TRUE; + + if (strncmp(argv[i],"+h",2)==0 || + strncmp(argv[i],"-h",2)==0) + setHeapSize(&(argv[i][2])); } everybody(PREPREL); @@ -497,7 +502,8 @@ String s; { /* return FALSE if none found. */ return TRUE; #endif - case 'h' : setHeapSize(s+1); + case 'h' : /* don't do anything, since pre-scan of args + will have got it already */ return TRUE; case 'c' : /* don't do anything, since pre-scan of args @@ -1220,8 +1226,12 @@ static void tryLoadGroup ( Cell grp ) assert(nonNull(m)); if (module(m).mode == FM_SOURCE) { processModule ( m ); + module(m).tree = NIL; } else { processInterfaces ( singleton(snd(grp)) ); + m = findModule(textOf(snd(grp))); + assert(nonNull(m)); + module(m).tree = NIL; } break; case GRP_REC: @@ -1235,6 +1245,11 @@ static void tryLoadGroup ( Cell grp ) } } processInterfaces ( snd(grp) ); + for (t = snd(grp); nonNull(t); t=tl(t)) { + m = findModule(textOf(hd(t))); + assert(nonNull(m)); + module(m).tree = NIL; + } break; default: internal("tryLoadGroup"); diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c index 2e5f161..5884cb1 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.26 $ - * $Date: 2000/04/04 15:41:56 $ + * $Revision: 1.27 $ + * $Date: 2000/04/05 16:57:18 $ * ------------------------------------------------------------------------*/ #ifdef HAVE_SIGNAL_H @@ -936,7 +936,7 @@ Void gcCStack() { /* Garbage collect elements off */ fatal("gcCStack"); #endif -#define Blargh markWithoutMove(*ptr); +#define Blargh mark(*ptr); #if 0 markWithoutMove((*ptr)/sizeof(Cell)); \ markWithoutMove(( (void*)(*ptr)-(void*)heapTopFst)/sizeof(Cell)); \ diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index 2c1caa8..cdb519b 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.62 $ - * $Date: 2000/04/05 10:25:08 $ + * $Revision: 1.63 $ + * $Date: 2000/04/05 16:57:18 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -469,6 +469,13 @@ Text t; { * tycon, class, instance and module tables. Also, potentially, TREX Exts. * ------------------------------------------------------------------------*/ +#ifdef DEBUG_STORAGE_EXTRA +static Bool debugStorageExtra = TRUE; +#else +static Bool debugStorageExtra = FALSE; +#endif + + #define EXPANDABLE_SYMBOL_TABLE(type_name,struct_name, \ proc_name,free_proc_name, \ free_list,tab_name,tab_size,err_msg, \ @@ -484,9 +491,11 @@ Text t; { assert(TAB_BASE_ADDR <= n); \ assert(n < TAB_BASE_ADDR+tab_size); \ assert(tab_name[n-TAB_BASE_ADDR].inUse); \ - tab_name[n-TAB_BASE_ADDR].inUse = FALSE; \ - /*tab_name[n-TAB_BASE_ADDR].nextFree = free_list; */ \ - /*free_list = n;*/ \ + tab_name[n-TAB_BASE_ADDR].inUse = FALSE; \ + if (!debugStorageExtra) { \ + tab_name[n-TAB_BASE_ADDR].nextFree = free_list; \ + free_list = n; \ + } \ } \ \ type_name proc_name ( void ) \ @@ -514,8 +523,9 @@ Text t; { newTab[i].inUse = FALSE; \ newTab[i].nextFree = i-1+TAB_BASE_ADDR; \ } \ - /* fprintf(stderr, "Expanding " #type_name \ - "table to size %d\n", newSz );*/ \ + if (debugStorageExtra) \ + fprintf(stderr, "Expanding " #type_name \ + "table to size %d\n", newSz ); \ newTab[tab_size].nextFree = TAB_BASE_ADDR-1; \ free_list = newSz-1+TAB_BASE_ADDR; \ tab_size = newSz; \ @@ -613,7 +623,8 @@ struct strModule* generate_module_ref ( Cell mo ) * ------------------------------------------------------------------------*/ #define TYCONHSZ 256 /* Size of Tycon hash table*/ - //#define tHash(x) (((x)-TEXT_BASE_ADDR)%TYCONHSZ)/* Tycon hash function */ +static Tycon tyconHash[TYCONHSZ]; /* Hash table storage */ + static int tHash(Text x) { int r; @@ -625,12 +636,13 @@ static int tHash(Text x) assert(r= 0 && x < TYCONHSZ); return x; } + Tycon newTycon ( Text t ) /* add new tycon to tycon table */ { Int h = tHash(t); @@ -656,7 +668,7 @@ Tycon newTycon ( Text t ) /* add new tycon to tycon table */ Tycon findTycon(t) /* locate Tycon in tycon table */ Text t; { Tycon tc = tyconHash[RC_T(tHash(t))]; -assert(isTycon(tc) || isTuple(tc) || isNull(tc)); + assert(isTycon(tc) || isTuple(tc) || isNull(tc)); while (nonNull(tc) && tycon(tc).text!=t) tc = tycon(tc).nextTyconHash; return tc; @@ -814,7 +826,8 @@ Tycon mkTuple ( Int n ) * ------------------------------------------------------------------------*/ #define NAMEHSZ 256 /* Size of Name hash table */ -//#define nHash(x) (((x)-TEXT_BASE_ADDR)%NAMEHSZ) /* hash fn :: Text->Int */ +static Name nameHash[NAMEHSZ]; /* Hash table storage */ + static int nHash(Text x) { assert(isText(x) || inventedText(x)); @@ -822,12 +835,13 @@ static int nHash(Text x) if (x < 0) x = -x; return x%NAMEHSZ; } -static Name nameHash[NAMEHSZ]; /* Hash table storage */ + int RC_N ( int x ) { assert (x >= 0 && x < NAMEHSZ); return x; } + void hashSanity ( void ) { Int i, j; @@ -875,8 +889,8 @@ Name newName ( Text t, Cell parent ) /* Add new name to name table */ Name findName(t) /* Locate name in name table */ Text t; { Name n = nameHash[RC_N(nHash(t))]; -assert(isText(t)); -assert(isName(n) || isNull(n)); + assert(isText(t) || isInventedVar(t) || isInventedDictVar(t)); + assert(isName(n) || isNull(n)); while (nonNull(n) && name(n).text!=t) n = name(n).nextNameHash; return n; @@ -1844,12 +1858,8 @@ OSectionKind lookupSection ( void* ad ) Int heapSize = DEFAULTHEAP; /* number of cells in heap */ Heap heapFst; /* array of fst component of pairs */ Heap heapSnd; /* array of snd component of pairs */ -#ifndef GLOBALfst Heap heapTopFst; -#endif -#ifndef GLOBALsnd Heap heapTopSnd; -#endif Bool consGC = TRUE; /* Set to FALSE to turn off gc from*/ /* C stack; use with extreme care! */ Long numCells; @@ -1902,7 +1912,6 @@ static Int markCount, stackRoots; Cell pair(l,r) /* Allocate pair (l, r) from */ Cell l, r; { /* heap, garbage collecting first */ Cell c = freeList; /* if necessary ... */ - if (isNull(c)) { lsave = l; rsave = r; @@ -1923,77 +1932,40 @@ Cell l, r; { /* heap, garbage collecting first */ static Int *marks; static Int marksSize; -Cell markExpr(c) /* External interface to markCell */ -Cell c; { - return isGenPair(c) ? markCell(c) : c; -} - -static Cell local markCell(c) /* Traverse part of graph marking */ -Cell c; { /* cells reachable from given root */ - /* markCell(c) is only called if c */ - /* is a pair */ - { register int place = placeInSet(c); - register int mask = maskInSet(c); - if (marks[place]&mask) - return c; - else { - marks[place] |= mask; - recordMark(); - } - } - - /* STACK_CHECK: Avoid stack overflows during recursive marking. */ - if (isGenPair(fst(c))) { - STACK_CHECK - fst(c) = markCell(fst(c)); - markSnd(c); - } - else if (isNull(fst(c)) || isTagPtr(fst(c))) { - STACK_CHECK - markSnd(c); - } - - return c; -} - -static Void local markSnd(c) /* Variant of markCell used to */ -Cell c; { /* update snd component of cell */ - Cell t; /* using tail recursion */ +void mark ( Cell root ) +{ + Cell c; + Cell mstack[NUM_MSTACK]; + Int msp = -1; + Int msp_max = -1; -ma: t = c; /* Keep pointer to original pair */ - c = snd(c); - if (!isPair(c)) - return; + mstack[++msp] = root; - { register int place = placeInSet(c); - register int mask = maskInSet(c); - if (marks[place]&mask) - return; - else { + while (msp >= 0) { + if (msp > msp_max) msp_max = msp; + c = mstack[msp--]; + if (!isGenPair(c)) continue; + if (fst(c)==FREECELL) continue; + { + register int place = placeInSet(c); + register int mask = maskInSet(c); + if (!(marks[place]&mask)) { marks[place] |= mask; - recordMark(); - } - } - - if (isGenPair(fst(c))) { - fst(c) = markCell(fst(c)); - goto ma; - } - else if (isNull(fst(c)) || isTagPtr(fst(c))) - goto ma; - return; -} - -Void markWithoutMove(n) /* Garbage collect cell at n, as if*/ -Cell n; { /* it was a cell ref, but don't */ - /* move cell so we don't have */ - /* to modify the stored value of n */ - if (isGenPair(n)) { - recordStackRoot(); - markCell(n); - } + if (msp >= NUM_MSTACK-5) { + fprintf ( stderr, + "hugs: fatal stack overflow during GC. " + "Increase NUM_MSTACK.\n" ); + exit(9); + } + mstack[++msp] = fst(c); + mstack[++msp] = snd(c); + } + } + } + // fprintf(stderr, "%d ",msp_max); } + Void garbageCollect() { /* Run garbage collector ... */ /* disable break checking */ Int i,j; @@ -2003,11 +1975,11 @@ Void garbageCollect() { /* Run garbage collector ... */ 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); gcStarted(); + for (i=0; i