Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv10097
Modified Files: link.lisp md-slot-value.lisp Log Message: Mo' better tuning, esp. of c-link-ex Date: Sat May 21 17:13:12 2005 Author: ktilton
Index: cells/link.lisp diff -u cells/link.lisp:1.3 cells/link.lisp:1.4 --- cells/link.lisp:1.3 Thu May 19 22:17:47 2005 +++ cells/link.lisp Sat May 21 17:13:12 2005 @@ -22,11 +22,14 @@
(in-package :cells)
+(eval-when (compile load) + (proclaim '(optimize (speed 3) (safety 0) (space 0) (debug 0)))) + + (defun c-link-ex (used &aux (user (car *c-calculators*))) (c-assert user) - (assert used) - (when (or (c-optimized-away-p used) - (not (typep used 'cell))) + (c-assert used) + (when (c-optimized-away-p used) ;; 2005-05-21 removed slow type check that used is cell (return-from c-link-ex nil))
@@ -43,51 +46,55 @@ (c-assert (not (eq :eternal-rest (md-state (c-model used))))) (count-it :c-link-entry)
-;;; (loop for ku in (c-usesds user) -;;; for posn upfrom 0 -;;; wh - -;;; (loop with prior-used = 0 -;;; and found = nil -;;; for known-used in (c-useds user) -;;; when (eq known-used used) -;;; do (progn -;;; (setf found t) -;;; (loop-finish)) -;;; finally (return (- *cd-usagect* -;;; (- (length (cd-useds user)) -;;; (or (position used (cd-useds user)) 0))))) - - (if (find used (c-useds user)) - (count-it :known-used) - (progn + (multiple-value-bind (used-pos useds-len) + (loop with u-pos + for known in (cd-useds user) + counting known into length + ;; do (print (list :data known length)) + when (eq used known) + do + (count-it :known-used) + (setf u-pos (1- length)) + finally (return (values u-pos length))) + + (when (null used-pos) (trc nil "c-link > new user,used " user used) (count-it :new-used) + (incf useds-len) + (setf used-pos 0) (push user (c-users used)) - (push used (cd-useds user)))) + (push used (cd-useds user)))
- (let ((mapn (get-mapn used (cd-useds user)) - #+not (- *cd-usagect* - (- (length (cd-useds user)) - (or (position used (cd-useds user)) 0))))) - ;; (trc user "c-link> setting usage bit" user mapn used) - (if (minusp mapn) - (c-break "whoa. more than ~d used by ~a? i see ~d" - *cd-usagect* user (length (cd-useds user))) - (cd-usage-set user mapn))) + (let ((mapn (- *cd-usagect* + (- useds-len used-pos)))) + ;; (trc user "c-link> setting usage bit" user mapn used) + (if (minusp mapn) + (c-break "whoa. more than ~d used by ~a? i see ~d" + *cd-usagect* user (length (cd-useds user))) + (cd-usage-set user mapn)))) used) - +#+test +(dotimes (used 3) + (print (multiple-value-bind (p l) + (loop with u-pos + for known in '(0 2) + counting known into length + ;; do (print (list :data known length)) + when (eql used known) do (setf u-pos (1- length)) + finally (return (values u-pos length))) + (list p l)))) #+TEST (dotimes (n 3) (trc "mapn" n (get-mapn n '(0 1 2))))
(defun get-mapn (seek map) + (declare (fixnum *cd-usagect*)) (- *cd-usagect* (loop with seek-pos = nil for m in map - for pos upfrom 0 - counting m into m-len - when (eql seek m) + for pos fixnum upfrom 0 + counting m into m-len fixnum + when (eq seek m) do (setf seek-pos pos) finally (return (- m-len seek-pos)))))
Index: cells/md-slot-value.lisp diff -u cells/md-slot-value.lisp:1.7 cells/md-slot-value.lisp:1.8 --- cells/md-slot-value.lisp:1.7 Sat May 21 03:40:53 2005 +++ cells/md-slot-value.lisp Sat May 21 17:13:12 2005 @@ -58,7 +58,13 @@ ((c-inputp c)) ((c-currentp c)) ((or (not (c-validp c)) - (c-influenced-by-pulse c)) + (some (lambda (used) + (c-value-ensure-current used) + (when (and (c-changed used) (> (c-pulse used)(c-pulse c))) + #+chya (trc nil "used changed" used :asker c + :inpulse ip :pulse *data-pulse-id*) + t)) + (cd-useds c))) (c-calculate-and-set c)) (t (c-pulse-update c :valid-uninfluenced)))
@@ -67,18 +73,7 @@ (error 'unbound-cell :instance (c-model c) :name (c-slot-name c)))
(c-value c)) - -(defun c-influenced-by-pulse (c); &aux (ip *data-pulse-id*)) - (unless (c-currentp c) - (count-it :c-influenced-by-pulse) - (trc nil "c-influenced-by-pulse> " c (c-useds c)) - (some (lambda (used) - (c-value-ensure-current used) - (when (and (c-changed used) (> (c-pulse used)(c-pulse c))) - #+chya (trc nil "used changed" used :asker c - :inpulse ip :pulse *data-pulse-id*) - t)) - (c-useds c)))) + ;; 2005-05-21 was c-useds, but I think these are c-dependents
(defun c-calculate-and-set (c) (flet ((body ()