Skip to content
Snippets Groups Projects
Commit 1f888eec authored by rtoy's avatar rtoy
Browse files

Speed up building on sparc. Time taken is now almost half! This was

caused by all the calls to stat in PROBE-FILE in LOCATE-DOMAIN-FILE
for files that did not exist.  The default locale was C, so every
message lookup was causing many stat's to non-exist files.  (There
were over 1000 calls/sec on a 750 MHz sparc!)

So we cache all the calls to PROBE-FILE in LOCATE-DOMAIN-FILE.  But
just in case, we also allow the user to get at the hash table to
examine it (GET-DOMAIN-FILE-CACHE) and also allow the user to clear it
(CLEAR-DOMAIN-FILE-CACHE) in case new translations are added without
restarting lisp.
parent 1300a06a
No related branches found
No related tags found
No related merge requests found
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*- ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
;;; $Revision: 1.8 $ ;;; $Revision: 1.9 $
;;; Copyright 1999-2010 Paul Foley (mycroft@actrix.gen.nz) ;;; Copyright 1999-2010 Paul Foley (mycroft@actrix.gen.nz)
;;; ;;;
;;; Permission is hereby granted, free of charge, to any person obtaining ;;; Permission is hereby granted, free of charge, to any person obtaining
...@@ -23,7 +23,7 @@ ...@@ -23,7 +23,7 @@
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;;; DAMAGE. ;;; DAMAGE.
(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/intl.lisp,v 1.8 2010/07/14 03:13:20 rtoy Rel $") (ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/intl.lisp,v 1.9 2010/12/11 22:39:46 rtoy Exp $")
(in-package "INTL") (in-package "INTL")
...@@ -79,29 +79,49 @@ ...@@ -79,29 +79,49 @@
(ash (the (unsigned-byte 8) (read-byte stream)) 8) (ash (the (unsigned-byte 8) (read-byte stream)) 8)
(the (unsigned-byte 8) (read-byte stream)))) (the (unsigned-byte 8) (read-byte stream))))
(defun locate-domain-file (domain locale locale-dir) ;; If the domain file doesn't exist because the locale isn't
;; The default locale-dir includes search lists. If we get called ;; supported, we end up doing a huge number of stats looking for a
;; before the search lists are initialized, we lose. The search ;; non-existent file everytime a translation is needed. This is
;; lists are initialized in environment-init, which sets ;; really expensive. So create a cache to hold the results.
;; *environment-list-initialized*. This way, we return NIL to (let ((domain-file-cache (make-hash-table :test 'equal)))
;; indicate there's no domain file to use. (defun get-domain-file-cache ()
(when lisp::*environment-list-initialized* ;; Mostly for debugging to let the user get at the cache.
(flet ((path (locale base) domain-file-cache)
(merge-pathnames (make-pathname :directory (list :relative locale (defun clear-domain-file-cache ()
"LC_MESSAGES") ;; Mostly for debugging. But also useful if we now have installed
:name domain :type "mo") ;; some new translations.
base))) (clrhash domain-file-cache))
(let ((locale (or (gethash locale *locale-aliases*) locale))) (defun locate-domain-file (domain locale locale-dir)
(dolist (base (if (listp locale-dir) locale-dir (list locale-dir))) ;; The default locale-dir includes search lists. If we get called
(let ((probe ;; before the search lists are initialized, we lose. The search
(or (probe-file (path locale base)) ;; lists are initialized in environment-init, which sets
(let ((dot (position #\. locale))) ;; *environment-list-initialized*. This way, we return NIL to
(and dot (probe-file (path (subseq locale 0 dot) base)))) ;; indicate there's no domain file to use.
(let ((at (position #\@ locale))) (when lisp::*environment-list-initialized*
(and at (probe-file (path (subseq locale 0 at) base)))) (flet ((path (locale base)
(let ((us (position #\_ locale))) (merge-pathnames (make-pathname :directory (list :relative locale
(and us (probe-file (path (subseq locale 0 us) base))))))) "LC_MESSAGES")
(when probe (return probe)))))))) :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 find-encoding (domain) (defun find-encoding (domain)
(when (null (domain-entry-encoding domain)) (when (null (domain-entry-encoding domain))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment