Mercurial > hg > xemacs-beta

comparison lisp/loadup.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 0784d089fdc9
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
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 (let ((gc-cons-threshold 30000)) 48 ;(start-profiling)
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)))
49 56
50 ;; This is awfully damn early to be getting an error, right? 57 ;; This is awfully damn early to be getting an error, right?
51 (call-with-condition-handler 'really-early-error-handler 58 (call-with-condition-handler 'really-early-error-handler
52 #'(lambda () 59 #'(lambda ()
53 60
63 (insert-file-contents-internal "../Installation") 70 (insert-file-contents-internal "../Installation")
64 (fmakunbound 'format-decode) 71 (fmakunbound 'format-decode)
65 (prog1 (buffer-substring) 72 (prog1 (buffer-substring)
66 (kill-buffer (current-buffer))))) 73 (kill-buffer (current-buffer)))))
67 74
68 (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) 75 (let ((build-root (expand-file-name ".." invocation-directory)))
69 (setq module-load-path (split-path (getenv "EMACSBOOTSTRAPMODULEPATH"))) 76 (setq load-path (list (expand-file-name "lisp" build-root)))
77 (setq module-load-path (list (expand-file-name "modules" build-root))))
70 78
71 ;; message not defined yet ... 79 ;; message not defined yet ...
72 (external-debugging-output (format "\nUsing load-path %s" load-path)) 80 (external-debugging-output (format "\nUsing load-path %s" load-path))
73 (external-debugging-output (format "\nUsing module-load-path %s" 81 (external-debugging-output (format "\nUsing module-load-path %s"
74 module-load-path)) 82 module-load-path))
107 (if load-ignore-elc-files 115 (if load-ignore-elc-files
108 '(".el" "") '(".elc" ".el" ""))))) 116 '(".el" "") '(".elc" ".el" "")))))
109 (if full-path 117 (if full-path
110 (prog1 118 (prog1
111 (load full-path) 119 (load full-path)
112 (garbage-collect)) 120 ;; but garbage collection really slows down loading.
121 (unless (memq 'quick-build internal-error-checking)
122 (garbage-collect)))
113 (external-debugging-output (format "\nLoad file %s: not found\n" 123 (external-debugging-output (format "\nLoad file %s: not found\n"
114 file)) 124 file))
115 ;; Uncomment in case of trouble 125 ;; Uncomment in case of trouble
116 ;;(print (format "late-packages: %S" late-packages)) 126 ;;(print (format "late-packages: %S" late-packages))
117 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) 127 ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
153 ;; you may load them with a "site-load.el" file. 163 ;; you may load them with a "site-load.el" file.
154 ;; But you must also cause them to be scanned when the DOC file 164 ;; But you must also cause them to be scanned when the DOC file
155 ;; is generated. For VMS, you must edit ../../vms/makedoc.com. 165 ;; is generated. For VMS, you must edit ../../vms/makedoc.com.
156 ;; For other systems, you must edit ../../src/Makefile.in.in. 166 ;; For other systems, you must edit ../../src/Makefile.in.in.
157 (when (load "site-load" t) 167 (when (load "site-load" t)
158 (garbage-collect)) 168 (garbage-collect)
169 )
159 170
160 ;;FSFmacs randomness 171 ;;FSFmacs randomness
161 ;;(if (fboundp 'x-popup-menu) 172 ;;(if (fboundp 'x-popup-menu)
162 ;; (precompute-menubar-bindings)) 173 ;; (precompute-menubar-bindings))
163 ;;; Turn on recording of which commands get rebound, 174 ;;; Turn on recording of which commands get rebound,
189 200
190 ;;; At this point, we're ready to resume undo recording for scratch. 201 ;;; At this point, we're ready to resume undo recording for scratch.
191 (buffer-enable-undo "*scratch*") 202 (buffer-enable-undo "*scratch*")
192 203
193 ) ;; frequent garbage collection 204 ) ;; 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)
194 270
195 ;; Dump into the name `xemacs' (only) 271 ;; Dump into the name `xemacs' (only)
196 (when (member "dump" command-line-args) 272 (when (member "dump" command-line-args)
197 (message "Dumping under the name xemacs") 273 (message "Dumping under the name xemacs")
198 ;; This is handled earlier in the build process. 274 ;; This is handled earlier in the build process.