Update of /project/cells/cvsroot/cells
In directory clnet:/tmp/cvs-serv19981
Modified Files:
cells.lisp md-slot-value.lisp md-utilities.lisp
Log Message:
Allow access to dead instances during *not-to-be* processing.
--- /project/cells/cvsroot/cells/cells.lisp 2008/04/11 09:19:29 1.26
+++ /project/cells/cvsroot/cells/cells.lisp 2008/04/12 22:53:26 1.27
@@ -47,6 +47,7 @@
(defparameter *within-integrity* nil)
(defparameter *client-queue-handler* nil)
(defparameter *unfinished-business* nil)
+(defparameter *not-to-be* nil)
#+test
(cells-reset)
--- /project/cells/cvsroot/cells/md-slot-value.lisp 2008/04/11 09:19:32 1.41
+++ /project/cells/cvsroot/cells/md-slot-value.lisp 2008/04/12 22:53:26 1.42
@@ -21,8 +21,9 @@
(defparameter *ide-app-hard-to-kill* t)
(defun md-slot-value (self slot-name &aux (c (md-slot-cell self slot-name)))
- (when (mdead self)
- (trc "md-slot-value passed dead self, returning NIL" self)
+ (when (and (not *not-to-be*)
+ (mdead self))
+ (trc "md-slot-value passed dead self, returning NIL" self slot-name c)
(inspect self)
(break "see inspector for dead ~a" self)
(return-from md-slot-value nil))
@@ -57,7 +58,7 @@
(record-caller c))))
(defun chk (s &optional (key 'anon))
- (when (eq :eternal-rest (md-state s))
+ (when (mdead s)
(break "model ~a is dead at ~a" s key)))
;;;(defmethod trcp ((c cell))
@@ -77,6 +78,9 @@
(count-it :ensure-value-is-current)
;; (trc c "ensure-value-is-current > entry" c (c-state c) :now-pulse *data-pulse-id* debug-id ensurer)
+ (when *not-to-be*
+ (return-from ensure-value-is-current t))
+
(when (and (not (symbolp (c-model c)))(eq :eternal-rest (md-state (c-model c))))
(break "model ~a of cell ~a is dead" (c-model c) c))
--- /project/cells/cvsroot/cells/md-utilities.lisp 2008/01/29 04:29:52 1.14
+++ /project/cells/cvsroot/cells/md-utilities.lisp 2008/04/12 22:53:26 1.15
@@ -31,9 +31,9 @@
;___________________ birth / death__________________________________
(defgeneric mdead (self)
-
(:method ((self model-object))
- (eq :eternal-rest (md-state self)))
+ (unless *not-to-be*
+ (eq :eternal-rest (md-state self))))
(:method (self)
(declare (ignore self))
@@ -45,20 +45,20 @@
(:method :around ((self model-object))
(declare (ignorable self))
- (trc nil #+not (typep self '(or mathx::problem mathx::prb-solvers mathx::prb-solver))
- "not.to-be nailing" self)
- ;;showpanic (c-assert (not (eq (md-state self) :eternal-rest)))
- (unless (eq (md-state self) :eternal-rest)
- (call-next-method)
-
- (setf (fm-parent self) nil
- (md-state self) :eternal-rest)
-
- (md-map-cells self nil
- (lambda (c)
- (c-assert (eq :quiesced (c-state c))))) ;; fails if user obstructs not.to-be with primary method (use :before etc)
+ (let ((*not-to-be* t))
+ (trc nil #+not (typep self '(or mathx::problem mathx::prb-solvers mathx::prb-solver))
+ "not.to-be nailing" self)
+ (unless (eq (md-state self) :eternal-rest)
+ (call-next-method)
+
+ (setf (fm-parent self) nil
+ (md-state self) :eternal-rest)
+
+ (md-map-cells self nil
+ (lambda (c)
+ (c-assert (eq :quiesced (c-state c))))) ;; fails if user obstructs not.to-be with primary method (use :before etc)
- (trc nil "not.to-be cleared 2 fm-parent, eternal-rest" self))))
+ (trc nil "not.to-be cleared 2 fm-parent, eternal-rest" self)))))
(defun md-quiesce (self)
(trc nil "md-quiesce nailing cells" self (type-of self))