diff --git a/ldb/gc.c b/ldb/gc.c index 9137a4a1d62fea0c00353e3878e578fb2b229bdd..d8a4da8e171df00a0e665192fb131b1f6bdd07ae 100644 --- a/ldb/gc.c +++ b/ldb/gc.c @@ -1,7 +1,7 @@ /* * Stop and Copy GC based on Cheney's algorithm. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.22 1990/12/18 00:59:59 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.23 1990/12/18 23:26:27 wlott Exp $ * * Written by Christopher Hoover. */ @@ -368,26 +368,14 @@ long nwords; static scavenge_newspace() { - lispobj *here; + lispobj *here, *next; - here = new_space; - while (here < new_space_free_pointer) { - lispobj object; - int type, words_scavenged; - - object = *here; - type = TypeOf(object); - -#if defined(DEBUG_SCAVENGE_VERBOSE) - printf("Scavenging object at 0x%08x, object = 0x%08x, type = %d\n", - (unsigned long) here, (unsigned long) object, type); -#endif - - words_scavenged = (scavtab[type])(here, object); - - here += words_scavenged; - } - gc_assert(here == new_space_free_pointer); + here = new_space; + while (here < new_space_free_pointer) { + next = new_space_free_pointer; + scavenge(here, next - here); + here = next; + } } @@ -892,13 +880,19 @@ static scav_structure_pointer(where, object) lispobj *where, object; { - if (from_space_p(object)) { - /* ### I don't know how to transport these! */ + if (from_space_p(object)) { + lispobj first, *first_pointer; - fprintf(stderr, "GC lossage. Cannot scavenge structure pointer in from space!\n"); - gc_lose(); - } else - return 1; + /* object is a pointer into from space. check to see */ + /* if it has been forwarded */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; + + if (!(Pointerp(first) && new_space_p(first))) + first = *first_pointer = trans_boxed(object); + *where = first; + } + return 1; } diff --git a/ldb/print.c b/ldb/print.c index 1071129c1100562a725a3d44f637a08292bebb29..dadf98ff2cb2c91159305e03ca892f1e2e94c837 100644 --- a/ldb/print.c +++ b/ldb/print.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/print.c,v 1.14 1990/11/08 22:46:22 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/print.c,v 1.15 1990/12/18 23:25:34 wlott Exp $ */ #include <stdio.h> #include "ldb.h" @@ -269,13 +269,23 @@ lispobj obj; static void brief_struct(obj) lispobj obj; { - printf("structure"); + printf("#<ptr to "); + print_obj(NULL, ((struct structure *)PTR(obj))->slots[0]); + printf(" structure>"); } static void print_struct(obj) lispobj obj; { - printf("Structure mumble mumble."); + struct structure *structure = (struct structure *)PTR(obj); + int i; + char buffer[16]; + + print_obj("type: ", structure->slots[0]); + for (i = 1; i < HeaderValue(structure->header); i++) { + sprintf(buffer, "slot %d: ", i); + print_obj(buffer, structure->slots[i]); + } } static void brief_otherptr(obj) diff --git a/ldb/purify.c b/ldb/purify.c index ad3a8fc6e70af336816919a382411cf613182c34..fb6f7c88464eae7d03aa56e0734d53601f9928d7 100644 --- a/ldb/purify.c +++ b/ldb/purify.c @@ -1,6 +1,6 @@ /* Purify. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/purify.c,v 1.10 1990/12/01 22:50:38 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/purify.c,v 1.11 1990/12/18 23:26:42 wlott Exp $ */ #include <mach.h> @@ -397,15 +397,6 @@ static lispobj ptrans_list(thing, constant) return ((lispobj)orig) | type_ListPointer; } -static lispobj ptrans_struct(thing, header, constant) - lispobj thing, header; - boolean constant; -{ - /* Shouldn't be any structures in dynamic space. */ - gc_abort(); - return NIL; -} - static lispobj ptrans_otherptr(thing, header, constant) lispobj thing, header; boolean constant; @@ -439,7 +430,6 @@ static lispobj ptrans_otherptr(thing, header, constant) return ptrans_vector(thing, 1, 0, FALSE, constant); case type_SimpleVector: - case type_StructureHeader: return ptrans_vector(thing, 32, 0, TRUE, constant); case type_SimpleArrayUnsignedByte2: @@ -536,7 +526,7 @@ static lispobj *pscav(addr, nwords, constant) break; case type_StructurePointer: - thing = ptrans_struct(thing, header, constant); + thing = ptrans_boxed(thing, header, constant); break; case type_OtherPointer: