Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv6035

Modified Files: cell-types.lisp cells.lpr constructors.lisp defpackage.lisp integrity.lisp link.lisp md-slot-value.lisp md-utilities.lisp model-object.lisp propagate.lisp trc-eko.lisp Log Message: Mostly someone screwing with file creation dates, but also a profound change to handling of cell currency in the face of model quiescence. See list (or code remarks re :uncurrent) for deets.

--- /project/cells/cvsroot/cells/cell-types.lisp 2006/10/02 20:55:00 1.19 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/10/17 21:28:39 1.20 @@ -28,7 +28,13 @@ (caller-store (make-fifo-queue) :type cons) ;; (C3) probably better to notify callers FIFO

(state :nascent :type symbol) ;; :nascent, :awake, :optimized-away - (value-state :unbound :type symbol) ;; {:unbound | :unevaluated | :valid} + (value-state :unbound :type symbol) ;; {:unbound | :unevaluated | :uncurrent | :valid} + ; uncurrent (aka dirty) new for 06-10-15. we need this so + ; c-quiesce can force a caller to update when asked + ; in case the owner of the quiesced cell goes out of existence + ; in a way the caller will not see via any kids dependency. Saw + ; this one coming a long time ago: depending on cell X implies + ; a dependency on the existence of instance owning X (pulse 0 :type fixnum) (pulse-last-changed 0 :type fixnum) ;; lazys can miss changes by missing change of X followed by unchange of X in subsequent DP lazy --- /project/cells/cvsroot/cells/cells.lpr 2006/08/28 21:44:13 1.21 +++ /project/cells/cvsroot/cells/cells.lpr 2006/10/17 21:28:39 1.22 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Oct 17, 2006 12:56)"; cg: "1.81"; -*-

(in-package :cg-user)

--- /project/cells/cvsroot/cells/constructors.lisp 2006/10/02 02:38:31 1.9 +++ /project/cells/cvsroot/cells/constructors.lisp 2006/10/17 21:28:39 1.10 @@ -83,6 +83,17 @@ :lazy :until-asked :rule (c-lambda ,@body)))

+(export! c?dbg c_?dbg) + +(defmacro c_?dbg (&body body) + "Lazy until asked, then eagerly propagating" + `(make-c-dependent + :code ',body + :value-state :unevaluated + :lazy :until-asked + :rule (c-lambda ,@body) + :debug t)) + (defmacro c?? ((&key (tagp nil) (in nil) (out t))&body body) (let ((result (copy-symbol 'result)) (thetag (gensym))) --- /project/cells/cvsroot/cells/defpackage.lisp 2006/06/20 14:16:44 1.7 +++ /project/cells/cvsroot/cells/defpackage.lisp 2006/10/17 21:28:39 1.8 @@ -42,6 +42,7 @@ #:class-precedence-list #-(and mcl (not openmcl-partial-mop)) #:class-slots #:slot-definition-name + #:class-direct-subclasses ) (:export #:cell #:.md-name #:c-input #:c-in #:c-in8 --- /project/cells/cvsroot/cells/integrity.lisp 2006/10/02 02:38:31 1.13 +++ /project/cells/cvsroot/cells/integrity.lisp 2006/10/17 21:28:39 1.14 @@ -70,6 +70,8 @@

(defun ufb-add (opcode continuation) (assert (find opcode *ufb-opcodes*)) + (when (and *no-tell* (eq opcode :tell-dependents)) + (break "truly queueing tell under no-tell")) (trc nil "ufb-add deferring" opcode (when (eql opcode :client)(car continuation))) (fifo-add (ufb-queue-ensure opcode) continuation))

@@ -81,7 +83,7 @@ while task do (trc nil "unfin task is" opcode task) (funcall task))) - +(defparameter *no-tell* nil) (defun finish-business () (when *stop* (return-from finish-business)) (tagbody @@ -99,7 +101,14 @@ ; during their awakening to be handled along with those enqueued by cells of ; existing model instances. ; - (just-do-it :awaken) ;--- md-awaken new instances --- + (bwhen (uqp (fifo-peek (ufb-queue :tell-dependents))) + (trcx finish-business uqp) + (DOlist (b (fifo-data (ufb-queue :tell-dependents))) + (trc "unhandled :tell-dependents" (car b) (c-callers (car b)))) + (break "unexpected 1> ufb needs to tell dependnents after telling dependents")) + (let ((*no-tell* t)) + (just-do-it :awaken) ;--- md-awaken new instances --- + ) ; ; we do not go back to check for a need to :tell-dependents because (a) the original propagation ; and processing of the :tell-dependents queue is a full propagation; no rule can ask for a cell that @@ -107,10 +116,12 @@ ; awakening need that precisely because no one asked for their values, so there can be no dependents ; to "tell". I think. :) So... ; - (when (fifo-peek (ufb-queue :tell-dependents)) + (bwhen (uqp (fifo-peek (ufb-queue :tell-dependents))) + (trcx finish-business uqp) (DOlist (b (fifo-data (ufb-queue :tell-dependents))) (trc "unhandled :tell-dependents" (car b) (c-callers (car b)))) - (break "ufb")) + (break "unexpected 2> ufb needs to tell dependnents after awakening")) + (assert (null (fifo-peek (ufb-queue :tell-dependents))))

;--- process client queue ------------------------------ --- /project/cells/cvsroot/cells/link.lisp 2006/10/02 20:55:00 1.18 +++ /project/cells/cvsroot/cells/link.lisp 2006/10/17 21:28:39 1.19 @@ -25,7 +25,7 @@ (defun record-caller (used &aux (caller (car *call-stack*))) (when (c-optimized-away-p used) ;; 2005-05-21 removed slow type check that used is cell (return-from record-caller nil)) - (trc nil "record-caller entry: used=" used :caller caller) + (trc used "record-caller entry: used=" used :caller caller) (multiple-value-bind (used-pos useds-len) (loop with u-pos for known in (cd-useds caller) @@ -37,7 +37,7 @@ finally (return (values (when u-pos (- length u-pos)) length)))

(when (null used-pos) - (trc nil "c-link > new caller,used " caller used) + (trc caller "c-link > new caller,used " caller used) (count-it :new-used) (setf used-pos useds-len) (push used (cd-useds caller)) @@ -69,6 +69,7 @@ (zerop (sbit usage rpos))) (progn (count-it :unlink-unused) + (trc c "c-unlink-unused" c :dropping-used (car useds)) (c-unlink-caller (car useds) c) (rplaca useds nil)) (progn --- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/10/02 02:38:31 1.28 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/10/17 21:28:39 1.29 @@ -60,10 +60,12 @@ (break "model ~a of cell ~a is dead" (c-model c) c))

(cond - ((c-currentp c)(trc nil "c-currentp" c)) ;; used to follow c-inputp, but I am toying with letting ephemerals (inputs) fall obsolete + ((c-currentp c) + (trc nil "c-currentp" c)) ;; used to follow c-inputp, but I am toying with letting ephemerals (inputs) fall obsolete ;; and then get reset here (ie, ((c-input-p c) (ephemeral-reset c))). ie, do not assume inputs are never obsolete ;; - ((c-inputp c)(trc nil "c-inputp" c)) ;; always current (for now; see above) + ((and (c-inputp c) + (c-validp c))) ;; a c?n (ruled-then-input) cell will not be valid at first

((or (not (c-validp c)) ;; --- /project/cells/cvsroot/cells/md-utilities.lisp 2006/09/03 13:41:09 1.8 +++ /project/cells/cvsroot/cells/md-utilities.lisp 2006/10/17 21:28:39 1.9 @@ -56,10 +56,11 @@ (defun c-quiesce (c) (typecase c (cell - (trc nil "c-quiesce unlinking" c) + (trc c "c-quiesce unlinking" c) (c-unlink-from-used c) (when (typep c 'cell) (dolist (caller (c-callers c)) + (setf (c-value-state caller) :uncurrent) (c-unlink-caller c caller))) (trc nil "cell quiesce nulled cell awake" c))))

@@ -70,6 +71,6 @@

(defmacro make-kid (class &rest initargs) `(make-instance ,class - :fm-parent (progn (assert self) self) - ,@initargs)) + ,@initargs + :fm-parent (progn (assert self) self)))

--- /project/cells/cvsroot/cells/model-object.lisp 2006/10/02 02:38:31 1.12 +++ /project/cells/cvsroot/cells/model-object.lisp 2006/10/17 21:28:39 1.13 @@ -178,7 +178,7 @@ (if entry (progn (setf (cdr entry) new-type) - (loop for c in (mop:class-direct-subclasses (find-class class-name)) + (loop for c in (class-direct-subclasses (find-class class-name)) do (setf (md-slot-cell-type (class-name c) slot-name) new-type))) (push (cons slot-name new-type) (get class-name :cell-types)))))

@@ -194,7 +194,7 @@ (if entry (progn (setf (cdr entry) value) - (loop for c in (mop:class-direct-subclasses (find-class class-name)) + (loop for c in (class-direct-subclasses (find-class class-name)) do (setf (md-slot-owning (class-name c) slot-name) value))) (push (cons slot-name value) (get class-name :ownings)))))

--- /project/cells/cvsroot/cells/propagate.lisp 2006/10/11 22:16:22 1.23 +++ /project/cells/cvsroot/cells/propagate.lisp 2006/10/17 21:28:39 1.24 @@ -72,7 +72,7 @@ (when *stop* (princ #.)(princ #!) (return-from c-propagate)) - (trc nil "c-propagate> propping" c (c-value c) :caller-ct (length (c-callers c)) c) + (trc c "c-propagate> !!!!!!!!!!!!!! propping" c (c-value c) :caller-ct (length (c-callers c)) c)

(when *c-debug* (when (> *c-prop-depth* 250) @@ -168,9 +168,12 @@ ; but B is busy eagerly propagating. "This time" is important because it means ; there is no way one can reliably be sure H will not ask for A ; - (when (c-callers c) - (trc nil "c-propagate-to-callers > queueing" c) - (let ((causation (cons c *causation*))) ;; in case deferred + (when (find-if-not (lambda (caller) + (and (c-lazy caller) ;; slight optimization + (member (c-lazy caller) '(t :always :once-asked)))) + (c-callers c)) + (let ((causation (cons c *causation*)) ;; in case deferred + ) (with-integrity (:tell-dependents c) (assert (null *call-stack*)) (let ((*causation* causation)) --- /project/cells/cvsroot/cells/trc-eko.lisp 2006/10/06 08:01:10 1.3 +++ /project/cells/cvsroot/cells/trc-eko.lisp 2006/10/17 21:28:39 1.4 @@ -126,6 +126,14 @@ (trc ,(car trcargs) :=> ,result ,@(cdr trcargs)) ,result)))

+(defmacro ekx (ekx-id &rest body) + (let ((result (gensym))) + `(let ((,result (,@body))) + (trc ,(string-downcase (symbol-name ekx-id)) :=> ,result) + ,result))) + +(export! ekx) + (defmacro eko-if ((&rest trcargs) &rest body) (let ((result (gensym))) `(let ((,result ,@body))