From 26831fda7441461b62d62a1f66bb4c910248be8d Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 26 Feb 1993 09:02:06 +0000 Subject: [PATCH] new structure branch & tuning, see new_struct --- lisp/gc.c | 20 ++++++++++---------- lisp/print.c | 2 +- lisp/purify.c | 18 +++++++++++++++--- tools/worldbuild.lisp | 8 +++++--- tools/worldcom.lisp | 10 ++++++---- 5 files changed, 37 insertions(+), 21 deletions(-) diff --git a/lisp/gc.c b/lisp/gc.c index ebb05a507..2fbb6d6a2 100644 --- a/lisp/gc.c +++ b/lisp/gc.c @@ -1,7 +1,7 @@ /* * Stop and Copy GC based on Cheney's algorithm. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.4 1993/01/10 17:20:12 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.5 1993/02/26 09:02:03 ram Exp $ * * Written by Christopher Hoover. */ @@ -521,8 +521,8 @@ void print_garbage(lispobj *from_space, lispobj *from_space_free_pointer) case type_ListPointer: nwords = 2; break; - case type_StructurePointer: - printf("Don't know about structures yet!\n"); + case type_InstancePointer: + printf("Don't know about instances yet!\n"); nwords = 1; break; case type_FunctionPointer: @@ -825,10 +825,10 @@ trans_function_header(lispobj object) -/* Structures */ +/* Instances */ static int -scav_structure_pointer(lispobj *where, lispobj object) +scav_instance_pointer(lispobj *where, lispobj object) { if (from_space_p(object)) { lispobj first, *first_pointer; @@ -1641,7 +1641,7 @@ void gc_init(void) /* OtherImmediate0 */ scavtab[type_ListPointer|(i<<3)] = scav_list_pointer; scavtab[type_OddFixnum|(i<<3)] = scav_immediate; - scavtab[type_StructurePointer|(i<<3)] = scav_structure_pointer; + scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer; /* OtherImmediate1 */ scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer; } @@ -1689,7 +1689,7 @@ void gc_init(void) scavtab[type_Sap] = scav_unboxed; scavtab[type_UnboundMarker] = scav_immediate; scavtab[type_WeakPointer] = scav_weak_pointer; - scavtab[type_StructureHeader] = scav_boxed; + scavtab[type_InstanceHeader] = scav_boxed; #ifndef sparc scavtab[type_Fdefn] = scav_fdefn; #else @@ -1734,7 +1734,7 @@ void gc_init(void) transother[type_Sap] = trans_unboxed; transother[type_UnboundMarker] = trans_immediate; transother[type_WeakPointer] = trans_weak_pointer; - transother[type_StructureHeader] = trans_vector; + transother[type_InstanceHeader] = trans_vector; transother[type_Fdefn] = trans_boxed; /* Size table */ @@ -1748,7 +1748,7 @@ void gc_init(void) /* OtherImmediate0 */ sizetab[type_ListPointer|(i<<3)] = size_pointer; sizetab[type_OddFixnum|(i<<3)] = size_immediate; - sizetab[type_StructurePointer|(i<<3)] = size_pointer; + sizetab[type_InstancePointer|(i<<3)] = size_pointer; /* OtherImmediate1 */ sizetab[type_OtherPointer|(i<<3)] = size_pointer; } @@ -1788,7 +1788,7 @@ void gc_init(void) sizetab[type_Sap] = size_unboxed; sizetab[type_UnboundMarker] = size_immediate; sizetab[type_WeakPointer] = size_weak_pointer; - sizetab[type_StructureHeader] = size_vector; + sizetab[type_InstanceHeader] = size_vector; sizetab[type_Fdefn] = size_boxed; } diff --git a/lisp/print.c b/lisp/print.c index 6d05a32b9..c33017192 100644 --- a/lisp/print.c +++ b/lisp/print.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.1.1.1 1993/02/23 12:01:22 ram Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.2 1993/02/26 09:02:05 ram Exp $ */ #include <stdio.h> #include "print.h" diff --git a/lisp/purify.c b/lisp/purify.c index ba2cafcf2..09d84b277 100644 --- a/lisp/purify.c +++ b/lisp/purify.c @@ -1,6 +1,6 @@ /* Purify. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.4 1993/01/10 17:22:37 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.5 1993/02/26 09:02:06 ram Exp $ */ #include <stdio.h> #include <sys/types.h> @@ -130,6 +130,18 @@ static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant) return result; } +/* need to look at the layout to see if it is a pure structure class, and + only then can we transport as constant. If it is pure, we can + ALWAYS transport as a constant */ + +static lispobj ptrans_instance(lispobj thing, lispobj header, boolean constant) +{ + lispobj layout = ((struct instance *)PTR(thing))->slots[0]; + ptrans_boxed(thing, header, + (((struct instance *)PTR(layout))->slots[15]) + != NIL); +} + static lispobj ptrans_fdefn(lispobj thing, lispobj header) { int nwords; @@ -507,8 +519,8 @@ static lispobj *pscav(lispobj *addr, int nwords, boolean constant) thing = ptrans_list(thing, constant); break; - case type_StructurePointer: - thing = ptrans_boxed(thing, header, constant); + case type_InstancePointer: + thing = ptrans_instance(thing, header, constant); break; case type_OtherPointer: diff --git a/tools/worldbuild.lisp b/tools/worldbuild.lisp index 1d8f5a9fe..6428538bc 100644 --- a/tools/worldbuild.lisp +++ b/tools/worldbuild.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldbuild.lisp,v 1.17 1993/01/15 18:18:11 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldbuild.lisp,v 1.18 1993/02/26 08:59:59 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -52,9 +52,11 @@ "target:code/type-boot" "target:code/struct" "target:code/error" - "target:compiler/type" + "target:code/typedefs" + "target:code/class" + "target:code/type" "target:compiler/generic/vm-type" - "target:compiler/type-init" + "target:code/type-init" "target:code/defstruct" "target:compiler/proclaim" diff --git a/tools/worldcom.lisp b/tools/worldcom.lisp index 1df97c741..2a1e5a517 100644 --- a/tools/worldcom.lisp +++ b/tools/worldcom.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.47 1992/12/16 10:57:11 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.48 1993/02/26 09:00:03 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -36,6 +36,7 @@ ;;; these guys need to be first. (comf "target:code/struct") ; For structures. +(comf "target:code/sysmacs") ;;; Assembly files. (when (c:backend-featurep :pmax) @@ -83,9 +84,11 @@ ;;; recurse. (defvar *original-%deftype* #'lisp::%deftype) (setf (fdefinition 'lisp::%deftype) #'list) -(comf "target:compiler/type") +(comf "target:code/typedefs") +(comf "target:code/class") +(comf "target:code/type") (comf "target:compiler/generic/vm-type") -(comf "target:compiler/type-init") +(comf "target:code/type-init") (comf "target:code/pred") (setf (fdefinition 'lisp::%deftype) *original-%deftype*) @@ -176,7 +179,6 @@ (comf "target:code/ntrace") (comf "target:code/profile") (comf "target:code/sort") -(comf "target:code/sysmacs") (comf "target:code/time") (comf "target:code/weak") (comf "target:code/final") -- GitLab