X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fbytecomp.el;h=f5c527fc041c03dc0c430a028f801d880ae99d73;hb=86ee3bc0c7c643f7166fb356d26e1e0f863b3339;hp=421a840a4f1bcc578cfea631eb0b078699decd77;hpb=d8bd7eee3147c839d3c74d1823c139cd54867a75;p=chise%2Fxemacs-chise.git- diff --git a/lisp/bytecomp.el b/lisp/bytecomp.el index 421a840..f5c527f 100644 --- a/lisp/bytecomp.el +++ b/lisp/bytecomp.el @@ -10,7 +10,7 @@ ;; Richard Stallman ;; Keywords: internal lisp -(defconst byte-compile-version (purecopy "2.27 XEmacs; 2000-09-12.")) +(defconst byte-compile-version "2.27 XEmacs; 2000-09-12.") ;; This file is part of XEmacs. @@ -121,7 +121,7 @@ ;;; generate .elc files which can be loaded into ;;; generic emacs 19. ;;; emacs-lisp-file-regexp Regexp for the extension of source-files; -;;; see also the function byte-compile-dest-file. +;;; see also the function `byte-compile-dest-file'. ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. ;;; ;;; Most of the above parameters can also be set on a file-by-file basis; see @@ -145,7 +145,7 @@ ;;; This is, in fact, exactly what `defsubst' does. To make a function no ;;; longer be inline, you must use `proclaim-notinline'. Beware that if ;;; you define a function with `defsubst' and later redefine it with -;;; `defun', it will still be open-coded until you use proclaim-notinline. +;;; `defun', it will still be open-coded until you use `proclaim-notinline'. ;;; ;;; o You can also open-code one particular call to a function without ;;; open-coding all calls. Use the 'inline' form to do this, like so: @@ -164,20 +164,20 @@ ;;; ;;; o Forms like ((lambda ...) ...) are open-coded. ;;; -;;; o The form `eval-when-compile' is like progn, except that the body +;;; o The form `eval-when-compile' is like `progn', except that the body ;;; is evaluated at compile-time. When it appears at top-level, this ;;; is analogous to the Common Lisp idiom (eval-when (compile) ...). ;;; When it does not appear at top-level, it is similar to the ;;; Common Lisp #. reader macro (but not in interpreted code). ;;; -;;; o The form `eval-and-compile' is similar to eval-when-compile, but -;;; the whole form is evalled both at compile-time and at run-time. +;;; o The form `eval-and-compile' is similar to `eval-when-compile', +;;; but the whole form is evalled both at compile-time and at run-time. ;;; ;;; o The command M-x byte-compile-and-load-file does what you'd think. ;;; -;;; o The command compile-defun is analogous to eval-defun. +;;; o The command `compile-defun' is analogous to `eval-defun'. ;;; -;;; o If you run byte-compile-file on a filename which is visited in a +;;; o If you run `byte-compile-file' on a filename which is visited in a ;;; buffer, and that buffer is modified, you are asked whether you want ;;; to save the buffer before compiling. ;;; @@ -229,7 +229,7 @@ is compiled with optimization, this causes a speedup.") (defmacro byte-compile-version-cond (cond) cond))) ) -(defvar emacs-lisp-file-regexp (purecopy "\\.el$") +(defvar emacs-lisp-file-regexp "\\.el$" "*Regexp which matches Emacs Lisp source files. You may want to redefine `byte-compile-dest-file' if you change this.") @@ -443,16 +443,33 @@ on the specbind stack. The cdr of each cell is an integer bitmask.") (defvar byte-compiler-error-flag) +;;; A form of eval that includes the currently defined macro definitions. +;;; This helps implement the promise made in the Lispref: +;;; +;;; "If a file being compiled contains a `defmacro' form, the macro is +;;; defined temporarily for the rest of the compilation of that file." +(defun byte-compile-eval (form) + (let ((save-macro-environment nil)) + (unwind-protect + (loop for (sym . def) in byte-compile-macro-environment do + (push + (if (fboundp sym) (cons sym (symbol-function sym)) sym) + save-macro-environment) + (fset sym (cons 'macro def)) + finally return (eval form)) + (dolist (elt save-macro-environment) + (if (symbolp elt) + (fmakunbound elt) + (fset (car elt) (cdr elt))))))) + (defconst byte-compile-initial-macro-environment - (purecopy - '((byte-compiler-options . (lambda (&rest forms) - (apply 'byte-compiler-options-handler forms))) - (eval-when-compile . (lambda (&rest body) - (list 'quote (eval (byte-compile-top-level - (cons 'progn body)))))) - (eval-and-compile . (lambda (&rest body) - (eval (cons 'progn body)) - (cons 'progn body))))) + '((byte-compiler-options . (lambda (&rest forms) + (apply 'byte-compiler-options-handler forms))) + (eval-when-compile . (lambda (&rest body) + (list 'quote (byte-compile-eval (cons 'progn body))))) + (eval-and-compile . (lambda (&rest body) + (byte-compile-eval (cons 'progn body)) + (cons 'progn body)))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -716,18 +733,18 @@ otherwise pop it") (defconst byte-constant-limit 64 "Exclusive maximum index usable in the `byte-constant' opcode.") -(defconst byte-goto-ops (purecopy - '(byte-goto byte-goto-if-nil byte-goto-if-not-nil - byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop)) +(defconst byte-goto-ops + '(byte-goto byte-goto-if-nil byte-goto-if-not-nil + byte-goto-if-nil-else-pop + byte-goto-if-not-nil-else-pop) "List of byte-codes whose offset is a pc.") (defconst byte-goto-always-pop-ops - (purecopy '(byte-goto-if-nil byte-goto-if-not-nil))) + '(byte-goto-if-nil byte-goto-if-not-nil)) (defconst byte-rel-goto-ops - (purecopy '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil - byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop)) + '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil + byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop) "byte-codes for relative jumps.") (byte-extrude-byte-code-vectors) @@ -997,7 +1014,7 @@ otherwise pop it") '(emacs19) '(emacs20))))) ;; now we can copy it. -(setq byte-compiler-legal-options (purecopy byte-compiler-legal-options)) +(setq byte-compiler-legal-options byte-compiler-legal-options) (defun byte-compiler-options-handler (&rest args) (let (key val desc choices) @@ -1229,7 +1246,10 @@ otherwise pop it") (setq var nil)) (setq rest (cdr rest))) ;; if var is nil at this point, it's a defvar in this file. - (not var)))) + (not var)) + ;; Perhaps (eval-when-compile (defvar foo)) + (and (boundp 'current-load-list) + (memq var current-load-list)))) ;;; If we have compiled bindings of variables which have no referents, warn. @@ -1371,8 +1391,8 @@ Files in subdirectories of DIRECTORY are processed also." (defun byte-recompile-directory (directory &optional arg norecursion force) "Recompile every `.el' file in DIRECTORY that needs recompilation. This is if a `.elc' file exists but is older than the `.el' file. -Files in subdirectories of DIRECTORY are processed also unless argument -NORECURSION is non-nil. +Files in subdirectories of DIRECTORY are also processed unless +optional argument NORECURSION is non-nil. If the `.elc' file does not exist, normally the `.el' file is *not* compiled. But a prefix argument (optional second arg) means ask user, @@ -1381,7 +1401,7 @@ don't ask and compile the file anyway. A nonzero prefix argument also means ask about each subdirectory. -If the fourth argument FORCE is non-nil, +If the fourth optional argument FORCE is non-nil, recompile every `.el' file that already has a `.elc' file." (interactive "DByte recompile directory: \nP") (if arg @@ -1769,7 +1789,8 @@ With argument, insert value in current buffer after the form." (setq ces 'binary) (goto-char (point-min)) (while (< (point)(point-max)) - (cond ((eq (char-after) ?\;) + (cond ((and (eq (char-after) ?\;) + (not (eq (char-after (1- (point))) ?\\))) (delete-region (point)(point-at-eol)) (if (eq (char-after) ?\n) (delete-char 1) @@ -1801,7 +1822,11 @@ With argument, insert value in current buffer after the form." (if (and (featurep 'utf-2000) (re-search-backward "\\\\u[0-9A-Fa-f]+" nil t)) 'utf-8-unix - 'binary)))) + 'binary) + (when (featurep 'utf-2000) + (goto-char (point-min)) + (if (re-search-forward "\\\\u[0-9A-Fa-f]+" nil t) + 'utf-8-mcs-unix))))) (setq ces 'binary)) (if (eq ces 'binary) (setq buffer-file-coding-system 'binary) @@ -2725,6 +2750,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (eq base-op 'byte-varset) byte-compile-assigned-bit byte-compile-referenced-bit))))) + (and (boundp 'current-load-list) + (memq var current-load-list)) (if (eq base-op 'byte-varset) (or (memq var byte-compile-free-assignments) (progn @@ -2768,8 +2795,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (defmacro byte-defop-compiler (function &optional compile-handler) ;; add a compiler-form for FUNCTION. - ;; If function is a symbol, then the variable "byte-SYMBOL" must name - ;; the opcode to be used. If function is a list, the first element + ;; If FUNCTION is a symbol, then the variable "byte-SYMBOL" must name + ;; the opcode to be used. If is a list, the first element ;; is the function and the second element is the bytecode-symbol. ;; COMPILE-HANDLER is the function to use to compile this byte-op, or ;; may be the abbreviations 0, 1, 2, 3, 0-1, 1-2, 2-3, 0+1, 1+1, 2+1, @@ -2959,11 +2986,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-defop-compiler-rmsfun member 2) (byte-defop-compiler-rmsfun assq 2) -(byte-defop-compiler max byte-compile-associative) -(byte-defop-compiler min byte-compile-associative) -(byte-defop-compiler (+ byte-plus) byte-compile-associative) -(byte-defop-compiler (* byte-mult) byte-compile-associative) - ;;####(byte-defop-compiler move-to-column 1) (byte-defop-compiler-1 interactive byte-compile-noop) (byte-defop-compiler-1 domain byte-compile-domain) @@ -3042,40 +3064,52 @@ If FORM is a lambda or a macro, byte-compile it as a function." (defun byte-compile-no-args-with-one-extra (form) (case (length (cdr form)) (0 (byte-compile-no-args form)) - (1 (byte-compile-normal-call form)) + (1 (if (eq nil (nth 1 form)) + (byte-compile-no-args (butlast form)) + (byte-compile-normal-call form))) (t (byte-compile-subr-wrong-args form "0-1")))) (defun byte-compile-one-arg-with-one-extra (form) (case (length (cdr form)) (1 (byte-compile-one-arg form)) - (2 (byte-compile-normal-call form)) + (2 (if (eq nil (nth 2 form)) + (byte-compile-one-arg (butlast form)) + (byte-compile-normal-call form))) (t (byte-compile-subr-wrong-args form "1-2")))) (defun byte-compile-two-args-with-one-extra (form) (case (length (cdr form)) (2 (byte-compile-two-args form)) - (3 (byte-compile-normal-call form)) + (3 (if (eq nil (nth 3 form)) + (byte-compile-two-args (butlast form)) + (byte-compile-normal-call form))) (t (byte-compile-subr-wrong-args form "2-3")))) (defun byte-compile-zero-or-one-arg-with-one-extra (form) (case (length (cdr form)) (0 (byte-compile-one-arg (append form '(nil)))) (1 (byte-compile-one-arg form)) - (2 (byte-compile-normal-call form)) + (2 (if (eq nil (nth 2 form)) + (byte-compile-one-arg (butlast form)) + (byte-compile-normal-call form))) (t (byte-compile-subr-wrong-args form "0-2")))) (defun byte-compile-one-or-two-args-with-one-extra (form) (case (length (cdr form)) (1 (byte-compile-two-args (append form '(nil)))) (2 (byte-compile-two-args form)) - (3 (byte-compile-normal-call form)) + (3 (if (eq nil (nth 3 form)) + (byte-compile-two-args (butlast form)) + (byte-compile-normal-call form))) (t (byte-compile-subr-wrong-args form "1-3")))) (defun byte-compile-two-or-three-args-with-one-extra (form) (case (length (cdr form)) (2 (byte-compile-three-args (append form '(nil)))) (3 (byte-compile-three-args form)) - (4 (byte-compile-normal-call form)) + (4 (if (eq nil (nth 4 form)) + (byte-compile-three-args (butlast form)) + (byte-compile-normal-call form))) (t (byte-compile-subr-wrong-args form "2-4")))) (defun byte-compile-no-args-with-two-extra (form) @@ -3107,33 +3141,31 @@ If FORM is a lambda or a macro, byte-compile it as a function." (defun byte-compile-discard () (byte-compile-out 'byte-discard 0)) -;; Compile a function that accepts one or more args and is right-associative. -;; We do it by left-associativity so that the operations -;; are done in the same order as in interpreted code. -;(defun byte-compile-associative (form) -; (if (cdr form) -; (let ((opcode (get (car form) 'byte-opcode)) -; (args (copy-sequence (cdr form)))) -; (byte-compile-form (car args)) -; (setq args (cdr args)) -; (while args -; (byte-compile-form (car args)) -; (byte-compile-out opcode 0) -; (setq args (cdr args)))) -; (byte-compile-constant (eval form)))) - -;; Compile a function that accepts one or more args and is right-associative. -;; We do it by left-associativity so that the operations -;; are done in the same order as in interpreted code. -(defun byte-compile-associative (form) - (let ((args (cdr form)) - (opcode (get (car form) 'byte-opcode))) +(defun byte-compile-max (form) + (let ((args (cdr form))) (case (length args) - (0 (byte-compile-constant (eval form))) + (0 (byte-compile-subr-wrong-args form "1 or more")) + (1 (byte-compile-form (car args)) + (when (not byte-compile-delete-errors) + (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-max 0))) (t (byte-compile-form (car args)) - (dolist (arg (cdr args)) - (byte-compile-form arg) - (byte-compile-out opcode 0)))))) + (dolist (elt (cdr args)) + (byte-compile-form elt) + (byte-compile-out 'byte-max 0)))))) + +(defun byte-compile-min (form) + (let ((args (cdr form))) + (case (length args) + (0 (byte-compile-subr-wrong-args form "1 or more")) + (1 (byte-compile-form (car args)) + (when (not byte-compile-delete-errors) + (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-min 0))) + (t (byte-compile-form (car args)) + (dolist (elt (cdr args)) + (byte-compile-form elt) + (byte-compile-out 'byte-min 0)))))) ;; more complicated compiler macros @@ -3143,8 +3175,12 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-defop-compiler fset) (byte-defop-compiler insert) (byte-defop-compiler-1 function byte-compile-function-form) -(byte-defop-compiler-1 - byte-compile-minus) -(byte-defop-compiler (/ byte-quo) byte-compile-quo) +(byte-defop-compiler max) +(byte-defop-compiler min) +(byte-defop-compiler (+ byte-plus) byte-compile-plus) +(byte-defop-compiler-1 - byte-compile-minus) +(byte-defop-compiler (* byte-mult) byte-compile-mult) +(byte-defop-compiler (/ byte-quo) byte-compile-quo) (byte-defop-compiler nconc) (byte-defop-compiler-1 beginning-of-line) @@ -3219,6 +3255,23 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-out 'byte-concatN nargs)) ((byte-compile-normal-call form))))) +(defun byte-compile-plus (form) + (let ((args (cdr form))) + (case (length args) + (0 (byte-compile-constant 0)) + (1 (byte-compile-plus (append form '(0)))) + (t (byte-compile-form (car args)) + (dolist (elt (cdr args)) + (case elt + (0 (when (not byte-compile-delete-errors) + (byte-compile-constant 0) + (byte-compile-out 'byte-plus 0))) + (+1 (byte-compile-out 'byte-add1 0)) + (-1 (byte-compile-out 'byte-sub1 0)) + (t + (byte-compile-form elt) + (byte-compile-out 'byte-plus 0)))))))) + (defun byte-compile-minus (form) (let ((args (cdr form))) (case (length args) @@ -3227,8 +3280,33 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-out 'byte-negate 0)) (t (byte-compile-form (car args)) (dolist (elt (cdr args)) - (byte-compile-form elt) - (byte-compile-out 'byte-diff 0)))))) + (case elt + (0 (when (not byte-compile-delete-errors) + (byte-compile-constant 0) + (byte-compile-out 'byte-diff 0))) + (+1 (byte-compile-out 'byte-sub1 0)) + (-1 (byte-compile-out 'byte-add1 0)) + (t + (byte-compile-form elt) + (byte-compile-out 'byte-diff 0)))))))) + +(defun byte-compile-mult (form) + (let ((args (cdr form))) + (case (length args) + (0 (byte-compile-constant 1)) + (1 (byte-compile-mult (append form '(1)))) + (t (byte-compile-form (car args)) + (dolist (elt (cdr args)) + (case elt + (1 (when (not byte-compile-delete-errors) + (byte-compile-constant 1) + (byte-compile-out 'byte-mult 0))) + (-1 (byte-compile-out 'byte-negate 0)) + (2 (byte-compile-out 'byte-dup 0) + (byte-compile-out 'byte-plus 0)) + (t + (byte-compile-form elt) + (byte-compile-out 'byte-mult 0)))))))) (defun byte-compile-quo (form) (let ((args (cdr form))) @@ -3239,8 +3317,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-out 'byte-quo 0)) (t (byte-compile-form (car args)) (dolist (elt (cdr args)) - (byte-compile-form elt) - (byte-compile-out 'byte-quo 0)))))) + (case elt + (+1 (when (not byte-compile-delete-errors) + (byte-compile-constant 1) + (byte-compile-out 'byte-quo 0))) + (-1 (byte-compile-out 'byte-negate 0)) + (t + (when (and (numberp elt) (= elt 0)) + (byte-compile-warn "Attempt to divide by zero: %s" form)) + (byte-compile-form elt) + (byte-compile-out 'byte-quo 0)))))))) (defun byte-compile-nconc (form) (let ((args (cdr form))) @@ -3815,8 +3901,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-body-do-effect (list ;; Put the defined variable in this library's load-history entry - ;; just as a real defvar would, but only in top-level forms. - (when (null byte-compile-current-form) + ;; just as a real defvar would, but only in top-level forms with values. + (when (and (> (length form) 2) + (null byte-compile-current-form)) `(push ',var current-load-list)) (when (> (length form) 3) (when (and string (not (stringp string))) @@ -4094,7 +4181,7 @@ invoked interactively." Use this from the command line, with `-batch'; it won't work in an interactive Emacs. Each file is processed even if an error occurred previously. -For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" +For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"." ;; command-line-args-left is what is left of the command line (from ;; startup.el) (defvar command-line-args-left) ;Avoid 'free variable' warning