Mercurial > hg > xemacs-beta

comparison lisp/loadup.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents b8cc9ab3f761
children da8ed4261e83
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
43 "List of files preloaded into the XEmacs binary image.") 43 "List of files preloaded into the XEmacs binary image.")
44 44
45 (defvar Installation-string nil 45 (defvar Installation-string nil
46 "Description of XEmacs installation.") 46 "Description of XEmacs installation.")
47 47
48 ;(start-profiling) 48 (let ((gc-cons-threshold 30000))
49
50 (let ((gc-cons-threshold
51 ;; setting it low makes loadup incredibly fucking slow.
52 ;; no need to do it when not dumping.
53 (if (and purify-flag
54 (not (memq 'quick-build internal-error-checking)))
55 30000 3000000)))
56 49
57 ;; This is awfully damn early to be getting an error, right? 50 ;; This is awfully damn early to be getting an error, right?
58 (call-with-condition-handler 'really-early-error-handler 51 (call-with-condition-handler 'really-early-error-handler
59 #'(lambda () 52 #'(lambda ()
60 53
61 ;; Initialize Installation-string. We do it before loading 54 ;; Initializa Installation-string. We do it before loading
62 ;; anything so that dumped code can make use of its value. 55 ;; anything so that dumped code can make use of its value.
63 (setq Installation-string 56 (setq Installation-string
64 (save-current-buffer 57 (save-current-buffer
65 (set-buffer (get-buffer-create (generate-new-buffer-name 58 (set-buffer (get-buffer-create (generate-new-buffer-name
66 " *temp*"))) 59 " *temp*")))
70 (insert-file-contents-internal "../Installation") 63 (insert-file-contents-internal "../Installation")
71 (fmakunbound 'format-decode) 64 (fmakunbound 'format-decode)
72 (prog1 (buffer-substring) 65 (prog1 (buffer-substring)
73 (kill-buffer (current-buffer))))) 66 (kill-buffer (current-buffer)))))
74 67
75 (let ((build-root (expand-file-name ".." invocation-directory))) 68 (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))
76 (setq load-path (list (expand-file-name "lisp" build-root))) 69 (setq module-load-path (split-path (getenv "EMACSBOOTSTRAPMODULEPATH")))
77 (setq module-load-path (list (expand-file-name "modules" build-root))))
78 70
79 ;; message not defined yet ... 71 ;; message not defined yet ...
80 (external-debugging-output (format "\nUsing load-path %s" load-path)) 72 (external-debugging-output (format "\nUsing load-path %s" load-path))
81 (external-debugging-output (format "\nUsing module-load-path %s" 73 (external-debugging-output (format "\nUsing module-load-path %s"
82 module-load-path)) 74 module-load-path))
115 (if load-ignore-elc-files 107 (if load-ignore-elc-files
116 '(".el" "") '(".elc" ".el" ""))))) 108 '(".el" "") '(".elc" ".el" "")))))
117 (if full-path 109 (if full-path
118 (prog1 110 (prog1
119 (load full-path) 111 (load full-path)
120 ;; but garbage collection really slows down loading. 112 (garbage-collect))
121 (unless (memq 'quick-build internal-error-checking)
122 (garbage-collect)))
123 (external-debugging-output (format "\nLoad file %s: not found\n" 113 (external-debugging-output (format "\nLoad file %s: not found\n"
124 file)) 114 file))
125 ;; Uncomment in case of trouble 115 ;; Uncomment in case of trouble
126 ;;(print (format "late-packages: %S" late-packages)) 116 ;;(print (format "late-packages: %S" late-packages))
127 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) 117 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
128 nil))) 118 nil)))
129 119
130 (load (expand-file-name "../lisp/dumped-lisp.el")) 120 (load (concat default-directory "../lisp/dumped-lisp.el"))
131 121
132 (let ((files preloaded-file-list) 122 (let ((files preloaded-file-list)
133 file) 123 file)
134 (while (setq file (car files)) 124 (while (setq file (car files))
135 (unless (pureload file) 125 (unless (pureload file)
163 ;; you may load them with a "site-load.el" file. 153 ;; you may load them with a "site-load.el" file.
164 ;; But you must also cause them to be scanned when the DOC file 154 ;; But you must also cause them to be scanned when the DOC file
165 ;; is generated. For VMS, you must edit ../../vms/makedoc.com. 155 ;; is generated. For VMS, you must edit ../../vms/makedoc.com.
166 ;; For other systems, you must edit ../../src/Makefile.in.in. 156 ;; For other systems, you must edit ../../src/Makefile.in.in.
167 (when (load "site-load" t) 157 (when (load "site-load" t)
168 (garbage-collect) 158 (garbage-collect))
169 )
170 159
171 ;;FSFmacs randomness 160 ;;FSFmacs randomness
172 ;;(if (fboundp 'x-popup-menu) 161 ;;(if (fboundp 'x-popup-menu)
173 ;; (precompute-menubar-bindings)) 162 ;; (precompute-menubar-bindings))
174 ;;; Turn on recording of which commands get rebound, 163 ;;; Turn on recording of which commands get rebound,
200 189
201 ;;; At this point, we're ready to resume undo recording for scratch. 190 ;;; At this point, we're ready to resume undo recording for scratch.
202 (buffer-enable-undo "*scratch*") 191 (buffer-enable-undo "*scratch*")
203 192
204 ) ;; frequent garbage collection 193 ) ;; frequent garbage collection
205
206 ;(stop-profiling)
207
208 ;; yuck! need to insert the function def here, and rewrite the dolist
209 ;; loop below.
210
211 ;(defun loadup-profile-results (&optional info stream)
212 ; "Print profiling info INFO to STREAM in a pretty format.
213 ;If INFO is omitted, the current profiling info is retrieved using
214 ; `get-profiling-info'.
215 ;If STREAM is omitted, either a *Profiling Results* buffer or standard
216 ; output are used, depending on whether the function was called
217 ; interactively or not."
218 ; (interactive)
219 ; (setq info (if info
220 ; (copy-alist info)
221 ; (get-profiling-info)))
222 ; (when (and (not stream)
223 ; (interactive-p))
224 ; (pop-to-buffer (get-buffer-create "*Profiling Results*"))
225 ; (erase-buffer))
226 ; (let ((standard-output (or stream (if (interactive-p)
227 ; (current-buffer)
228 ; standard-output)))
229 ; ;; Calculate the longest function
230 ; (maxfunlen (apply #'max
231 ; (length "Function Name")
232 ; (mapcar
233 ; (lambda (el)
234 ; ;; Functions longer than 50 characters (usually
235 ; ;; anonymous functions) don't qualify
236 ; (let ((l (length (format "%s" (car el)))))
237 ; (if (< l 50)
238 ; l 0)))
239 ; info))))
240 ; (princ (format "%-*s Ticks %%/Total Call Count\n"
241 ; maxfunlen "Function Name"))
242 ; (princ (make-string maxfunlen ?=))
243 ; (princ " ===== ======= ==========\n")
244 ; (let ((sum (float (apply #'+ (mapcar #'cdr info)))))
245 ; (let (entry
246 ; (entry-list (nreverse (sort info #'cdr-less-than-cdr))))
247 ; (while entry-list
248 ; (setq entry (car entry-list))
249 ; (princ (format "%-*s %-5d %-6.3f %s\n"
250 ; maxfunlen (car entry) (cdr entry)
251 ; (* 100 (/ (cdr entry) sum))
252 ; (or (gethash (car entry) call-count-profile-table)
253 ; "")))
254 ; (setq entry-list (cdr entry-list))))
255 ; (princ (make-string maxfunlen ?-))
256 ; (princ "---------------------------------\n")
257 ; (princ (format "%-*s %-5d %-6.2f\n" maxfunlen "Total" sum 100.0))
258 ; (princ (format "\n\nOne tick = %g ms\n"
259 ; (/ default-profiling-interval 1000.0)))
260 ; (and (boundp 'internal-error-checking)
261 ; internal-error-checking
262 ; (princ "
263 ;WARNING: Error checking is turned on in this XEmacs. This might make
264 ; the measurements very unreliable.\n"))))
265 ; (when (and (not stream)
266 ; (interactive-p))
267 ; (goto-char (point-min))))
268
269 ;(loadup-profile-results nil 'external-debugging-output)
270 194
271 ;; Dump into the name `xemacs' (only) 195 ;; Dump into the name `xemacs' (only)
272 (when (member "dump" command-line-args) 196 (when (member "dump" command-line-args)
273 (message "Dumping under the name xemacs") 197 (message "Dumping under the name xemacs")
274 ;; This is handled earlier in the build process. 198 ;; This is handled earlier in the build process.