cells-cvs

cells-cvs@common-lisp.net

721 discussions

06 Dec '04

Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root/cells-gtk/test-gtk Removed Files: test-addon.lisp test-buttons.lisp test-dialogs.lisp test-display.lisp test-entry.lisp test-gtk.asd test-gtk.lisp test-layout.lisp test-menus.lisp test-textview.lisp test-tree-view.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:28:34 2004 Author: ktilton

1 0

06 Dec '04

Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root/cells-gtk Removed Files: actions.lisp addon.lisp buttons.lisp callback.lisp cells-gtk.asd cells-gtk.lisp dialogs.lisp display.lisp entry.lisp gtk-app.lisp layout.lisp menus.lisp textview.lisp tree-view.lisp widgets.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:28:21 2004 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/cells-gtk-root/INSTALL.TXT cell-cultures/cells-gtk-root/asdf.lisp cell-cultures/cells-gtk-root/load.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root Removed Files: INSTALL.TXT asdf.lisp load.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:28:18 2004 Author: ktilton

1 0

[cells-cvs] CVS update: cell-cultures/ffi-extender/definers.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells/cvsroot/cell-cultures/ffi-extender In directory common-lisp.net:/tmp/cvs-serv26849/ffi-extender Modified Files: definers.lisp Log Message: Add one dependency to ASDF, plus minor stuff to port cells-gtk to Lispworks Date: Mon Dec 6 21:26:09 2004 Author: ktilton Index: cell-cultures/ffi-extender/definers.lisp diff -u cell-cultures/ffi-extender/definers.lisp:1.2 cell-cultures/ffi-extender/definers.lisp:1.3 --- cell-cultures/ffi-extender/definers.lisp:1.2 Sun Dec 5 05:50:55 2004 +++ cell-cultures/ffi-extender/definers.lisp Mon Dec 6 21:26:08 2004 @@ -20,13 +20,15 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.2 2004/12/05 04:50:55 ktilton Exp $ +;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.3 2004/12/06 20:26:08 ktilton Exp $ (defpackage :ffi-extender (:nicknames :ffx)) +(in-package :ffx) + (eval-when (compile load eval) (export '( defun-ffx defun-ffx-multi @@ -37,10 +39,6 @@ make-ff-pointer ff-pointer-address ))) - - - -(in-package :ffx) (defun ff-pointer-address (ff-ptr) #-lispworks ff-ptr

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells.asd cell-cultures/cells/integrity.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv26849/cells Modified Files: cells.asd integrity.lisp Log Message: Add one dependency to ASDF, plus minor stuff to port cells-gtk to Lispworks Date: Mon Dec 6 21:26:07 2004 Author: ktilton Index: cell-cultures/cells/cells.asd diff -u cell-cultures/cells/cells.asd:1.4 cell-cultures/cells/cells.asd:1.5 --- cell-cultures/cells/cells.asd:1.4 Sun Dec 5 05:50:32 2004 +++ cell-cultures/cells/cells.asd Mon Dec 6 21:26:06 2004 @@ -18,7 +18,7 @@ (:file "defpackage") (:file "cells" :depends-on ("defpackage")) (:file "cell-types" :depends-on ("defpackage")) - (:file "integrity" :depends-on ("cell-types")) + (:file "integrity" :depends-on ("cell-types" "cells")) (:file "constructors" :depends-on ("integrity" "cells")) (:file "initialize" :depends-on ("cells" "cell-types")) (:file "md-slot-value" :depends-on ("integrity" "cell-types")) Index: cell-cultures/cells/integrity.lisp diff -u cell-cultures/cells/integrity.lisp:1.4 cell-cultures/cells/integrity.lisp:1.5 --- cell-cultures/cells/integrity.lisp:1.4 Fri Jul 9 05:53:04 2004 +++ cell-cultures/cells/integrity.lisp Mon Dec 6 21:26:06 2004 @@ -106,6 +106,8 @@ (defun finish-business (&aux task some-output setfs (setf-ct 0)) (declare (ignorable setfs)) + (assert (ufb-queue :user-notify)) + (assert (consp (ufb-queue :user-notify))) (tagbody notify-users ;--- notify users ------------------------------ @@ -126,7 +128,7 @@ (cond (task (setf some-output t) - (trc nil "finish-business outputting--------------------------") + (trc nil "finish-business outputting------------------------") (funcall task) (go next-output)) (some-output

1 0

[cells-cvs] CVS update: cell-cultures/utils-kt/utils-kt.asd
by ktilton＠common-lisp.net 05 Dec '04

05 Dec '04

Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv7571/utils-kt Modified Files: utils-kt.asd Log Message: Cleaning up Date: Sun Dec 5 05:51:03 2004 Author: ktilton Index: cell-cultures/utils-kt/utils-kt.asd diff -u cell-cultures/utils-kt/utils-kt.asd:1.1 cell-cultures/utils-kt/utils-kt.asd:1.2 --- cell-cultures/utils-kt/utils-kt.asd:1.1 Fri Nov 12 23:47:24 2004 +++ cell-cultures/utils-kt/utils-kt.asd Sun Dec 5 05:51:02 2004 @@ -17,9 +17,9 @@ :description "Kenny's Utilities" :long-description "Low-level utilities used by all of Kenny's projects" :components ((:file "defpackage") - (:file "debug") - (:file "detritus") - (:file "flow-control") + (:file "debug") + (:file "detritus") + (:file "flow-control") (:file "strings"))) (defmethod perform ((o load-op) (c (eql (find-system :utils-kt))))

1 0

[cells-cvs] CVS update: cell-cultures/ffi-extender/arrays.lisp cell-cultures/ffi-extender/callbacks.lisp cell-cultures/ffi-extender/definers.lisp cell-cultures/ffi-extender/ffi-extender.lpr
by ktilton＠common-lisp.net 05 Dec '04

05 Dec '04

Update of /project/cells/cvsroot/cell-cultures/ffi-extender In directory common-lisp.net:/tmp/cvs-serv7571/ffi-extender Modified Files: arrays.lisp callbacks.lisp definers.lisp ffi-extender.lpr Log Message: Cleaning up Date: Sun Dec 5 05:50:56 2004 Author: ktilton Index: cell-cultures/ffi-extender/arrays.lisp diff -u cell-cultures/ffi-extender/arrays.lisp:1.3 cell-cultures/ffi-extender/arrays.lisp:1.4 --- cell-cultures/ffi-extender/arrays.lisp:1.3 Wed Nov 17 13:31:51 2004 +++ cell-cultures/ffi-extender/arrays.lisp Sun Dec 5 05:50:54 2004 @@ -20,18 +20,11 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -(defpackage :ffi-extender - (:nicknames :ffx) - (:export - #:ff-elt #:ff-list - #:eltf #:eltd #:elti #:fgn-pa - #:with-ff-array-elements - #:make-ff-array - #:make-floatv #:ff-floatv-ensure - #:ffx-reset #:fgn-alloc #:fgn-free #:gllog #:glfree)) -(in-package :ffx) + +(in-package :ffx) + (defparameter *gl-rsrc* nil) (defparameter *fgn-mem* nil) @@ -188,4 +181,13 @@ (setf (ff-elt v :double n) (coerce value 'double-float))) (defmacro fgn-pa (pa n) - `(uffi:deref-array ,pa '(:array (* :void)) ,n)) \ No newline at end of file + `(uffi:deref-array ,pa '(:array (* :void)) ,n)) + +(eval-when (compile load eval) + (export '( + ff-elt ff-list + eltf eltd elti fgn-pa + with-ff-array-elements + make-ff-array + make-floatv ff-floatv-ensure + ffx-reset fgn-alloc fgn-free gllog glfree))) \ No newline at end of file Index: cell-cultures/ffi-extender/callbacks.lisp diff -u cell-cultures/ffi-extender/callbacks.lisp:1.2 cell-cultures/ffi-extender/callbacks.lisp:1.3 --- cell-cultures/ffi-extender/callbacks.lisp:1.2 Wed Nov 17 13:31:51 2004 +++ cell-cultures/ffi-extender/callbacks.lisp Sun Dec 5 05:50:54 2004 @@ -21,16 +21,6 @@ ;;; IN THE SOFTWARE. -(defpackage :ffi-extender - (:nicknames :ffx) - (:export - #:ff-register-callable - #:ff-defun-callable - #:ff-def-call - #:ff-pointer-address - )) - - (in-package :ffx) (defun ff-register-callable (callback-name) @@ -43,27 +33,23 @@ (defmacro ff-defun-callable (call-convention result-type name args &body body) (declare (ignorable result-type)) -#+lispworks - `(fli:define-foreign-callable - (,(symbol-name name) :result-type ,result-type :calling-convention ,call-convention) - (,@args) - ,@body) -#+allegro - `(ff:defun-foreign-callable ,name ,args - (declare (:convention ,(ecase call-convention - (:cdecl :c) - (:stdcall :stdcall)))) - ,@body)) - - -#+test ;; lw-sample -(fli:define-foreign-callable - ("square" :result-type :int) - ((arg-1 :int)) (* arg-1 arg-1)) + (let ((native-args (uffi::process-function-args args))) + #+lispworks + `(fli:define-foreign-callable + (,(symbol-name name) :result-type ,result-type :calling-convention ,call-convention) + (,@native-args) + ,@body) + #+allegro + `(ff:defun-foreign-callable ,name ,native-args + (declare (:convention ,(ecase call-convention + (:cdecl :c) + (:stdcall :stdcall)))) + ,@body))) + #+test -(ff-defun-callable :cdecl :int square ((arg-1 :int)) - (* arg-1 arg-1)) +(ff-defun-callable :cdecl :int square ((arg-1 :int)(data (* :void))) + (list data (* arg-1 arg-1))) (defmacro ff-def-call ((module iname ename) args) #+cormanlisp @@ -87,3 +73,9 @@ :module ,module :result-type :int)) + +(eval-when (compile load eval) + (export '(ff-register-callable + ff-defun-callable + ff-def-call + ff-pointer-address))) \ No newline at end of file Index: cell-cultures/ffi-extender/definers.lisp diff -u cell-cultures/ffi-extender/definers.lisp:1.1 cell-cultures/ffi-extender/definers.lisp:1.2 --- cell-cultures/ffi-extender/definers.lisp:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ffi-extender/definers.lisp Sun Dec 5 05:50:55 2004 @@ -20,22 +20,25 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.1 2004/06/26 18:38:42 ktilton Exp $ +;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.2 2004/12/05 04:50:55 ktilton Exp $ + -(defpackage :ffi-extender - (:nicknames :ffx) - (:export - - #:defun-ffx #:defun-ffx-multi - #:dffr - #:dfc - #:dft - #:dfenum - #:make-ff-pointer - #:ff-pointer-address - )) +(defpackage :ffi-extender + (:nicknames :ffx)) +(eval-when (compile load eval) + (export '( + defun-ffx defun-ffx-multi + dffr + dfc + dft + dfenum + make-ff-pointer + ff-pointer-address + ))) + + (in-package :ffx) Index: cell-cultures/ffi-extender/ffi-extender.lpr diff -u cell-cultures/ffi-extender/ffi-extender.lpr:1.1 cell-cultures/ffi-extender/ffi-extender.lpr:1.2 --- cell-cultures/ffi-extender/ffi-extender.lpr:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ffi-extender/ffi-extender.lpr Sun Dec 5 05:50:55 2004 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "6.2 [Windows] (Jun 26, 2002 11:39)"; common-graphics: "1.389.2.105.2.14"; -*- +;; -*- lisp-version: "6.2 [Windows] (Sep 3, 2004 12:04)"; common-graphics: "1.389.2.105.2.14"; -*- (in-package :common-graphics-user) @@ -9,7 +9,8 @@ :modules (list (make-instance 'module :name "definers.lisp") (make-instance 'module :name "callbacks.lisp") (make-instance 'module :name "arrays.lisp")) - :projects nil + :projects (list (make-instance 'project-module :name + "c:\\000000\\uffi\\uffi")) :libraries nil :distributed-files nil :project-package-name :ffi-extender

1 0

[cells-cvs] CVS update: cell-cultures/config/cl-ftgl-config.lisp
by ktilton＠common-lisp.net 05 Dec '04

05 Dec '04

Update of /project/cells/cvsroot/cell-cultures/config In directory common-lisp.net:/tmp/cvs-serv7571/config Modified Files: cl-ftgl-config.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:50 2004 Author: ktilton Index: cell-cultures/config/cl-ftgl-config.lisp diff -u cell-cultures/config/cl-ftgl-config.lisp:1.2 cell-cultures/config/cl-ftgl-config.lisp:1.3 --- cell-cultures/config/cl-ftgl-config.lisp:1.2 Fri Oct 1 06:01:32 2004 +++ cell-cultures/config/cl-ftgl-config.lisp Sun Dec 5 05:50:49 2004 @@ -35,6 +35,6 @@ #+linux '(:absolute "usr" "share" "fonts" "truetype") :type "ttf")) -(setq *gui-style-default-face* 'sylfaen) +(setq *gui-style-default-face* 'symbol) ;; 'sylfaen) (setq *gui-style-button-face* 'arialn)

1 0

[cells-cvs] CVS update: cell-cultures/cl-ftgl/cl-ftgl.lisp
by ktilton＠common-lisp.net 05 Dec '04

05 Dec '04

Update of /project/cells/cvsroot/cell-cultures/cl-ftgl In directory common-lisp.net:/tmp/cvs-serv7571/cl-ftgl Modified Files: cl-ftgl.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:46 2004 Author: ktilton Index: cell-cultures/cl-ftgl/cl-ftgl.lisp diff -u cell-cultures/cl-ftgl/cl-ftgl.lisp:1.6 cell-cultures/cl-ftgl/cl-ftgl.lisp:1.7 --- cell-cultures/cl-ftgl/cl-ftgl.lisp:1.6 Wed Nov 17 13:31:36 2004 +++ cell-cultures/cl-ftgl/cl-ftgl.lisp Sun Dec 5 05:50:41 2004 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.6 2004/11/17 12:31:36 ktilton Exp $ +;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.7 2004/12/05 04:50:41 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -178,11 +178,17 @@ #+test (cl-ftgl-test) +(defvar *start*) +(defvar *frames*) +(defun now () (/ (get-internal-real-time) internal-time-units-per-second)) + (defun cl-ftgl-test () + (setf *start* (now) + *frames* 0) (cl-ftgl-reset) (setq *test-fonts* (mapcar (lambda (mode) - (cons mode (ftgl-make mode *gui-style-default-face* 36 96 18))) + (cons mode (ftgl-make mode *gui-style-default-face* 48 96 18))) '(:texture :pixmap :bitmap :outline :polygon :extruded))) (ogl::lesson-14 'cl-ftgl-test-disp-fc)) @@ -194,7 +200,7 @@ (defun cl-ftgl-test-disp () - + (incf *frames*) (gl-load-identity) ;; Reset The Current Modelview Matrix (gl-clear-color 0.0 0.0 0.0 0.5) (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit)) @@ -209,7 +215,9 @@ (gl-disable gl_lighting) (gl-translatef -100 -200 0) (gl-enable gl_texture_2d) - (ftgl-render (test-font :texture) "un-rotated texture") + (ftgl-render (test-font :texture) + (format nil "texture ~d" (floor (/ *frames* + (max 1 (- (now) *start*)))))) (gl-translatef 100 200 0) (gl-translatef -100 200 0)

1 0

[cells-cvs] CVS update: cell-cultures/cells/cell-types.lisp cell-cultures/cells/cells.asd cell-cultures/cells/md-slot-value.lisp cell-cultures/cells/md-utilities.lisp cell-cultures/cells/optimization.lisp cell-cultures/cells/propagate.lisp
by ktilton＠common-lisp.net 05 Dec '04

05 Dec '04

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv7571/cells Modified Files: cell-types.lisp cells.asd md-slot-value.lisp md-utilities.lisp optimization.lisp propagate.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:33 2004 Author: ktilton Index: cell-cultures/cells/cell-types.lisp diff -u cell-cultures/cells/cell-types.lisp:1.2 cell-cultures/cells/cell-types.lisp:1.3 --- cell-cultures/cells/cell-types.lisp:1.2 Sun Jul 4 20:59:41 2004 +++ cell-cultures/cells/cell-types.lisp Sun Dec 5 05:50:32 2004 @@ -79,14 +79,51 @@ :initial-element 0) :type vector)) (defstruct (c-stream - (:include c-ruled) + (:include c-dependent) (:conc-name cs-)) values) -;;; (defmacro cell~ (&body body) -;;; `(make-c-stream -;;; :rule (lambda ,@*c-lambda* -;;; ,@body))) +(defstruct streamer from stepper donep to) + +#+notyet +(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)) + +#+test +(progn + (defmodel streamertest () + ((val :accessor val :initform (c~~~ :from 0 :to (^oval))) + (oval :initarg :oval :accessor oval :initform (c-in 0)))) + + (def-c-output val ((self streamertest)) + (print `(streamertest old ,old-value new ,new-value))) + + (cell-reset) + (let ((it (make-be 'streamertest :oval 5))) + ;;(setf (oval it) 5) + it)) (defstruct (c-drifter (:include c-dependent))) Index: cell-cultures/cells/cells.asd diff -u cell-cultures/cells/cells.asd:1.3 cell-cultures/cells/cells.asd:1.4 --- cell-cultures/cells/cells.asd:1.3 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/cells.asd Sun Dec 5 05:50:32 2004 @@ -18,9 +18,9 @@ (:file "defpackage") (:file "cells" :depends-on ("defpackage")) (:file "cell-types" :depends-on ("defpackage")) - (:file "integrity" :depends-on ("defpackage")) + (:file "integrity" :depends-on ("cell-types")) (:file "constructors" :depends-on ("integrity" "cells")) - (:file "initialize" :depends-on ("cells")) + (:file "initialize" :depends-on ("cells" "cell-types")) (:file "md-slot-value" :depends-on ("integrity" "cell-types")) (:file "slot-utilities" :depends-on ("cells")) (:file "optimization" :depends-on ("cells")) @@ -33,7 +33,7 @@ (:file "md-utilities" :depends-on ("cells")) (:file "family" :depends-on ("defmodel")) (:file "fm-utilities" :depends-on ("cells")) - (:file "family-values" :depends-on ("propagate" "defmodel" )) + (:file "family-values" :depends-on ("family" "propagate" "defmodel" )) (:file "test" :depends-on ("family")) )) Index: cell-cultures/cells/md-slot-value.lisp diff -u cell-cultures/cells/md-slot-value.lisp:1.4 cell-cultures/cells/md-slot-value.lisp:1.5 --- cell-cultures/cells/md-slot-value.lisp:1.4 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/md-slot-value.lisp Sun Dec 5 05:50:32 2004 @@ -140,12 +140,15 @@ (if c (when (find c *causation*) - (if (c-cyclicp c) + (case (c-cyclicp c) + (:run-on (trc "cyclicity running on" c)) + ((t) (progn - (trc nil "cyclicity handled gracefully" c) + (trc "cyclicity handled gracefully" c) (c-pulse-update c :cyclicity-1) - (return-from md-slot-value new-value)) - (c-break "(setf md-slot-value) setf looping ~a ~a" c *causation*))) + (return-from md-slot-value new-value))) + (otherwise + (c-break "(setf md-slot-value) setf looping ~a ~a" c *causation*)))) (progn (c-break "(setf md-slot-value)> cellular slot ~a of ~a cannot be setf unless initialized as inputp" slot-name self))) @@ -158,7 +161,9 @@ new-value) -(defun md-slot-value-assume (c raw-value) + + +(defmethod md-slot-value-assume (c raw-value) (assert c) (trc nil "md-slot-value-assume entry:" c raw-value) (bif (c-pos (position c *causation*)) @@ -185,7 +190,8 @@ (c-value-state c) :valid (c-state c) :awake) - (c-optimize-away?! c) ;;; put optimize test here to avoid needless linking + (unless (typep c 'c-stream) ;; c-stream needs to run out first stream at least + (c-optimize-away?! c)) ;;; put optimize test here to avoid needless linking ; --- data flow propagation ----------- Index: cell-cultures/cells/md-utilities.lisp diff -u cell-cultures/cells/md-utilities.lisp:1.3 cell-cultures/cells/md-utilities.lisp:1.4 --- cell-cultures/cells/md-utilities.lisp:1.3 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/md-utilities.lisp Sun Dec 5 05:50:32 2004 @@ -102,4 +102,5 @@ self) (defun make-be (class &rest initargs) - (to-be (apply 'make-instance class initargs))) \ No newline at end of file + (to-be (apply 'make-instance class initargs))) + Index: cell-cultures/cells/optimization.lisp diff -u cell-cultures/cells/optimization.lisp:1.1 cell-cultures/cells/optimization.lisp:1.2 --- cell-cultures/cells/optimization.lisp:1.1 Sat Jun 26 20:38:36 2004 +++ cell-cultures/cells/optimization.lisp Sun Dec 5 05:50:32 2004 @@ -31,12 +31,13 @@ (typecase c (c-dependent (if (and *c-optimizep* + (not (c-optimized-away-p c)) ;; c-streams 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) (null (cd-useds c))) (progn - (trc nil "optimizing away" c) + (trc nil "optimizing away" c (c-state c)) (count-it :c-optimized) (setf (c-state c) :optimized-away) Index: cell-cultures/cells/propagate.lisp diff -u cell-cultures/cells/propagate.lisp:1.4 cell-cultures/cells/propagate.lisp:1.5 --- cell-cultures/cells/propagate.lisp:1.4 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/propagate.lisp Sun Dec 5 05:50:32 2004 @@ -161,7 +161,7 @@ (format t "~&output ~d (~a ~a) old: ~a" ,temp1 ',slotname ,loc-self ,oldvarg)) (format t "~&output ~d (~a ~a) new: ~a" ,temp1 ',slotname ,loc-self ,new-varg)))) `(defmethod c-output-slot-name - #-(or clisp cormanlisp) progn + #-(or clisp cormanlisp) progn #+(or clisp cormanlisp) :around ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp) (declare (ignorable ,@(flet ((arg-name (arg-spec) @@ -170,7 +170,8 @@ (atom arg-spec)))) (list (arg-name self-arg)(arg-name new-varg) (arg-name oldvarg)(arg-name oldvargboundp))))) - ,@output-body)))) + ,@output-body + #+(or clisp cormanlisp) (call-next-method))))) (defmacro bump-output-count (slotname) ;; pure test func `(if (get ',slotname :outputs)

1 0

← Newer
1
...
50
51
52
53
54
55
56
...
73
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

cells-cvs