[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv10272

Modified Files:
	los-closette.lisp 
Log Message:
Have run-time-context-class be a proper metaclass for run-time-context.

Date: Sun May  1 01:22:20 2005
Author: ffjeld

Index: movitz/losp/muerte/los-closette.lisp
diff -u movitz/losp/muerte/los-closette.lisp:1.26 movitz/losp/muerte/los-closette.lisp:1.27
--- movitz/losp/muerte/los-closette.lisp:1.26	Tue Jan 25 14:52:25 2005
+++ movitz/losp/muerte/los-closette.lisp	Sun May  1 01:22:19 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Jul 23 14:29:10 2002
 ;;;;                
-;;;; $Id: los-closette.lisp,v 1.26 2005/01/25 13:52:25 ffjeld Exp $
+;;;; $Id: los-closette.lisp,v 1.27 2005/04/30 23:22:19 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1006,14 +1006,14 @@
 (defclass infant-object (t) () (:metaclass built-in-class))
 (defclass unbound-value (t) () (:metaclass built-in-class))
 
-(defclass run-time-context (t)
-  ()
-  (:metaclass built-in-class)
-  (:size #.(bt:sizeof 'movitz::movitz-run-time-context))
-  (:slot-map #.(movitz::slot-map 'movitz::movitz-run-time-context
-			       (cl:+ (bt:slot-offset 'movitz::movitz-run-time-context
-						     'movitz::run-time-context-start)
-				     0))))
+;;;(defclass run-time-context (t)
+;;;  ()
+;;;  (:metaclass built-in-class)
+;;;  (:size #.(bt:sizeof 'movitz::movitz-run-time-context))
+;;;  (:slot-map #.(movitz::slot-map 'movitz::movitz-run-time-context
+;;;			       (cl:+ (bt:slot-offset 'movitz::movitz-run-time-context
+;;;						     'movitz::run-time-context-start)
+;;;				     0))))
 
 (defclass stream () ())
 
@@ -1040,13 +1040,7 @@
 (defclass funcallable-standard-object (standard-object function) ())
 (defclass generic-function (metaobject funcallable-standard-object) ())
 (defclass standard-generic-function (generic-function)
-  (#+ignore
-   (name
-    :initarg :name)			; :accessor generic-function-name
-   #+ignore
-   (lambda-list				; :accessor generic-function-lambda-list
-    :initarg :lambda-list)
-   (methods
+  ((methods
     :initform ())			; :accessor generic-function-methods)
    (method-class			; :accessor generic-function-method-class
     :initarg :method-class)
@@ -1718,11 +1712,6 @@
       (write-string ")" stream)))
   object)
 
-(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)))
-  x)
-
 (defmethod print-object ((x illegal-object) stream)
   (error "Won't print illegal-object ~Z." x)
   ;; (print-unreadable-object (x stream :type t :identity t))
@@ -1912,3 +1901,32 @@
       (values))))
 
 
+;;;;
+
+(defclass run-time-context-class (std-slotted-class built-in-class) ())
+
+(defclass run-time-context (t)
+  ((name
+    :initarg :name
+    :accessor run-time-context-name)
+   (stack-vector
+    :initarg :stack-vector))
+  (:metaclass run-time-context-class)
+  (:size #.(bt:sizeof 'movitz::movitz-run-time-context))
+  (:slot-map #.(movitz::slot-map 'movitz::movitz-run-time-context
+			       (cl:+ (bt:slot-offset 'movitz::movitz-run-time-context
+						     'movitz::run-time-context-start)
+				     0))))
+
+(defmethod slot-value-using-class ((class run-time-context-class) object
+				   (slot standard-effective-slot-definition))
+  (let ((x (svref (%run-time-context-slot 'slots object)
+		  (slot-definition-location slot))))
+    (if (eq x (load-global-constant new-unbound-value))
+	(slot-unbound class object (slot-definition-name slot))
+      x)))
+
+(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)))
+  x)