From 9603fc24a8a4f29098e922d10af7c5188b6f2f86 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Mon, 11 Aug 2003 14:22:44 +0000
Subject: [PATCH] 	* src/compiler/main.lisp (convert-and-maybe-compile):
 Don't 	frob bytes-consed-between-gcs.

	* src/compiler/alloc.lisp (defallocators) [#+gencgc]: Definition
	that doesn't do resourcing.
---
 compiler/alloc.lisp | 28 +++++++++++++++++++++++++++-
 compiler/main.lisp  | 21 ++++++++-------------
 2 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/compiler/alloc.lisp b/compiler/alloc.lisp
index 0dd4eaea1..d3303e725 100644
--- a/compiler/alloc.lisp
+++ b/compiler/alloc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alloc.lisp,v 1.13 2000/06/18 15:45:30 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alloc.lisp,v 1.14 2003/08/11 14:22:44 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -42,6 +42,7 @@
 ;;;
 ;;;    Define some structure freelisting operations.
 ;;;
+#-gencgc
 (defmacro defallocators (&rest specs)
   "defallocators {((name lambda-list [real-lambda-list]) thread-slot
                    (deinit-form*)
@@ -92,6 +93,31 @@
 	 ,@(hook-forms))
        (pushnew 'defallocator-deallocation-hook ext:*before-gc-hooks*))))
 
+#+gencgc
+(defmacro defallocators (&rest specs)
+  "defallocators {((name lambda-list [real-lambda-list]) thread-slot
+                   (deinit-form*)
+		   (reinit-form*))}*"
+  (collect ((forms))
+    (dolist (spec specs)
+      (destructuring-bind ((name lambda-list
+				 &optional (real-lambda-list lambda-list))
+			   thread-slot deinit-forms reinit-forms)
+	  spec
+	(declare (ignore thread-slot reinit-forms))
+	(let ((fun-name (symbolicate "MAKE-" name))
+	      (unfun-name (symbolicate "UNMAKE-" name))
+	      (var-name (symbolicate "*" name "-FREE-LIST*"))
+	      (real-fun-name (symbolicate "REALLY-MAKE-" name)))
+	  (forms `(proclaim '(inline ,fun-name ,unfun-name)))
+	  (forms `(defvar ,var-name nil))
+	  (forms `(defun ,fun-name ,lambda-list
+		    (,real-fun-name ,@real-lambda-list)))
+	  (forms `(defun ,unfun-name (structure)
+		    (declare (optimize (safety 0)))
+		    ,@deinit-forms)))))
+    `(progn
+       ,@(forms))))
 
 (defmacro node-deinits ()
   '(progn
diff --git a/compiler/main.lisp b/compiler/main.lisp
index 42232c36c..dd3f60ee7 100644
--- a/compiler/main.lisp
+++ b/compiler/main.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.136 2003/07/15 10:24:06 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.137 2003/08/11 14:22:43 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -956,18 +956,13 @@
 ;;;
 (defun convert-and-maybe-compile (form path)
   (declare (list path))
-  (let ((orig (bytes-consed-between-gcs)))
-    (unwind-protect
-	(progn
-	  (setf (bytes-consed-between-gcs) (* orig 4))
-	  (let* ((*lexical-environment*
-		  (make-lexenv :cookie *default-cookie*
-			       :interface-cookie *default-interface-cookie*))
-		 (tll (ir1-top-level form path nil)))
-	    (cond ((eq *block-compile* t) (push tll *top-level-lambdas*))
-		  (t
-		   (compile-top-level (list tll) nil)))))
-      (setf (bytes-consed-between-gcs) orig))))
+  (let* ((*lexical-environment*
+	  (make-lexenv :cookie *default-cookie*
+		       :interface-cookie *default-interface-cookie*))
+	 (tll (ir1-top-level form path nil)))
+    (if (eq *block-compile* t)
+	(push tll *top-level-lambdas*)
+	(compile-top-level (list tll) nil))))
 
 ;;; PROCESS-PROGN  --  Internal
 ;;;
-- 
GitLab