Skip to content
Snippets Groups Projects
Commit 21ee6424 authored by gerd's avatar gerd
Browse files

* src/pcl/ctor.lisp (slot-init-forms): Declare safety 3 to

	prevent constant folding of type tests.
	(instance-init-forms): Use svref instead of %svref.
parent 59f242fc
No related branches found
No related tags found
No related merge requests found
...@@ -46,7 +46,7 @@ ...@@ -46,7 +46,7 @@
;;; is called. ;;; is called.
(file-comment (file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.13 2003/05/25 14:33:50 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.14 2003/07/01 14:49:39 gerd Exp $")
(in-package "PCL") (in-package "PCL")
...@@ -593,7 +593,7 @@ ...@@ -593,7 +593,7 @@
collect `(,var (funcall ,initfn)) into bindings collect `(,var (funcall ,initfn)) into bindings
finally (return (values vars bindings))) finally (return (values vars bindings)))
`(let ,bindings `(let ,bindings
(declare (ignorable ,@vars)) (declare (ignorable ,@vars) (optimize (safety 3)))
,@instance-init-forms ,@instance-init-forms
,@class-init-forms)))))) ,@class-init-forms))))))
...@@ -636,28 +636,28 @@ ...@@ -636,28 +636,28 @@
(ecase type (ecase type
((nil) ((nil)
(unless before-method-p (unless before-method-p
`(setf (%svref .slots. ,i) +slot-unbound+))) `(setf (svref .slots. ,i) +slot-unbound+)))
((param var) ((param var)
`(setf (%svref .slots. ,i) (the ,slot-type ,value))) `(setf (svref .slots. ,i) (the ,slot-type ,value)))
(initfn (initfn
`(setf (%svref .slots. ,i) `(setf (svref .slots. ,i)
(the ,slot-type (funcall ,value)))) (the ,slot-type (funcall ,value))))
(initform/initfn (initform/initfn
(if before-method-p (if before-method-p
`(when (eq (%svref .slots. ,i) +slot-unbound+) `(when (eq (svref .slots. ,i) +slot-unbound+)
(setf (%svref .slots. ,i) (setf (svref .slots. ,i)
(the ,slot-type (funcall ,value)))) (the ,slot-type (funcall ,value))))
`(setf (%svref .slots. ,i) `(setf (svref .slots. ,i)
(the ,slot-type (funcall ,value))))) (the ,slot-type (funcall ,value)))))
(initform (initform
(if before-method-p (if before-method-p
`(when (eq (%svref .slots. ,i) +slot-unbound+) `(when (eq (svref .slots. ,i) +slot-unbound+)
(setf (%svref .slots. ,i) (setf (svref .slots. ,i)
(the ,slot-type ',(eval value)))) (the ,slot-type ',(eval value))))
`(setf (%svref .slots. ,i) `(setf (svref .slots. ,i)
(the ,slot-type ',(eval value))))) (the ,slot-type ',(eval value)))))
(constant (constant
`(setf (%svref .slots. ,i) `(setf (svref .slots. ,i)
(the ,slot-type ',(eval value))))))) (the ,slot-type ',(eval value)))))))
;;; ;;;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment