[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