Date: Sunday, December 12, 2010 @ 19:19:38 Author: rtoy Path: /project/cmucl/cvsroot/src/code

Modified: intl.lisp

Revert previous change. Instead of caching probe-file, have LOAD-DOMAIN return an appropriate entry instead of returning NIL. This still gets rid of all the stats.

Solution from Paul Foley.

-----------+ intl.lisp | 77 ++++++++++++++++++++++++------------------------------------ 1 file changed, 31 insertions(+), 46 deletions(-)

Index: src/code/intl.lisp diff -u src/code/intl.lisp:1.9 src/code/intl.lisp:1.10 --- src/code/intl.lisp:1.9 Sat Dec 11 17:39:46 2010 +++ src/code/intl.lisp Sun Dec 12 19:19:38 2010 @@ -1,6 +1,6 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-

-;;; $Revision: 1.9 $ +;;; $Revision: 1.10 $ ;;; Copyright 1999-2010 Paul Foley (mycroft@actrix.gen.nz) ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining @@ -23,7 +23,7 @@ ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH ;;; DAMAGE. -(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.9 2010-12-11 22:39:46 rtoy Exp $") +(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.10 2010-12-13 00:19:38 rtoy Exp $")

(in-package "INTL")

@@ -79,49 +79,29 @@ (ash (the (unsigned-byte 8) (read-byte stream)) 8) (the (unsigned-byte 8) (read-byte stream))))

-;; If the domain file doesn't exist because the locale isn't -;; supported, we end up doing a huge number of stats looking for a -;; non-existent file everytime a translation is needed. This is -;; really expensive. So create a cache to hold the results. -(let ((domain-file-cache (make-hash-table :test 'equal))) - (defun get-domain-file-cache () - ;; Mostly for debugging to let the user get at the cache. - domain-file-cache) - (defun clear-domain-file-cache () - ;; Mostly for debugging. But also useful if we now have installed - ;; some new translations. - (clrhash domain-file-cache)) - (defun locate-domain-file (domain locale locale-dir) - ;; The default locale-dir includes search lists. If we get called - ;; before the search lists are initialized, we lose. The search - ;; lists are initialized in environment-init, which sets - ;; *environment-list-initialized*. This way, we return NIL to - ;; indicate there's no domain file to use. - (when lisp::*environment-list-initialized* - (flet ((path (locale base) - (merge-pathnames (make-pathname :directory (list :relative locale - "LC_MESSAGES") - :name domain :type "mo") - base)) - (memoized-probe-file (p) - ;; Cache the results of probe-file and return the - ;; cached value when possible. - (multiple-value-bind (value foundp) - (gethash p domain-file-cache) - (if foundp - value - (setf (gethash p domain-file-cache) (probe-file p)))))) - (let ((locale (or (gethash locale *locale-aliases*) locale))) - (dolist (base (if (listp locale-dir) locale-dir (list locale-dir))) - (let ((probe - (or (memoized-probe-file (path locale base)) - (let ((dot (position #. locale))) - (and dot (memoized-probe-file (path (subseq locale 0 dot) base)))) - (let ((at (position #@ locale))) - (and at (memoized-probe-file (path (subseq locale 0 at) base)))) - (let ((us (position #_ locale))) - (and us (memoized-probe-file (path (subseq locale 0 us) base))))))) - (when probe (return probe))))))))) +(defun locate-domain-file (domain locale locale-dir) + ;; The default locale-dir includes search lists. If we get called + ;; before the search lists are initialized, we lose. The search + ;; lists are initialized in environment-init, which sets + ;; *environment-list-initialized*. This way, we return NIL to + ;; indicate there's no domain file to use. + (when lisp::*environment-list-initialized* + (flet ((path (locale base) + (merge-pathnames (make-pathname :directory (list :relative locale + "LC_MESSAGES") + :name domain :type "mo") + base))) + (let ((locale (or (gethash locale *locale-aliases*) locale))) + (dolist (base (if (listp locale-dir) locale-dir (list locale-dir))) + (let ((probe + (or (probe-file (path locale base)) + (let ((dot (position #. locale))) + (and dot (probe-file (path (subseq locale 0 dot) base)))) + (let ((at (position #@ locale))) + (and at (probe-file (path (subseq locale 0 at) base)))) + (let ((us (position #_ locale))) + (and us (probe-file (path (subseq locale 0 us) base))))))) + (when probe (return probe))))))))

(defun find-encoding (domain) (when (null (domain-entry-encoding domain)) @@ -341,7 +321,12 @@ (defun load-domain (domain locale &optional (locale-dir *locale-directories*)) (let ((file (locate-domain-file domain locale locale-dir)) (read #'read-lelong)) - (unless file (return-from load-domain nil)) + (unless file + (let ((entry (make-domain-entry :domain domain :locale locale + :hash (make-hash-table :size 0 + :test 'equal)))) + (setf (gethash domain *loaded-domains*) entry) + (return-from load-domain entry))) (with-open-file (stream file :direction :input :if-does-not-exist nil :element-type '(unsigned-byte 8)) (unless stream (return-from load-domain nil))