Update of /project/cells/cvsroot/cells/utils-kt In directory clnet:/tmp/cvs-serv8789/utils-kt
Modified Files: core.lisp debug.lisp detritus.lisp flow-control.lisp Log Message: nothing special
--- /project/cells/cvsroot/cells/utils-kt/core.lisp 2008/04/23 03:20:10 1.9 +++ /project/cells/cvsroot/cells/utils-kt/core.lisp 2008/06/16 12:38:04 1.10 @@ -46,41 +46,26 @@ value))) ,@(when docstring (list docstring)))))
- -(export! exe-path exe-dll font-path) - -#-iamnotkenny -(defun exe-path () - #+its-alive! - (excl:current-directory) - #-its-alive! +(defun test-setup (&optional drib) + #+(and allegro ide) + (ide.base::find-new-prompt-command + (cg.base::find-window :listener-frame)) + (when drib + (dribble (merge-pathnames + (make-pathname :name drib :type "TXT") + (project-path))))) + +(export! test-setup test-prep test-init) +(export! project-path) +(defun project-path () + #+(and allegro ide) (excl:path-pathname (ide.base::project-file ide.base:*current-project*)))
-#-iamnotkenny -(defun font-path () - (merge-pathnames - (make-pathname - :directory #+its-alive! (list :relative "font") - #-its-alive! (append (butlast (pathname-directory - (exe-path) - )) - (list "TY Extender" "font"))) - (exe-path))) - #+test -(list (exe-path)(font-path)) +(test-setup)
-(defmacro exe-dll (&optional filename) - (assert filename) - (concatenate 'string filename ".dll")) +(defun test-prep (&optional drib) + (test-setup drib))
-#+chya -(defun exe-dll (&optional filename) - (merge-pathnames - (make-pathname :name filename :type "DLL" - :directory (append (butlast (pathname-directory (exe-path))) - (list "dll"))) - (exe-path))) - -#+test -(probe-file (exe-dll "openal32")) +(defun test-init (&optional drib) + (test-setup drib)) \ No newline at end of file --- /project/cells/cvsroot/cells/utils-kt/debug.lisp 2008/03/15 15:18:34 1.19 +++ /project/cells/cvsroot/cells/utils-kt/debug.lisp 2008/06/16 12:38:04 1.20 @@ -55,13 +55,13 @@
(defmacro count-it (&rest keys) (declare (ignorable keys)) - #+(or) `(progn) - `(when (car *counting*) + `(progn) + #+(or) `(when (car *counting*) (call-count-it ,@keys)))
(defun call-count-it (&rest keys) (declare (ignorable keys)) - (when (find (car keys) '(:trcfailed :TGTNILEVAL)) + #+nahh (when (find (car keys) '(:trcfailed :TGTNILEVAL)) (break "clean up time ~a" keys)) (let ((entry (assoc keys *count* :test #'equal))) (if entry @@ -85,6 +85,7 @@ (when clearp (count-clear "show-count")))
+ ;-------------------- timex ---------------------------------
(export! timex) --- /project/cells/cvsroot/cells/utils-kt/detritus.lisp 2008/03/15 15:18:34 1.20 +++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp 2008/06/16 12:38:04 1.21 @@ -59,30 +59,6 @@ (defun collect-if (test list) (remove-if-not test list))
-(defun test-setup (&optional drib) - #-(or iamnotkenny its-alive!) - (ide.base::find-new-prompt-command - (cg.base::find-window :listener-frame)) - (when drib - (dribble (merge-pathnames - (make-pathname :name drib :type "TXT") - (project-path))))) - -(export! project-path) -(defun project-path () - #+allegro (excl:path-pathname (ide.base::project-file ide.base:*current-project*))) - -#+test -(test-setup) - -(defun test-prep (&optional drib) - (test-setup drib)) - -(defun test-init (&optional drib) - (test-setup drib)) - -(export! test-setup test-prep test-init) - ;;; --- FIFO Queue -----------------------------
(defun make-fifo-queue (&rest init-data) --- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp 2008/03/15 15:18:34 1.13 +++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp 2008/06/16 12:38:04 1.14 @@ -150,11 +150,15 @@ (defun -1?1 (x) (* -1?1 x))
(defun prime? (n) - (and (> n 1) - (or (= 2 n)(oddp n)) - (loop for d upfrom 3 by 2 to (sqrt n) - when (zerop (mod n d)) return nil - finally (return t)))) + (when (> n 1) + (cond + ((= 2 n) t) + ((evenp n) (values nil 2)) + (t (loop for d upfrom 3 by 2 to (sqrt n) + when (zerop (mod n d)) do (return-from prime? (values nil d)) + finally (return t)))))) + +
; --- cloucell support for struct access of slots ------------------------