[closure-cvs] CVS update: closure/src/html/html-style.lisp

Eric Marsden emarsden at common-lisp.net
Sun Mar 13 21:02:00 UTC 2005


Update of /project/closure/cvsroot/closure/src/html
In directory common-lisp.net:/tmp/cvs-serv23140/src/html

Modified Files:
	html-style.lisp 
Log Message:
 - Fix use of *STYLE-SHEET-CACHE*/LOCK. Was causing recursive lock attempts
   that were detected by SBCL's mutexes. 

Date: Sun Mar 13 22:01:59 2005
Author: emarsden

Index: closure/src/html/html-style.lisp
diff -u closure/src/html/html-style.lisp:1.3 closure/src/html/html-style.lisp:1.4
--- closure/src/html/html-style.lisp:1.3	Sun Mar 13 19:01:54 2005
+++ closure/src/html/html-style.lisp	Sun Mar 13 22:01:59 2005
@@ -389,22 +389,24 @@
 (defun maybe-parse-style-sheet-from-url (url &key (name "anonymous") 
                                                   (supersheet nil)
                                                   (media-type :all))
-  (mp/with-lock (*style-sheet-cache*/lock)
-    (multiple-value-bind (looked presentp) (gethash url *style-sheet-cache*)
-      (cond (presentp
-             (format T "~&;; Serving style sheet ~S [at ~S] from cache.~%"
-                     name url)
-             looked)
-            (t
-             (format T "~&;; fetching and parsing style sheet ~S [at ~S].~%"
-                     name url)
-             (let ((res (maybe-parse-style-sheet-from-url-aux
-                         url 
-                         :name name 
-                         :supersheet supersheet
-                         :media-type media-type)))
-               (setf (gethash url *style-sheet-cache*) res)
-               res))))))
+  (multiple-value-bind (looked presentp)
+      (mp/with-lock (*style-sheet-cache*/lock)
+          (gethash url *style-sheet-cache*))
+    (cond (presentp
+           (format *debug-io* "~&;; Serving style sheet ~S [at ~S] from cache.~%"
+                   name url)
+           looked)
+          (t
+           (format *debug-io* "~&;; fetching and parsing style sheet ~S [at ~S].~%"
+                   name url)
+           (let ((res (maybe-parse-style-sheet-from-url-aux
+                       url 
+                       :name name 
+                       :supersheet supersheet
+                       :media-type media-type)))
+             (mp/with-lock (*style-sheet-cache*/lock)
+                (setf (gethash url *style-sheet-cache*) res))
+             res)))))
 
 (defun maybe-parse-style-sheet-from-url-aux (url &key (name "anonymous") 
                                                   (supersheet nil)




More information about the Closure-cvs mailing list