[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