summaryrefslogtreecommitdiffstats
path: root/sys.c
diff options
context:
space:
mode:
Diffstat (limited to 'sys.c')
-rw-r--r--sys.c70
1 files changed, 47 insertions, 23 deletions
diff --git a/sys.c b/sys.c
index 0a9615b..9767fe0 100644
--- a/sys.c
+++ b/sys.c
@@ -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 */