[cells-cvs] CVS update: cell-cultures/cells/integrity.lisp cell-cultures/cells/model-object.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/cells
In directory common-lisp.net:/tmp/cvs-serv14181/cells

Modified Files:
	integrity.lisp model-object.lisp 
Log Message:

Date: Thu Jul  8 20:53:04 2004
Author: ktilton

Index: cell-cultures/cells/integrity.lisp
diff -u cell-cultures/cells/integrity.lisp:1.3 cell-cultures/cells/integrity.lisp:1.4
--- cell-cultures/cells/integrity.lisp:1.3	Tue Jul  6 18:25:40 2004
+++ cell-cultures/cells/integrity.lisp	Thu Jul  8 20:53:04 2004
@@ -51,8 +51,8 @@
   `(let ((*deference-acknowledged* t))
      , at body))
 
-(defmacro with-integrity ((key &rest defer-info) &rest body)
-  `(call-with-integrity ,key (list , at defer-info)
+(defmacro with-integrity ((debug-key &rest defer-info) &rest body)
+  `(call-with-integrity ,debug-key (list , at defer-info)
      (lambda () , at body)))
 
 (defun ufb-queue (opcode)
@@ -61,7 +61,7 @@
 (defun ufb-add (opcode continuation)
   (fifo-add (ufb-queue opcode) continuation))
 
-(defconstant-once *ufb-opcodes* '(:user-notify :output :setf :makunbound))
+(defconstant-once *ufb-opcodes* '(:user-notify :output :setf :makunbound :finalize))
 
 (define-condition c-opcode-deferred (c-enabling)
    ((defer-info :initarg :defer-info :reader defer-info))
@@ -72,8 +72,8 @@
 
 (defparameter *ufb-needed* nil)
 
-(defun call-with-integrity (key defer-info action &aux (opcode (car defer-info)))
-  (declare (ignorable key))
+(defun call-with-integrity (debug-key defer-info action &aux (opcode (car defer-info)))
+  (declare (ignorable debug-key))
   (assert (or (null opcode) (member opcode *ufb-opcodes*)))
   (trc nil "call-with-integrity entry *unfinished-business*" *unfinished-business*)
   (if *unfinished-business*
@@ -91,7 +91,7 @@
            (mapcar (lambda (opcode)
                      (cons opcode (make-fifo-queue)))
              *ufb-opcodes*)))
-      (trc nil "!!!!!!!!!! started new *unfinished-business*" key defer-info)
+      (trc nil "!!!!!!!!!! started new *unfinished-business*" debug-key defer-info)
       (when (or (zerop *data-pulse-id*)
               (member opcode '(:setf :makunbound)))
         (data-pulse-next (cons opcode defer-info))
@@ -145,4 +145,12 @@
             (push c setfs)
             (data-pulse-next (list :finbiz c new-value))
             (funcall task-fn))))
+      (go notify-users))
+
+    ; --- do finalizations ------------------------
+    (setf task (fifo-pop (ufb-queue :finalize)))
+    (when task
+      (destructuring-bind ((self) . task-fn) task
+        (trc "finbiz: deferred finalize!!!!" self)
+        (funcall task-fn))
       (go notify-users))))


Index: cell-cultures/cells/model-object.lisp
diff -u cell-cultures/cells/model-object.lisp:1.2 cell-cultures/cells/model-object.lisp:1.3
--- cell-cultures/cells/model-object.lisp:1.2	Sun Jul  4 11:59:41 2004
+++ cell-cultures/cells/model-object.lisp	Thu Jul  8 20:53:04 2004
@@ -154,7 +154,7 @@
             (progn ;; next bit revised to avoid double-output of optimized cells
               (when (eql '.kids slot-name)
                 (bwhen (sv (slot-value self '.kids))
-                  (trc nil "soon will output initial kids of" self)
+                  (trc "soon will output initial kids of" self)
                   (md-kids-change self sv nil :md-awaken-slot)))
               (c-output-initially self slot-name)))))))