diff options
Diffstat (limited to 'sys.c')
| -rw-r--r-- | sys.c | 70 |
1 files changed, 47 insertions, 23 deletions
@@ -1,4 +1,4 @@ -/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. +/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -68,7 +68,7 @@ void igc P((char *what, STACKITEM *stackbase)); char *mktemp P((char *template)); #endif -static void gc_sweep P((void)); +static void gc_sweep P((int contin_bad)); char s_nogrow[] = "could not grow", s_heap[] = "heap", s_hplims[] = "hplims"; @@ -141,8 +141,8 @@ SCM open_file(filename, modes) SETSTREAM(port, f); if (BUF0 & (CAR(port) = tc16_fport | mode_bits(CHARS(modes)))) i_setbuf0(port); - ALLOW_INTS; } + ALLOW_INTS; return port; } @@ -565,9 +565,9 @@ void add_final(final) return; } -char s_obunhash[] = "object-unhash"; +char s_obunhash[] = "object-unhash", s_gc[] = "gc"; static iproc subr0s[] = { - {"gc", gc}, + {s_gc, gc}, {"tmpnam", ltmpnam}, {0, 0}}; @@ -883,7 +883,7 @@ void dowinds(to, delta) } } -/* Remember that setjmp needs to be called after scm_make_cont */ +/* Remember that setjump needs to be called after scm_make_cont */ SCM scm_make_cont() { @@ -951,10 +951,13 @@ SCM obunhash(obj) #endif ASSERT(INUMP(obj), obj, ARG1, s_obunhash); obj = SRS(obj, 1) & ~1L; - comm: +comm: if IMP(obj) return obj; if NCELLP(obj) return BOOL_F; - { /* code is adapted from mark_locations */ + { + /* This code is adapted from mark_locations() in "sys.c" and + scm_cell_p() in "rope.c", which means that changes to these + routines must be coordinated. */ register CELLPTR ptr = (CELLPTR)SCM2PTR(obj); register sizet i = 0, j = hplim_ind; do { @@ -1295,7 +1298,7 @@ SCM gc_for_newcell() } static char s_bad_type[] = "unknown type in "; -jmp_buf save_regs_gc_mark; +jump_buf save_regs_gc_mark; void mark_locations P((STACKITEM x[], sizet n)); static void mark_syms P((SCM v)); static void mark_sym_values P((SCM v)); @@ -1315,7 +1318,8 @@ void igc(what, stackbase) int j = num_protects; long oheap_size = heap_size; gc_start(what); - ++errjmp_bad; + if (++errjmp_bad > 1) + wta(MAKINUM(errjmp_bad), "gc called from within ", s_gc); /* By marking symhash first, we provide the best immunity from accidental references. In order to accidentally protect a symbol, a pointer will have to point directly at the symbol (as @@ -1329,8 +1333,8 @@ void igc(what, stackbase) #endif if (stackbase) { FLUSH_REGISTER_WINDOWS; - /* This assumes that all registers are saved into the jmp_buf */ - setjmp(save_regs_gc_mark); + /* This assumes that all registers are saved into the jump_buf */ + setjump(save_regs_gc_mark); mark_locations((STACKITEM *) save_regs_gc_mark, (sizet) (sizeof(STACKITEM) - 1 + sizeof save_regs_gc_mark) / sizeof(STACKITEM)); @@ -1354,9 +1358,10 @@ void igc(what, stackbase) #endif } } - while(j--) gc_mark(sys_protects[j]); + while(j--) + gc_mark(sys_protects[j]); sweep_symhash(symhash); - gc_sweep(); + gc_sweep(!stackbase); --errjmp_bad; gc_end(); if (oheap_size != heap_size) { @@ -1376,7 +1381,7 @@ void free_storage() gc_mark(def_inp); /* don't want to close stdin */ gc_mark(def_outp); /* don't want to close stdout */ gc_mark(def_errp); /* don't want to close stderr */ - gc_sweep(); + gc_sweep(0); rootcont = BOOL_F; while (hplim_ind) { /* free heap segments */ hplim_ind -= 2; @@ -1507,6 +1512,12 @@ void gc_mark(p) } } +/* mark_locations() marks a location pointed to by x[0:n] only if + `x[m]' is cell-aligned and points into a valid heap segment. This + code is duplicated by obunhash() in "sys.c" and scm_cell_p() in + "rope.c", which means that changes to these routines must be + coordinated. */ + void mark_locations(x, n) STACKITEM x[]; sizet n; @@ -1532,7 +1543,8 @@ void mark_locations(x, n) #define HUGE_LENGTH(x) (LENGTH_MAX==LENGTH(x) ? *((long *)VELTS(x)) : LENGTH(x)) -static void gc_sweep() +static void gc_sweep(contin_bad) + int contin_bad; { register CELLPTR ptr; #ifdef POINTERS_MUNGED @@ -1599,10 +1611,17 @@ static void gc_sweep() m += LENGTH(scmptr)+1; goto freechars; case tc7_contin: - if GC8MARKP(scmptr) goto c8mrkcontinue; + if GC8MARKP(scmptr) { + if (contin_bad && CONT(scmptr)->length) { + warn("uncollected ", (char *)0); + iprin1(scmptr, cur_errp, 1); + lputc('\n', cur_errp); + lfflush(cur_errp); + } + goto c8mrkcontinue; + } m += LENGTH(scmptr)*sizeof(STACKITEM) + sizeof(CONTINUATION); -/* free_continuation(CONT(scmptr)); */ - goto freechars; + free_continuation(CONT(scmptr)); break; /* goto freechars; */ case tc7_ssymbol: if GC8MARKP(scmptr) goto c8mrkcontinue; /* Do not free storage because tc7_ssymbol means scmptr's @@ -1708,15 +1727,18 @@ static void mark_syms(v) /* If this bucket has already been marked, then something is wrong. */ ASSERT(!GCMARKP(al), al, s_bad_type, s_gc_sym); x = CAR(al); - SETGCMARK(al); + SETGCMARK(al); /* Do mark bucket list */ ASSERT(!GCMARKP(x), x, s_bad_type, s_gc_sym); if (UNDEFINED==CDR(x) && tc7_msymbol==TYP7(CAR(x))) goto used; /* Don't mark symbol. */ SETGC8MARK(CAR(x)); used: - SETGCMARK(x); /* Do mark value cell. */ + /* SETGCMARK(x) */; /* Don't mark value cell. */ + /* We used to mark the value cell, but value cells get returned + by calls to intern(). This caused a rare GC leak which only + showed up in large programs. */ } - SETGC8MARK(v); /* Mark bucket list. */ + SETGC8MARK(v); /* Mark bucket vector. */ } /* mark_symhash marks the values of hash table V. */ @@ -1744,8 +1766,10 @@ static void sweep_symhash(v) lloc = &(VELTS(v)[k]); while NIMP(al = (*lloc & ~1L)) { x = CAR(al); - if GC8MARKP(CAR(x)) + if GC8MARKP(CAR(x)) { lloc = &(CDR(al)); + SETGCMARK(x); + } else { *lloc = CDR(al); CLRGCMARK(al); /* bucket pair to be collected by gc_sweep */ |