[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