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