Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21525
Modified Files: run-time-context.lisp Log Message: *** empty log message *** Date: Wed May 4 09:43:27 2005 Author: ffjeld
Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.19 movitz/losp/muerte/run-time-context.lisp:1.20 --- movitz/losp/muerte/run-time-context.lisp:1.19 Wed May 4 08:17:21 2005 +++ movitz/losp/muerte/run-time-context.lisp Wed May 4 09:43:27 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.19 2005/05/04 06:17:21 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.20 2005/05/04 07:43:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -27,6 +27,7 @@ (defclass run-time-context (t) ((name :initarg :name + :initform :anonymous :accessor run-time-context-name) (stack-vector :initarg :stack-vector)) @@ -92,8 +93,8 @@ (let ((slot-location (slot-definition-location slot))) (check-type slot-location positive-fixnum) (lambda (instance) - (unbound-protect (svref (%run-time-context-slot 'slots instance) slot-location) - (slot-unbound-trampoline instance slot-location))))) + (with-unbound-protect (svref (%run-time-context-slot 'slots instance) slot-location) + (slot-unbound-trampoline instance slot-location)))))
(defmethod compute-effective-slot-writer ((class run-time-context-class) slot) (let ((slot-location (slot-definition-location slot))) @@ -104,7 +105,7 @@
(defmethod print-object ((x run-time-context) stream) (print-unreadable-object (x stream :type t :identity t) - (format stream " ~S" (%run-time-context-slot 'name x))) + (format stream "~S" (run-time-context-name x))) x)
;;; @@ -142,7 +143,7 @@ (name :anonymous)) (check-type parent run-time-context) (let ((context (%shallow-copy-object parent (movitz-type-word-size 'movitz-run-time-context)))) - (setf (%run-time-context-slot 'name context) name + (setf (%run-time-context-slot 'slots context) (copy-seq (%run-time-context-slot 'slots parent)) (%run-time-context-slot 'self context) context (%run-time-context-slot 'atomically-continuation context) 0) context))