Skip to content
Snippets Groups Projects
Commit 8d942f2f authored by wlott's avatar wlott
Browse files

Added support for funcallable instances.

parent 76fd29f1
No related branches found
No related tags found
No related merge requests found
/* /*
* Stop and Copy GC based on Cheney's algorithm. * 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. * Written by Christopher Hoover.
*/ */
...@@ -585,20 +585,21 @@ lispobj *where, object; ...@@ -585,20 +585,21 @@ lispobj *where, object;
type = TypeOf(first); type = TypeOf(first);
switch (type) { switch (type) {
case type_FunctionHeader: case type_FunctionHeader:
copy = trans_function_header(object); copy = trans_function_header(object);
break; break;
case type_ClosureFunctionHeader: case type_ClosureFunctionHeader:
copy = trans_closure_function_header(object); copy = trans_closure_function_header(object);
break; break;
case type_ClosureHeader: case type_ClosureHeader:
copy = trans_boxed(object); case type_FuncallableInstanceHeader:
break; copy = trans_boxed(object);
default: break;
fprintf(stderr, "GC lossage. Bogus function pointer.\n"); default:
fprintf(stderr, "Pointer: 0x%08x, Header: 0x%08x\n", fprintf(stderr, "GC lossage. Bogus function pointer.\n");
(unsigned long) object, (unsigned long) first); fprintf(stderr, "Pointer: 0x%08x, Header: 0x%08x\n",
gc_lose(); (unsigned long) object, (unsigned long) first);
gc_lose();
} }
first = *first_pointer = copy; first = *first_pointer = copy;
...@@ -1745,6 +1746,7 @@ gc_init() ...@@ -1745,6 +1746,7 @@ gc_init()
scavtab[type_ClosureFunctionHeader] = scav_closure_function_header; scavtab[type_ClosureFunctionHeader] = scav_closure_function_header;
scavtab[type_ReturnPcHeader] = scav_return_pc_header; scavtab[type_ReturnPcHeader] = scav_return_pc_header;
scavtab[type_ClosureHeader] = scav_boxed; scavtab[type_ClosureHeader] = scav_boxed;
scavtab[type_FuncallableInstanceHeader] = scav_boxed;
scavtab[type_ValueCellHeader] = scav_boxed; scavtab[type_ValueCellHeader] = scav_boxed;
scavtab[type_SymbolHeader] = scav_symbol; scavtab[type_SymbolHeader] = scav_symbol;
scavtab[type_BaseCharacter] = scav_immediate; scavtab[type_BaseCharacter] = scav_immediate;
...@@ -1783,6 +1785,7 @@ gc_init() ...@@ -1783,6 +1785,7 @@ gc_init()
transother[type_ClosureFunctionHeader] = trans_closure_function_header; transother[type_ClosureFunctionHeader] = trans_closure_function_header;
transother[type_ReturnPcHeader] = trans_return_pc_header; transother[type_ReturnPcHeader] = trans_return_pc_header;
transother[type_ClosureHeader] = trans_boxed; transother[type_ClosureHeader] = trans_boxed;
transother[type_FuncallableInstanceHeader] = trans_boxed;
transother[type_ValueCellHeader] = trans_boxed; transother[type_ValueCellHeader] = trans_boxed;
transother[type_SymbolHeader] = trans_boxed; transother[type_SymbolHeader] = trans_boxed;
transother[type_BaseCharacter] = trans_immediate; transother[type_BaseCharacter] = trans_immediate;
...@@ -1835,6 +1838,7 @@ gc_init() ...@@ -1835,6 +1838,7 @@ gc_init()
sizetab[type_ReturnPcHeader] = size_return_pc_header; sizetab[type_ReturnPcHeader] = size_return_pc_header;
#endif #endif
sizetab[type_ClosureHeader] = size_boxed; sizetab[type_ClosureHeader] = size_boxed;
sizetab[type_FuncallableInstanceHeader] = size_boxed;
sizetab[type_ValueCellHeader] = size_boxed; sizetab[type_ValueCellHeader] = size_boxed;
sizetab[type_SymbolHeader] = size_boxed; sizetab[type_SymbolHeader] = size_boxed;
sizetab[type_BaseCharacter] = size_immediate; sizetab[type_BaseCharacter] = size_immediate;
......
/* Purify. */ /* 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> #include <mach.h>
...@@ -263,9 +263,10 @@ static lispobj ptrans_func(thing, header, constant) ...@@ -263,9 +263,10 @@ static lispobj ptrans_func(thing, header, constant)
lispobj code, *new, *old, result; lispobj code, *new, *old, result;
struct function_header *function; struct function_header *function;
/* THING can either be a function header, a closure function header, or */ /* THING can either be a function header, a closure function header, */
/* a closure. If it's a closure, we do the same as ptrans_boxed, */ /* a closure, or a funcallable-instance. If it's a closure or a */
/* otherwise we have to do something strange, 'cause it is buried inside */ /* funcallable-instance, we do the same as ptrans_boxed. */
/* Otherwise we have to do something strange, 'cause it is buried inside */
/* a code object. */ /* a code object. */
if (TypeOf(header) == type_ClosureHeader) { if (TypeOf(header) == type_ClosureHeader) {
...@@ -289,6 +290,26 @@ static lispobj ptrans_func(thing, header, constant) ...@@ -289,6 +290,26 @@ static lispobj ptrans_func(thing, header, constant)
return result; 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 { else {
gc_assert(TypeOf(header) == type_FunctionHeader || gc_assert(TypeOf(header) == type_FunctionHeader ||
TypeOf(header) == type_ClosureFunctionHeader); TypeOf(header) == type_ClosureFunctionHeader);
...@@ -400,6 +421,7 @@ static lispobj ptrans_otherptr(thing, header, constant) ...@@ -400,6 +421,7 @@ static lispobj ptrans_otherptr(thing, header, constant)
case type_ComplexVector: case type_ComplexVector:
case type_ComplexArray: case type_ComplexArray:
case type_ClosureHeader: case type_ClosureHeader:
case type_FuncallableInstanceHeader:
case type_ValueCellHeader: case type_ValueCellHeader:
case type_WeakPointer: case type_WeakPointer:
return ptrans_boxed(thing, header, constant); return ptrans_boxed(thing, header, constant);
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment