[isidorus-cvs] r313 - branches/new-datamodel/playground

Author: lgiessmann Date: Thu Sep 2 09:57:24 2010 New Revision: 313 Log: added some more examples Modified: branches/new-datamodel/playground/threading_debugging.lisp Modified: branches/new-datamodel/playground/threading_debugging.lisp ============================================================================== --- branches/new-datamodel/playground/threading_debugging.lisp (original) +++ branches/new-datamodel/playground/threading_debugging.lisp Thu Sep 2 09:57:24 2010 @@ -1,3 +1,4 @@ +(require :asdf) (asdf:operate 'asdf:load-op :isidorus) (xml-importer:setup-repository "textgrid.xtm" "data_base" :tm-id "http://ztt.fh-worms.de/textgrid.xtm" @@ -18,6 +19,21 @@ (condition (err) (error (format nil "~a" err))))) +(defun return-all-tmcl-instances-test-handler(&optional param) + "similar to hunchentoot's corresponding handler - but without hunchentoot's + variables, e.g. hunchentoot:content-type, ..." + (declare (ignorable param)) + (handler-case (let ((topic-instances + (isidorus-threading:with-reader-lock + (json-tmcl::return-all-tmcl-instances :revision 0)))) + (json:encode-json-to-string + (map 'list #'(lambda(y) + (map 'list #'d:uri y)) + (map 'list #'d:psis topic-instances)))) + (condition (err) (error (format nil "~a" err))))) + + + (defun return-all-topic-psis-test-handler (&optional param) "similar to hunchentoot's corresponding handler - but without hunchentoot's variables, e.g. hunchentoot:content-type, ..." @@ -33,14 +49,16 @@ (defun programm-1 (thread-fun) + "bordeaux-threads" (defvar *thread-1* (bordeaux-threads:make-thread thread-fun)) (defvar *thread-2* (bordeaux-threads:make-thread thread-fun))) (defun programm-2 (thread-fun) + "bordeaux-threads" (let ((thread-1 nil) (thread-2 nil) - (max-iterations 50)) + (max-iterations 150)) (do ((c1 0 (+ c1 0)) (c2 0 (+ c2 0))) ((and (>= c1 max-iterations) (>= c2 max-iterations))) @@ -54,14 +72,35 @@ (format t "c1: ~a c2: ~a~%" c1 c2))))) +(defun programm-3 (thread-fun) + "sb-thread" + (defvar *thread-3* (sb-thread:make-thread thread-fun)) + (defvar *thread-4* (sb-thread:make-thread thread-fun))) +(defun programm-4 (thread-fun) + "sb-thread" + (let ((thread-1 nil) + (thread-2 nil) + (max-iterations 150)) + (do ((c1 0 (+ c1 0)) + (c2 0 (+ c2 0))) + ((and (>= c1 max-iterations) (>= c2 max-iterations))) + (when (or (not thread-1) (not (sb-thread:thread-alive-p thread-1))) + (setf thread-1 (sb-thread:make-thread thread-fun)) + (incf c1) + (format t "c1: ~a c2: ~a~%" c1 c2)) + (when (or (not thread-2) (not (sb-thread:thread-alive-p thread-2))) + (setf thread-2 (sb-thread:make-thread thread-fun)) + (incf c2) + (format t "c1: ~a c2: ~a~%" c1 c2))))) + (defun main() - (programm-2 #'return-all-tmcl-types-test-handler)) + (programm-4 #'return-all-tmcl-types-test-handler)) (main) \ No newline at end of file
participants (1)
-
Lukas Giessmann