Commit 289982f2 authored by gerd's avatar gerd
Browse files

Control viability of dynamic-extent declarations with a 

	user-settable variable and an interface function that can be used
	across backends.

	* src/compiler/globaldb.lisp
	(*trust-dynamic-extent-declarations*): New variable.
	(trust-dynamic-extent-declaration-p): New function.
	* src/compiler/x86/macros.lisp (allocation): Use it.
	* src/compiler/sparc/macros.lisp (allocation): Use it.

	* src/code/exports.lisp ("EXTENSIONS"): Export
	*trust-dynamic-extent-declarations*.
	* src/code/exports.lisp ("C"): Export
	trust-dynamic-extent-declaration-p.
parent f4dc265b

code/exports.lisp

+6 −3
Original line number Diff line number Diff line
@@ -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/code/exports.lisp,v 1.220 2003/08/03 11:27:49 gerd Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.221 2003/08/06 19:00:13 gerd Exp $")

;;;

;;; **********************************************************************

;;;
@@ -1303,7 +1303,9 @@ 
	     "&PARSE-BODY"



	     ;; PCL declaration identifiers.

	     "SLOTS" "AUTO-COMPILE" "NOT-AUTO-COMPILE"))

	     "SLOTS" "AUTO-COMPILE" "NOT-AUTO-COMPILE"



	     "*TRUST-DYNAMIC-EXTENT-DECLARATIONS*"))



(defpackage "STREAM"

  (:import-from "SYSTEM" "LISP-STREAM")
@@ -1578,7 +1580,8 @@ 
	   "LARGE-ALLOC"

	   "%SET-FUNCTION-SELF"

	   "IR2-COMPONENT-DYNCOUNT-INFO"

	   "DYNCOUNT-INFO" "DYNCOUNT-INFO-P")

	   "DYNCOUNT-INFO" "DYNCOUNT-INFO-P"

	   "TRUST-DYNAMIC-EXTENT-DECLARATION-P")

  )

(defpackage "XREF"

  (:export "INIT-XREF-DATABASE"

compiler/globaldb.lisp

+28 −1
Original line number Diff line number Diff line
@@ -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/globaldb.lisp,v 1.42 2003/03/22 16:15:19 gerd Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.43 2003/08/06 19:00:13 gerd Exp $")

;;;

;;; **********************************************************************

;;;
@@ -1167,3 +1167,30 @@ 
); defun other-info-init



(declaim (freeze-type info-env))



(defvar *trust-dynamic-extent-declarations*

  (lambda (safety space speed debug)

    (declare (ignore space speed debug) (fixnum safety))

    (< safety 3))

  "If null, don't trust dynamic-extent declarations.



   If T, always trust dynamic-extent declarations.



   Otherwise, the value of this variable must be a function of four

   arguments SAFETY, SPACE, SPEED, and DEBUG.  If the function returns

   true when called, dynamic-extent declarations are trusted,

   otherwise, they are not trusted.



   Default is a function that returns true if SAFETY < 3.")



(defun trust-dynamic-extent-declaration-p (&optional node)

  (declare (type (or null node) node))

  (let ((trust *trust-dynamic-extent-declarations*))

    (if (functionp trust)

	(let ((cookie (lexenv-cookie (if node

					 (node-lexenv node)

					 *lexical-environment*))))

	  (funcall trust (cookie-safety cookie) (cookie-space cookie)

		   (cookie-speed cookie) (cookie-debug cookie)))

	trust)))

compiler/sparc/macros.lisp

+3 −3
Original line number Diff line number Diff line
@@ -5,11 +5,11 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.19 2003/08/06 14:45:50 toy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.20 2003/08/06 19:00:12 gerd Exp $")

;;;

;;; **********************************************************************

;;;

;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.19 2003/08/06 14:45:50 toy Exp $

;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.20 2003/08/06 19:00:12 gerd Exp $

;;;

;;; This file contains various useful macros for generating SPARC code.

;;;
@@ -205,7 +205,7 @@ 
  ;; set.  If the lowtag also has a 1 bit in the same position, we're all

  ;; set.  Otherwise, we need to zap out the lowtag from alloc-tn, and

  ;; then or in the lowtag.

  `(cond ((and ,stack-p ,node (policy ,node (>= speed safety)))

  `(cond ((and ,stack-p ,node (trust-dynamic-extent-declaration-p ,node))

	  ;; Stack allocation

	  ;;

	  ;; The control stack grows up, so round up CSP to a

compiler/x86/macros.lisp

+2 −2
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman or slisp-group@cs.cmu.edu.

;;;

(ext:file-comment

 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.19 2003/08/05 19:46:53 gerd Exp $")

 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.20 2003/08/06 19:00:12 gerd Exp $")

;;;

;;; **********************************************************************

;;;
@@ -261,7 +261,7 @@ 
   appropriate, allocate from the stack."

  (cond ((and inline

	      dynamic-extent

	      (policy inline (>= speed safety)))

	      (trust-dynamic-extent-declaration-p inline))

	 (stack-allocation alloc-tn size))

	((and *maybe-use-inline-allocation*

	      (or (null inline)