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