(defvar preloaded-file-list nil
"List of files preloaded into the XEmacs binary image.")
+(defvar Installation-string nil
+ "Description of XEmacs installation.")
-(let ((gc-cons-threshold 30000))
+;(start-profiling)
+
+(let ((gc-cons-threshold
+ ;; setting it low makes loadup incredibly fucking slow.
+ ;; no need to do it when not dumping.
+ (if (and purify-flag
+ (not (memq 'quick-build internal-error-checking)))
+ 30000 3000000)))
;; This is awfully damn early to be getting an error, right?
(call-with-condition-handler 'really-early-error-handler
#'(lambda ()
- ;; message not defined yet ...
- (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))
+ ;; Initialize Installation-string. We do it before loading
+ ;; anything so that dumped code can make use of its value.
+ (setq Installation-string
+ (save-current-buffer
+ (set-buffer (get-buffer-create (generate-new-buffer-name
+ " *temp*")))
+ ;; insert-file-contents-internal bogusly calls
+ ;; format-decode without checking if it's defined.
+ (fset 'format-decode #'(lambda (f l &optional v) l))
+ (insert-file-contents-internal "../Installation")
+ (fmakunbound 'format-decode)
+ (prog1 (buffer-substring)
+ (kill-buffer (current-buffer)))))
+
+ (let ((build-root (expand-file-name ".." invocation-directory)))
+ (setq load-path (list (expand-file-name "lisp" build-root)))
+ (setq module-load-path (list (expand-file-name "modules" build-root))))
+
+ ;; message not defined yet ...
(external-debugging-output (format "\nUsing load-path %s" load-path))
+ (external-debugging-output (format "\nUsing module-load-path %s"
+ module-load-path))
;; We don't want to have any undo records in the dumped XEmacs.
(buffer-disable-undo (get-buffer "*scratch*"))
(defun pureload (file)
(let ((full-path
(locate-file file load-path
- (if load-ignore-elc-files ".el:" ".elc:.el:"))))
+ (if load-ignore-elc-files
+ '(".el" "") '(".elc" ".el" "")))))
(if full-path
(prog1
(load full-path)
- (garbage-collect))
+ ;; but garbage collection really slows down loading.
+ (unless (memq 'quick-build internal-error-checking)
+ (garbage-collect)))
(external-debugging-output (format "\nLoad file %s: not found\n"
file))
;; Uncomment in case of trouble
;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name)))
nil)))
- (load (concat default-directory "../lisp/dumped-lisp.el"))
+ (load (expand-file-name "../lisp/dumped-lisp.el"))
(let ((files preloaded-file-list)
file)
;; is generated. For VMS, you must edit ../../vms/makedoc.com.
;; For other systems, you must edit ../../src/Makefile.in.in.
(when (load "site-load" t)
- (garbage-collect))
+ (garbage-collect)
+)
;;FSFmacs randomness
;;(if (fboundp 'x-popup-menu)
;;; for the sake of the next call to precompute-menubar-bindings.
;(setq define-key-rebound-commands nil)
-
;; Note: all compiled Lisp files loaded above this point
;; must be among the ones parsed by make-docfile
;; to construct DOC. Any that are not processed
) ;; frequent garbage collection
+;(stop-profiling)
+
+;; yuck! need to insert the function def here, and rewrite the dolist
+;; loop below.
+
+;(defun loadup-profile-results (&optional info stream)
+; "Print profiling info INFO to STREAM in a pretty format.
+;If INFO is omitted, the current profiling info is retrieved using
+; `get-profiling-info'.
+;If STREAM is omitted, either a *Profiling Results* buffer or standard
+; output are used, depending on whether the function was called
+; interactively or not."
+; (interactive)
+; (setq info (if info
+; (copy-alist info)
+; (get-profiling-info)))
+; (when (and (not stream)
+; (interactive-p))
+; (pop-to-buffer (get-buffer-create "*Profiling Results*"))
+; (erase-buffer))
+; (let ((standard-output (or stream (if (interactive-p)
+; (current-buffer)
+; standard-output)))
+; ;; Calculate the longest function
+; (maxfunlen (apply #'max
+; (length "Function Name")
+; (mapcar
+; (lambda (el)
+; ;; Functions longer than 50 characters (usually
+; ;; anonymous functions) don't qualify
+; (let ((l (length (format "%s" (car el)))))
+; (if (< l 50)
+; l 0)))
+; info))))
+; (princ (format "%-*s Ticks %%/Total Call Count\n"
+; maxfunlen "Function Name"))
+; (princ (make-string maxfunlen ?=))
+; (princ " ===== ======= ==========\n")
+; (let ((sum (float (apply #'+ (mapcar #'cdr info)))))
+; (let (entry
+; (entry-list (nreverse (sort info #'cdr-less-than-cdr))))
+; (while entry-list
+; (setq entry (car entry-list))
+; (princ (format "%-*s %-5d %-6.3f %s\n"
+; maxfunlen (car entry) (cdr entry)
+; (* 100 (/ (cdr entry) sum))
+; (or (gethash (car entry) call-count-profile-table)
+; "")))
+; (setq entry-list (cdr entry-list))))
+; (princ (make-string maxfunlen ?-))
+; (princ "---------------------------------\n")
+; (princ (format "%-*s %-5d %-6.2f\n" maxfunlen "Total" sum 100.0))
+; (princ (format "\n\nOne tick = %g ms\n"
+; (/ default-profiling-interval 1000.0)))
+; (and (boundp 'internal-error-checking)
+; internal-error-checking
+; (princ "
+;WARNING: Error checking is turned on in this XEmacs. This might make
+; the measurements very unreliable.\n"))))
+; (when (and (not stream)
+; (interactive-p))
+; (goto-char (point-min))))
+
+;(loadup-profile-results nil 'external-debugging-output)
+
;; Dump into the name `xemacs' (only)
(when (member "dump" command-line-args)
(message "Dumping under the name xemacs")
;; (condition-case () (delete-file "xemacs") (file-error nil))
(when (fboundp 'really-free)
(really-free))
- (dump-emacs (if (featurep 'infodock) "infodock" "xemacs") "temacs")
+ (dump-emacs
+ (cond
+ ((featurep 'infodock) "infodock")
+ ;; #### BILL!!!
+ ;; If we want to dump under a name other than `xemacs', do that here!
+ ;; ((featurep 'gtk) "xemacs-gtk")
+ (t "xemacs"))
+ "temacs")
(kill-emacs))
;; Avoid error if user loads some more libraries now.