[isidorus-cvs] r313 - branches/new-datamodel/playground
Lukas Giessmann
lgiessmann at common-lisp.net
Thu Sep 2 13:57:25 UTC 2010
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
More information about the Isidorus-cvs
mailing list