diff --git a/ldb/gc.c b/ldb/gc.c index 2a3cbe46b8f241c26a34a8a9352d33876e03e72d..687c4f8a3628fc2016f29669a4a942abbc722cee 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.19 1990/11/12 02:37:48 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.20 1990/11/27 17:37:41 wlott Exp $ * * Written by Christopher Hoover. */ @@ -585,20 +585,21 @@ lispobj *where, object; type = TypeOf(first); switch (type) { - case type_FunctionHeader: - copy = trans_function_header(object); - break; - case type_ClosureFunctionHeader: - copy = trans_closure_function_header(object); - break; - case type_ClosureHeader: - copy = trans_boxed(object); - break; - default: - fprintf(stderr, "GC lossage. Bogus function pointer.\n"); - fprintf(stderr, "Pointer: 0x%08x, Header: 0x%08x\n", - (unsigned long) object, (unsigned long) first); - gc_lose(); + case type_FunctionHeader: + copy = trans_function_header(object); + break; + case type_ClosureFunctionHeader: + copy = trans_closure_function_header(object); + break; + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + copy = trans_boxed(object); + break; + default: + fprintf(stderr, "GC lossage. Bogus function pointer.\n"); + fprintf(stderr, "Pointer: 0x%08x, Header: 0x%08x\n", + (unsigned long) object, (unsigned long) first); + gc_lose(); } first = *first_pointer = copy; @@ -1745,6 +1746,7 @@ gc_init() scavtab[type_ClosureFunctionHeader] = scav_closure_function_header; scavtab[type_ReturnPcHeader] = scav_return_pc_header; scavtab[type_ClosureHeader] = scav_boxed; + scavtab[type_FuncallableInstanceHeader] = scav_boxed; scavtab[type_ValueCellHeader] = scav_boxed; scavtab[type_SymbolHeader] = scav_symbol; scavtab[type_BaseCharacter] = scav_immediate; @@ -1783,6 +1785,7 @@ gc_init() transother[type_ClosureFunctionHeader] = trans_closure_function_header; transother[type_ReturnPcHeader] = trans_return_pc_header; transother[type_ClosureHeader] = trans_boxed; + transother[type_FuncallableInstanceHeader] = trans_boxed; transother[type_ValueCellHeader] = trans_boxed; transother[type_SymbolHeader] = trans_boxed; transother[type_BaseCharacter] = trans_immediate; @@ -1835,6 +1838,7 @@ gc_init() sizetab[type_ReturnPcHeader] = size_return_pc_header; #endif sizetab[type_ClosureHeader] = size_boxed; + sizetab[type_FuncallableInstanceHeader] = size_boxed; sizetab[type_ValueCellHeader] = size_boxed; sizetab[type_SymbolHeader] = size_boxed; sizetab[type_BaseCharacter] = size_immediate; diff --git a/ldb/purify.c b/ldb/purify.c index 5a113c3d54ea6feafa491c74f2626c6f6ccb08bc..b118d6d97cd422f898dfac485b9ce9eb5e395d3a 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.8 1990/11/12 02:39:02 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/purify.c,v 1.9 1990/11/27 17:38:02 wlott Exp $ */ #include <mach.h> @@ -263,9 +263,10 @@ static lispobj ptrans_func(thing, header, constant) lispobj code, *new, *old, result; struct function_header *function; - /* THING can either be a function header, a closure function header, or */ - /* a closure. If it's a closure, we do the same as ptrans_boxed, */ - /* otherwise we have to do something strange, 'cause it is buried inside */ + /* THING can either be a function header, a closure function header, */ + /* a closure, or a funcallable-instance. If it's a closure or a */ + /* funcallable-instance, we do the same as ptrans_boxed. */ + /* Otherwise we have to do something strange, 'cause it is buried inside */ /* a code object. */ if (TypeOf(header) == type_ClosureHeader) { @@ -289,6 +290,26 @@ static lispobj ptrans_func(thing, header, constant) return result; } + else if (TypeOf(header) == type_FuncallableInstanceHeader) { + nwords = 1 + HeaderValue(header); + + /* Allocate it. It *must* not go in read_only space. */ + old = (lispobj *)PTR(thing); + new = static_free; + static_free += CEILING(nwords, 2); + + /* Copy it. */ + bcopy(old, new, nwords * sizeof(lispobj)); + + /* Deposit forwarding pointer. */ + result = (lispobj)new | LowtagOf(thing); + *old = result; + + /* Scavenge it. */ + pscav(new, nwords, constant); + + return result; + } else { gc_assert(TypeOf(header) == type_FunctionHeader || TypeOf(header) == type_ClosureFunctionHeader); @@ -400,6 +421,7 @@ static lispobj ptrans_otherptr(thing, header, constant) case type_ComplexVector: case type_ComplexArray: case type_ClosureHeader: + case type_FuncallableInstanceHeader: case type_ValueCellHeader: case type_WeakPointer: return ptrans_boxed(thing, header, constant);