Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv7851
Modified Files: cell-types.lisp cells.lisp md-slot-value.lisp optimization.lisp Log Message: Most interesting, sloght change to md-slot-value-assume, to abort unchanged assignment a whisker sooner.
--- /project/cells/cvsroot/cells/cell-types.lisp 2006/05/20 06:32:19 1.9 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/06/10 22:16:35 1.10 @@ -103,40 +103,6 @@ (usage (make-array 16 :element-type 'bit :initial-element 0) :type simple-bit-vector))
- -(defstruct (c-stream - (:include c-dependent) - (:conc-name cs-)) - values) - -(defstruct streamer from stepper donep to) - -#+(or) -(defmacro c~~~ (&key (from 0) - stepper - (donep (c-lambda (> .cache (streamer-to slot-c)))) - to) - `(make-c-stream - :rule (c-lambda (make-streamer - :from ,from - :stepper ,stepper - :to ,to :donep ,donep)))) - -;;;(defmethod md-slot-value-assume :around ((c c-stream) (s streamer)) -;;; (bif (to (streamer-to s)) -;;; (loop for slot-value = (streamer-from s) -;;; then (bif (stepper (streamer-stepper s)) -;;; (funcall stepper c) -;;; (incf slot-value)) -;;; until (bif (to (streamer-to s)) -;;; (> slot-value to) -;;; (bwhen (donep-test (streamer-donep s)) -;;; (funcall donep-test c))) -;;; do (progn -;;; (print `(assume doing ,slot-value)) -;;; (call-next-method c slot-value)))) -;;; (c-optimize-away?! c)) - (defstruct (c-drifter (:include c-dependent)))
--- /project/cells/cvsroot/cells/cells.lisp 2006/06/03 00:38:04 1.11 +++ /project/cells/cvsroot/cells/cells.lisp 2006/06/10 22:16:35 1.12 @@ -81,7 +81,8 @@ (define-symbol-macro .cause (car *causation*))
-(define-condition unbound-cell (unbound-slot) ()) +(define-condition unbound-cell (unbound-slot) + ((cell :initarg :cell :reader cell :initform nil)))
(defgeneric slot-value-observe (slotname self new old old-boundp) #-(or cormanlisp) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/06/07 22:12:55 1.17 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/06/10 22:16:35 1.18 @@ -70,7 +70,7 @@ (t (c-pulse-update c :valid-uninfluenced)))
(when (c-unboundp c) - (error 'unbound-cell :instance (c-model c) :name (c-slot-name c))) + (error 'unbound-cell :cell c :instance (c-model c) :name (c-slot-name c)))
(c-value c))
@@ -141,7 +141,7 @@ (without-c-dependency (c-propagate c prior-value t)))))))
-;;; --- setf md-slot-value -------------------------------------------------------- +;;; --- setf md.slot.value -------------------------------------------------------- ;;;
(defun (setf md-slot-value) (new-value self slot-name @@ -176,35 +176,33 @@ (let ((prior-state (c-value-state c)) (prior-value (c-value c)) (absorbed-value (c-absorb-value c raw-value))) - + + (c-pulse-update c :slotv-assume) + + ; --- head off unchanged; this got moved earlier on 2006-06-10 --- + (when (and (not (eq propagation-code :propagate)) + (eql prior-state :valid) + (c-no-news c absorbed-value prior-value)) + (trc nil "(setf md-slot-value) > early no news" propagation-code prior-state prior-value absorbed-value) + (count-it :nonews) + (return-from md-slot-value-assume absorbed-value)) + ; --- slot maintenance --- (unless (c-synaptic c) (md-slot-value-store (c-model c) (c-slot-name c) absorbed-value))
; --- cell maintenance --- - (c-pulse-update c :slotv-assume) (setf (c-value c) absorbed-value (c-value-state c) :valid (c-state c) :awake)
- (unless (typep c 'c-stream) ;; c-stream (actually a FNYI) needs to run out first stream at least - (c-optimize-away?! c)) ;;; put optimize test here to avoid needless linking - + (c-optimize-away?! c) ;;; put optimize test here to avoid needless linking
; --- data flow propagation ----------- - ; - (trc nil "md-sv testing propagation" c propagation-code prior-state absorbed-value prior-value) - (if (or (eq propagation-code :no-propagate) ;; possible if c is a cell serving as a synapse between two cells - (and (not (eq propagation-code :propagate)) - (eql prior-state :valid) - (c-no-news c absorbed-value prior-value))) - (progn - (trc nil "(setf md-slot-value) >no news" prior-state (c-no-news c absorbed-value prior-value)) - (count-it :nonews)) - (progn - (setf (c-changed c) t) - (c-propagate c prior-value (eq prior-state :valid)))) ;; until 06-02-13 was (not (eq prior-state :unbound)) + (unless (eq propagation-code :no-propagate) + (setf (c-changed c) t) + (c-propagate c prior-value (eq prior-state :valid))) ;; until 06-02-13 was (not (eq prior-state :unbound))
absorbed-value)))
--- /project/cells/cvsroot/cells/optimization.lisp 2006/05/20 06:32:19 1.6 +++ /project/cells/cvsroot/cells/optimization.lisp 2006/06/10 22:16:35 1.7 @@ -27,7 +27,7 @@ (typecase c (c-dependent (if (and *c-optimizep* - (not (c-optimized-away-p c)) ;; c-streams come this way repeatedly even if optimized away + (not (c-optimized-away-p c)) ;; c-streams (FNYI) may come this way repeatedly even if optimized away (c-validp c) (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around) ;; chop (every (lambda (lbl-syn) (null (cd-useds (cdr lbl-syn)))) (cd-synapses c))