[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed May 4 07:43:28 UTC 2005
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 at 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))
More information about the Movitz-cvs
mailing list