From: Nikodemus S. <de...@us...> - 2008-07-30 13:51:59
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv14190/src/compiler Modified Files: ir2tran.lisp Log Message: 1.0.19.3: more careful PROGV and SET * Don't bind constants in PROGV. * Check variable types before binding / assignment. * When un-binding, PROGV doesn't temporarily bind a variable to NIL anymore, but directly to the unbound marker, so that an interrupt handler cannot see a bogus value. * Based on patch by Richard Kreuter. Index: ir2tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir2tran.lisp,v retrieving revision 1.74 retrieving revision 1.75 diff -u -d -r1.74 -r1.75 --- ir2tran.lisp 30 Jul 2008 13:44:55 -0000 1.74 +++ ir2tran.lisp 30 Jul 2008 13:51:56 -0000 1.75 @@ -1430,17 +1430,23 @@ (progn (labels ((,unbind (vars) (declare (optimize (speed 2) (debug 0))) - (dolist (var vars) - (%primitive bind nil var) - (makunbound var))) + (let ((unbound-marker (%primitive make-other-immediate-type + 0 sb!vm:unbound-marker-widetag))) + (dolist (var vars) + ;; CLHS says "bound and then made to have no value" -- user + ;; should not be able to tell the difference between that and this. + (about-to-modify-symbol-value var "bind ~S") + (%primitive bind unbound-marker var)))) (,bind (vars vals) (declare (optimize (speed 2) (debug 0))) (cond ((null vars)) ((null vals) (,unbind vars)) - (t (%primitive bind - (car vals) - (car vars)) - (,bind (cdr vars) (cdr vals)))))) + (t + (let ((val (car vals)) + (var (car vars))) + (about-to-modify-symbol-value var "bind ~S" val) + (%primitive bind val var)) + (,bind (cdr vars) (cdr vals)))))) (,bind ,vars ,vals)) nil ,@body) |