code/multithreading.lisp (1369 bytes)
1 (in-package :multi) 2 ;;; Work on DEFGLOBAL global lexical variables for SBCL, it is requested! Let-pseudoglobals was on the right track, but it looks like the compiler must be modified. 3 (defmacro collect (var-and-list &body body) 4 (let ((collector (gensym))) 5 `(let ((,collector nil)) 6 (dolist (,(car var-and-list) ,(car (cdr var-and-list))) 7 (setf ,collector (cons (progn ,@body) ,collector))) 8 (reverse ,collector)))) 9 (defun drakma-no-octets (url) 10 (let ((result (drakma:http-request url))) 11 (if (stringp result) 12 result 13 (drakma::octets-to-string result)))) 14 (defun getpage (uri) 15 "Uri should be 'http(s)://domainname.blah.toplevel/blah/blah/blah'" 16 (drakma-no-octets uri)) 17 (defun multiuri (&rest urilist) 18 "Deprecated function, use `uri' instead!" 19 (progn (warn "Multiuri is deprecated, use `uri' instead. Consider: 20 multi::multiuri vs multi:uri. Isn't that a better name?") 21 (apply #'uri urilist))) 22 (defun uri (&rest urilist) 23 (let ((lock (gensym)) 24 (list (gensym)) 25 (uri (gensym))) 26 (setf lock (make-lock)) ;a gensym 27 (setf list nil) 28 (let ((thread-list (collect (var urilist) 29 (setf uri var) 30 (make-thread (lambda () 31 (let ((result (getpage uri))) 32 (with-lock-held (lock) 33 (setf list (cons result list))))) 34 :name uri)))) 35 (dolist (thread thread-list list) 36 (join-thread thread)))))