/[emacs]/emacs/lisp/emacs-lisp/bytecomp.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/bytecomp.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2.98.2.9 by miles, Fri Apr 4 06:20:16 2003 UTC revision 2.98.2.10 by miles, Tue Oct 14 23:32:20 2003 UTC
# Line 160  Line 160 
160    
161  (or (fboundp 'defsubst)  (or (fboundp 'defsubst)
162      ;; This really ought to be loaded already!      ;; This really ought to be loaded already!
163      (load-library "byte-run"))      (load "byte-run"))
164    
165  ;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation  ;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation
166  ;; errors; however that file also wants to do (require 'bytecomp) for the  ;; errors; however that file also wants to do (require 'bytecomp) for the
# Line 362  Elements of the list may be be: Line 362  Elements of the list may be be:
362                        (const callargs) (const redefine)                        (const callargs) (const redefine)
363                        (const obsolete) (const noruntime) (const cl-functions))))                        (const obsolete) (const noruntime) (const cl-functions))))
364    
365    (defvar byte-compile-not-obsolete-var nil
366      "If non-nil, this is a variable that shouldn't be reported as obsolete.")
367    
368  (defcustom byte-compile-generate-call-tree nil  (defcustom byte-compile-generate-call-tree nil
369    "*Non-nil means collect call-graph information when compiling.    "*Non-nil means collect call-graph information when compiling.
370  This records functions were called and from where.  This records functions were called and from where.
# Line 415  specify different fields to sort on." Line 418  specify different fields to sort on."
418  (defvar byte-compile-bound-variables nil  (defvar byte-compile-bound-variables nil
419    "List of variables bound in the context of the current form.    "List of variables bound in the context of the current form.
420  This list lives partly on the stack.")  This list lives partly on the stack.")
421    (defvar byte-compile-const-variables nil
422      "List of variables declared as constants during compilation of this file.")
423  (defvar byte-compile-free-references)  (defvar byte-compile-free-references)
424  (defvar byte-compile-free-assignments)  (defvar byte-compile-free-assignments)
425    
# Line 433  This list lives partly on the stack.") Line 438  This list lives partly on the stack.")
438                                  (cons 'progn body)                                  (cons 'progn body)
439                                  byte-compile-initial-macro-environment))))))                                  byte-compile-initial-macro-environment))))))
440      (eval-and-compile . (lambda (&rest body)      (eval-and-compile . (lambda (&rest body)
441                            (byte-compile-eval-before-compile (cons 'progn body))                            (byte-compile-eval-before-compile
442                               (macroexpand-all
443                                (cons 'progn body)
444                                byte-compile-initial-macro-environment))
445                            (cons 'progn body))))                            (cons 'progn body))))
446    "The default macro-environment passed to macroexpand by the compiler.    "The default macro-environment passed to macroexpand by the compiler.
447  Placing a macro here will cause a macro to have different semantics when  Placing a macro here will cause a macro to have different semantics when
# Line 868  Each function's symbol gets marked with Line 876  Each function's symbol gets marked with
876                      (unless (memq s old-autoloads)                      (unless (memq s old-autoloads)
877                        (put s 'byte-compile-noruntime t)))                        (put s 'byte-compile-noruntime t)))
878                     ((and (consp s) (eq t (car s)))                     ((and (consp s) (eq t (car s)))
879                      (push s old-autoloads))                      (push (cdr s) old-autoloads))
880                     ((and (consp s) (eq 'autoload (car s)))                     ((and (consp s) (eq 'autoload (car s)))
881                      (put (cdr s) 'byte-compile-noruntime t)))))))                      (put (cdr s) 'byte-compile-noruntime t)))))))
882            ;; Go through current-load-list for the locally defined funs.            ;; Go through current-load-list for the locally defined funs.
# Line 878  Each function's symbol gets marked with Line 886  Each function's symbol gets marked with
886                  (when (and (symbolp s) (not (memq s old-autoloads)))                  (when (and (symbolp s) (not (memq s old-autoloads)))
887                    (put s 'byte-compile-noruntime t))                    (put s 'byte-compile-noruntime t))
888                  (when (and (consp s) (eq t (car s)))                  (when (and (consp s) (eq t (car s)))
889                    (push s old-autoloads))))))))))                    (push (cdr s) old-autoloads))))))))))
890    
891  (defun byte-compile-eval-before-compile (form)  (defun byte-compile-eval-before-compile (form)
892    "Evaluate FORM for `eval-and-compile'."    "Evaluate FORM for `eval-and-compile'."
# Line 1001  Each function's symbol gets marked with Line 1009  Each function's symbol gets marked with
1009      (when (or (and byte-compile-current-file      (when (or (and byte-compile-current-file
1010                     (not (equal byte-compile-current-file                     (not (equal byte-compile-current-file
1011                                 byte-compile-last-logged-file)))                                 byte-compile-last-logged-file)))
1012                (and byte-compile-last-warned-form                (and byte-compile-current-form
1013                     (not (eq byte-compile-current-form                     (not (eq byte-compile-current-form
1014                              byte-compile-last-warned-form))))                              byte-compile-last-warned-form))))
1015        (insert (format "\nIn %s:\n" form)))        (insert (format "\nIn %s:\n" form)))
# Line 1024  Each function's symbol gets marked with Line 1032  Each function's symbol gets marked with
1032    (and (not (equal byte-compile-current-file byte-compile-last-logged-file))    (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
1033         (not noninteractive)         (not noninteractive)
1034         (save-excursion         (save-excursion
1035           (byte-goto-log-buffer)           (set-buffer (get-buffer-create "*Compile-Log*"))
1036           (goto-char (point-max))           (goto-char (point-max))
1037           (let* ((dir (and byte-compile-current-file           (let* ((dir (and byte-compile-current-file
1038                            (file-name-directory byte-compile-current-file)))                            (file-name-directory byte-compile-current-file)))
# Line 1047  Each function's symbol gets marked with Line 1055  Each function's symbol gets marked with
1055               (setq default-directory dir)               (setq default-directory dir)
1056               (unless was-same               (unless was-same
1057                 (insert (format "Entering directory `%s'\n" default-directory))))                 (insert (format "Entering directory `%s'\n" default-directory))))
1058             (setq byte-compile-last-logged-file byte-compile-current-file)             (setq byte-compile-last-logged-file byte-compile-current-file
1059                     byte-compile-last-warned-form nil)
1060               ;; Do this after setting default-directory.
1061               (unless (eq major-mode 'compilation-mode)
1062                 (compilation-mode))
1063             pt))))             pt))))
1064    
1065  ;; Log a message STRING in *Compile-Log*.  ;; Log a message STRING in *Compile-Log*.
1066  ;; Also log the current function and file if not already done.  ;; Also log the current function and file if not already done.
1067  (defun byte-compile-log-warning (string &optional fill level)  (defun byte-compile-log-warning (string &optional fill level)
1068    (let ((warning-prefix-function 'byte-compile-warning-prefix)    (let ((warning-prefix-function 'byte-compile-warning-prefix)
1069          (warning-group-format "")          (warning-type-format "")
1070          (warning-fill-prefix (if fill "    ")))          (warning-fill-prefix (if fill "    ")))
1071      (display-warning 'bytecomp string level "*Compile-Log*")))      (display-warning 'bytecomp string level "*Compile-Log*")))
1072    
# Line 1336  Each function's symbol gets marked with Line 1348  Each function's symbol gets marked with
1348                            ;; These would sometimes be warned about                            ;; These would sometimes be warned about
1349                            ;; but such warnings are never useful,                            ;; but such warnings are never useful,
1350                            ;; so don't warn about them.                            ;; so don't warn about them.
1351                            macroexpand cl-macroexpand-all cl-compiling-file))))                            macroexpand cl-macroexpand-all
1352                              cl-compiling-file)))
1353                 ;; Avoid warnings for things which are safe because they
1354                 ;; have suitable compiler macros, but those aren't
1355                 ;; expanded at this stage.  There should probably be more
1356                 ;; here than caaar and friends.
1357                 (not (and (eq (get func 'byte-compile)
1358                               'cl-byte-compile-compiler-macro)
1359                           (string-match "\\`c[ad]+r\\'" (symbol-name func)))))
1360          (byte-compile-warn "Function `%s' from cl package called at runtime"          (byte-compile-warn "Function `%s' from cl package called at runtime"
1361                             func)))                             func)))
1362    form)    form)
# Line 1390  Each function's symbol gets marked with Line 1410  Each function's symbol gets marked with
1410    nil)    nil)
1411    
1412    
1413  (defsubst byte-compile-const-symbol-p (symbol)  (defsubst byte-compile-const-symbol-p (symbol &optional any-value)
1414      "Non-nil if SYMBOL is constant.
1415    If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
1416    symbol itself."
1417    (or (memq symbol '(nil t))    (or (memq symbol '(nil t))
1418        (keywordp symbol)))        (keywordp symbol)
1419          (if any-value (memq symbol byte-compile-const-variables))))
1420    
1421  (defmacro byte-compile-constp (form)  (defmacro byte-compile-constp (form)
1422    "Return non-nil if FORM is a constant."    "Return non-nil if FORM is a constant."
# Line 1412  Each function's symbol gets marked with Line 1436  Each function's symbol gets marked with
1436                   (copy-alist byte-compile-initial-macro-environment))                   (copy-alist byte-compile-initial-macro-environment))
1437                  (byte-compile-function-environment nil)                  (byte-compile-function-environment nil)
1438                  (byte-compile-bound-variables nil)                  (byte-compile-bound-variables nil)
1439                    (byte-compile-const-variables nil)
1440                  (byte-compile-free-references nil)                  (byte-compile-free-references nil)
1441                  (byte-compile-free-assignments nil)                  (byte-compile-free-assignments nil)
1442                  ;;                  ;;
# Line 1494  recompile every `.el' file that already Line 1519  recompile every `.el' file that already
1519      (save-some-buffers)      (save-some-buffers)
1520      (force-mode-line-update))      (force-mode-line-update))
1521    (save-current-buffer    (save-current-buffer
1522      (byte-goto-log-buffer)      (set-buffer (get-buffer-create "*Compile-Log*"))
1523      (setq default-directory directory)      (setq default-directory (expand-file-name directory))
1524        ;; compilation-mode copies value of default-directory.
1525        (unless (eq major-mode 'compilation-mode)
1526          (compilation-mode))
1527      (let ((directories (list (expand-file-name directory)))      (let ((directories (list (expand-file-name directory)))
1528            (default-directory default-directory)            (default-directory default-directory)
1529            (skip-count 0)            (skip-count 0)
# Line 1609  The value is non-nil if there were no er Line 1637  The value is non-nil if there were no er
1637        ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-        ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
1638        (set-buffer-multibyte t)        (set-buffer-multibyte t)
1639        (insert-file-contents filename)        (insert-file-contents filename)
1640        ;; Mimic the way after-insert-file-set-buffer-file-coding-system        ;; Mimic the way after-insert-file-set-coding can make the
1641        ;; can make the buffer unibyte when visiting this file.        ;; buffer unibyte when visiting this file.
1642        (when (or (eq last-coding-system-used 'no-conversion)        (when (or (eq last-coding-system-used 'no-conversion)
1643                  (eq (coding-system-type last-coding-system-used) 5))                  (eq (coding-system-type last-coding-system-used) 5))
1644          ;; For coding systems no-conversion and raw-text...,          ;; For coding systems no-conversion and raw-text...,
# Line 1797  With argument, insert value in current b Line 1825  With argument, insert value in current b
1825              (byte-compile-file-form form)))              (byte-compile-file-form form)))
1826          ;; Compile pending forms at end of file.          ;; Compile pending forms at end of file.
1827          (byte-compile-flush-pending)          (byte-compile-flush-pending)
1828            ;; Make warnings about unresolved functions
1829            ;; give the end of the file as their position.
1830            (setq byte-compile-last-position (point-max))
1831          (byte-compile-warn-about-unresolved-functions)          (byte-compile-warn-about-unresolved-functions)
1832          ;; Should we always do this?  When calling multiple files, it          ;; Should we always do this?  When calling multiple files, it
1833          ;; would be useful to delay this warning until all have          ;; would be useful to delay this warning until all have
# Line 1808  With argument, insert value in current b Line 1839  With argument, insert value in current b
1839      outbuffer))      outbuffer))
1840    
1841  (defun byte-compile-fix-header (filename inbuffer outbuffer)  (defun byte-compile-fix-header (filename inbuffer outbuffer)
1842    (save-excursion    (with-current-buffer outbuffer
     (set-buffer outbuffer)  
1843      ;; See if the buffer has any multibyte characters.      ;; See if the buffer has any multibyte characters.
1844      (when (< (point-max) (position-bytes (point-max)))      (when (< (point-max) (position-bytes (point-max)))
1845        (when (byte-compile-version-cond byte-compile-compatibility)        (when (byte-compile-version-cond byte-compile-compatibility)
# Line 1953  With argument, insert value in current b Line 1983  With argument, insert value in current b
1983        (prin1 form outbuffer)        (prin1 form outbuffer)
1984        nil)))        nil)))
1985    
1986    (defvar print-gensym-alist)             ;Used before print-circle existed.
1987    
1988  (defun byte-compile-output-docform (preface name info form specindex quoted)  (defun byte-compile-output-docform (preface name info form specindex quoted)
1989    "Print a form with a doc string.  INFO is (prefix doc-index postfix).    "Print a form with a doc string.  INFO is (prefix doc-index postfix).
1990  If PREFACE and NAME are non-nil, print them too,  If PREFACE and NAME are non-nil, print them too,
# Line 2003  list that represents a doc string refere Line 2035  list that represents a doc string refere
2035                 ;; print-gensym-alist not to be cleared                 ;; print-gensym-alist not to be cleared
2036                 ;; between calls to print functions.                 ;; between calls to print functions.
2037                 (print-gensym '(t))                 (print-gensym '(t))
2038                 ;; print-gensym-alist was used before print-circle existed.                 print-gensym-alist    ; was used before print-circle existed.
                print-gensym-alist  
2039                 (print-continuous-numbering t)                 (print-continuous-numbering t)
2040                 print-number-table                 print-number-table
2041                 (index 0))                 (index 0))
# Line 2096  list that represents a doc string refere Line 2127  list that represents a doc string refere
2127    
2128  (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)  (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
2129  (defun byte-compile-file-form-defsubst (form)  (defun byte-compile-file-form-defsubst (form)
2130    (cond ((assq (nth 1 form) byte-compile-unresolved-functions)    (when (assq (nth 1 form) byte-compile-unresolved-functions)
2131           (setq byte-compile-current-form (nth 1 form))      (setq byte-compile-current-form (nth 1 form))
2132           (byte-compile-warn "defsubst %s was used before it was defined"      (byte-compile-warn "defsubst %s was used before it was defined"
2133                              (nth 1 form))))                         (nth 1 form)))
2134    (byte-compile-file-form form)    (byte-compile-file-form form)
2135    ;; Return nil so the form is not output twice.    ;; Return nil so the form is not output twice.
2136    nil)    nil)
# Line 2131  list that represents a doc string refere Line 2162  list that represents a doc string refere
2162        ;; Since there is no doc string, we can compile this as a normal form,        ;; Since there is no doc string, we can compile this as a normal form,
2163        ;; and not do a file-boundary.        ;; and not do a file-boundary.
2164        (byte-compile-keep-pending form)        (byte-compile-keep-pending form)
2165      (if (memq 'free-vars byte-compile-warnings)      (when (memq 'free-vars byte-compile-warnings)
2166          (setq byte-compile-bound-variables        (push (nth 1 form) byte-compile-bound-variables)
2167                (cons (nth 1 form) byte-compile-bound-variables)))        (if (eq (car form) 'defconst)
2168              (push (nth 1 form) byte-compile-const-variables)))
2169      (cond ((consp (nth 2 form))      (cond ((consp (nth 2 form))
2170             (setq form (copy-sequence form))             (setq form (copy-sequence form))
2171             (setcar (cdr (cdr form))             (setcar (cdr (cdr form))
# Line 2143  list that represents a doc string refere Line 2175  list that represents a doc string refere
2175  (put 'custom-declare-variable 'byte-hunk-handler  (put 'custom-declare-variable 'byte-hunk-handler
2176       'byte-compile-file-form-custom-declare-variable)       'byte-compile-file-form-custom-declare-variable)
2177  (defun byte-compile-file-form-custom-declare-variable (form)  (defun byte-compile-file-form-custom-declare-variable (form)
2178    (if (memq 'free-vars byte-compile-warnings)    (when (memq 'free-vars byte-compile-warnings)
2179        (setq byte-compile-bound-variables      (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
             (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))  
2180    (let ((tail (nthcdr 4 form)))    (let ((tail (nthcdr 4 form)))
2181      (while tail      (while tail
2182        ;; If there are any (function (lambda ...)) expressions, compile        ;; If there are any (function (lambda ...)) expressions, compile
# Line 2457  If FORM is a lambda or a macro, byte-com Line 2488  If FORM is a lambda or a macro, byte-com
2488          (when (symbolp arg)          (when (symbolp arg)
2489            (byte-compile-set-symbol-position arg))            (byte-compile-set-symbol-position arg))
2490          (cond ((or (not (symbolp arg))          (cond ((or (not (symbolp arg))
2491                     (keywordp arg)                     (byte-compile-const-symbol-p arg t))
                    (memq arg '(t nil)))  
2492                 (error "Invalid lambda variable %s" arg))                 (error "Invalid lambda variable %s" arg))
2493                ((eq arg '&rest)                ((eq arg '&rest)
2494                 (unless (cdr list)                 (unless (cdr list)
# Line 2498  If FORM is a lambda or a macro, byte-com Line 2528  If FORM is a lambda or a macro, byte-com
2528                      (if (cdr body)                      (if (cdr body)
2529                          (setq body (cdr body))))))                          (setq body (cdr body))))))
2530           (int (assq 'interactive body)))           (int (assq 'interactive body)))
2531      (cond (int      ;; Process the interactive spec.
2532             (byte-compile-set-symbol-position 'interactive)      (when int
2533             ;; Skip (interactive) if it is in front (the most usual location).        (byte-compile-set-symbol-position 'interactive)
2534             (if (eq int (car body))        ;; Skip (interactive) if it is in front (the most usual location).
2535                 (setq body (cdr body)))        (if (eq int (car body))
2536             (cond ((consp (cdr int))            (setq body (cdr body)))
2537                    (if (cdr (cdr int))        (cond ((consp (cdr int))
2538                        (byte-compile-warn "malformed interactive spec: %s"               (if (cdr (cdr int))
2539                                           (prin1-to-string int)))                   (byte-compile-warn "malformed interactive spec: %s"
2540                    ;; If the interactive spec is a call to `list',                                      (prin1-to-string int)))
2541                    ;; don't compile it, because `call-interactively'               ;; If the interactive spec is a call to `list',
2542                    ;; looks at the args of `list'.               ;; don't compile it, because `call-interactively'
2543                    (let ((form (nth 1 int)))               ;; looks at the args of `list'.
2544                      (while (memq (car-safe form) '(let let* progn save-excursion))               (let ((form (nth 1 int)))
2545                        (while (consp (cdr form))                 (while (memq (car-safe form) '(let let* progn save-excursion))
2546                          (setq form (cdr form)))                   (while (consp (cdr form))
2547                        (setq form (car form)))                     (setq form (cdr form)))
2548                      (or (eq (car-safe form) 'list)                   (setq form (car form)))
2549                          (setq int (list 'interactive                 (or (eq (car-safe form) 'list)
2550                                          (byte-compile-top-level (nth 1 int)))))))                     (setq int (list 'interactive
2551                   ((cdr int)                                     (byte-compile-top-level (nth 1 int)))))))
2552                    (byte-compile-warn "malformed interactive spec: %s"               ((cdr int)
2553                                       (prin1-to-string int))))))                (byte-compile-warn "malformed interactive spec: %s"
2554                                     (prin1-to-string int)))))
2555        ;; Process the body.
2556      (let* ((byte-compile-lexical-environment      (let* ((byte-compile-lexical-environment
2557              ;; If doing lexical binding, push a new lexical environment              ;; If doing lexical binding, push a new lexical environment
2558              ;; containing the args and any closed-over variables.              ;; containing the args and any closed-over variables.
# Line 2539  If FORM is a lambda or a macro, byte-com Line 2571  If FORM is a lambda or a macro, byte-com
2571             (byte-compile-current-num-closures 0)             (byte-compile-current-num-closures 0)
2572             (compiled             (compiled
2573              (byte-compile-top-level (cons 'progn body) nil 'lambda)))              (byte-compile-top-level (cons 'progn body) nil 'lambda)))
2574          ;; Build the actual byte-coded function.
2575        (if (and (eq 'byte-code (car-safe compiled))        (if (and (eq 'byte-code (car-safe compiled))
2576                 (not (byte-compile-version-cond                 (not (byte-compile-version-cond
2577                       byte-compile-compatibility)))                       byte-compile-compatibility)))
# Line 2825  If BINDING is non-nil, VAR is being boun Line 2858  If BINDING is non-nil, VAR is being boun
2858                              (if (symbolp var) "constant" "nonvariable")                              (if (symbolp var) "constant" "nonvariable")
2859                              (prin1-to-string var)))                              (prin1-to-string var)))
2860          ((and (get var 'byte-obsolete-variable)          ((and (get var 'byte-obsolete-variable)
2861                (memq 'obsolete byte-compile-warnings))                (memq 'obsolete byte-compile-warnings)
2862                  (not (eq var byte-compile-not-obsolete-var)))
2863           (let* ((ob (get var 'byte-obsolete-variable))           (let* ((ob (get var 'byte-obsolete-variable))
2864                  (when (cdr ob)))                  (when (cdr ob)))
2865             (byte-compile-warn "%s is an obsolete variable%s; %s" var             (byte-compile-warn "%s is an obsolete variable%s; %s" var
# Line 2836  If BINDING is non-nil, VAR is being boun Line 2870  If BINDING is non-nil, VAR is being boun
2870    
2871  (defsubst byte-compile-dynamic-variable-op (base-op var)  (defsubst byte-compile-dynamic-variable-op (base-op var)
2872    (let ((tmp (assq var byte-compile-variables)))    (let ((tmp (assq var byte-compile-variables)))
2873      (or tmp      (unless tmp
2874          (setq tmp (list var)        (setq tmp (list var))
2875                byte-compile-variables (cons tmp byte-compile-variables)))        (push tmp byte-compile-variables))
2876      (byte-compile-out base-op tmp)))      (byte-compile-out base-op tmp)))
2877    
2878  (defun byte-compile-dynamic-variable-bind (var)  (defun byte-compile-dynamic-variable-bind (var)
# Line 2959  is the value it should have." Line 2993  is the value it should have."
2993    ;; If function is a symbol, then the variable "byte-SYMBOL" must name    ;; If function is a symbol, then the variable "byte-SYMBOL" must name
2994    ;; the opcode to be used.  If function is a list, the first element    ;; the opcode to be used.  If function is a list, the first element
2995    ;; is the function and the second element is the bytecode-symbol.    ;; is the function and the second element is the bytecode-symbol.
2996      ;; The second element may be nil, meaning there is no opcode.
2997    ;; COMPILE-HANDLER is the function to use to compile this byte-op, or    ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
2998    ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.    ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
2999    ;; If it is nil, then the handler is "byte-compile-SYMBOL."    ;; If it is nil, then the handler is "byte-compile-SYMBOL."
# Line 3220  discarding." Line 3255  discarding."
3255          (setq args (cdr args))          (setq args (cdr args))
3256          (or args (setq args '(0)          (or args (setq args '(0)
3257                         opcode (get '+ 'byte-opcode)))                         opcode (get '+ 'byte-opcode)))
3258          (while args          (dolist (arg args)
3259            (byte-compile-form (car args))            (byte-compile-form arg)
3260            (byte-compile-out opcode 0)            (byte-compile-out opcode 0)))
           (setq args (cdr args))))  
3261      (byte-compile-constant (eval form))))      (byte-compile-constant (eval form))))
3262    
3263    
# Line 3424  discarding." Line 3458  discarding."
3458  (byte-defop-compiler-1 or)  (byte-defop-compiler-1 or)
3459  (byte-defop-compiler-1 while)  (byte-defop-compiler-1 while)
3460  (byte-defop-compiler-1 funcall)  (byte-defop-compiler-1 funcall)
 (byte-defop-compiler-1 apply byte-compile-funarg)  
 (byte-defop-compiler-1 mapcar byte-compile-funarg)  
 (byte-defop-compiler-1 mapatoms byte-compile-funarg)  
 (byte-defop-compiler-1 mapconcat byte-compile-funarg)  
 (byte-defop-compiler-1 mapc byte-compile-funarg)  
 (byte-defop-compiler-1 maphash byte-compile-funarg)  
 (byte-defop-compiler-1 map-char-table byte-compile-funarg)  
 (byte-defop-compiler-1 sort byte-compile-funarg-2)  
3461  (byte-defop-compiler-1 let)  (byte-defop-compiler-1 let)
3462  (byte-defop-compiler-1 let*)  (byte-defop-compiler-1 let*)
3463    
# Line 3741  if LFORMINFO is nil (meaning all binding Line 3767  if LFORMINFO is nil (meaning all binding
3767    
3768  (defun byte-compile-track-mouse (form)  (defun byte-compile-track-mouse (form)
3769    (byte-compile-form    (byte-compile-form
3770     (list     `(funcall '(lambda nil
3771      'funcall                  (track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
     (list 'quote  
           (list 'lambda nil  
                 (cons 'track-mouse  
                       (byte-compile-top-level-body (cdr form))))))))  
3772    
3773  (defun byte-compile-condition-case (form)  (defun byte-compile-condition-case (form)
3774    (let* ((var (nth 1 form))    (let* ((var (nth 1 form))
# Line 3818  if LFORMINFO is nil (meaning all binding Line 3840  if LFORMINFO is nil (meaning all binding
3840    (byte-compile-out 'byte-temp-output-buffer-setup 0)    (byte-compile-out 'byte-temp-output-buffer-setup 0)
3841    (byte-compile-body (cdr (cdr form)))    (byte-compile-body (cdr (cdr form)))
3842    (byte-compile-out 'byte-temp-output-buffer-show 0))    (byte-compile-out 'byte-temp-output-buffer-show 0))
   
3843    
3844  ;;; top-level forms elsewhere  ;;; top-level forms elsewhere
3845    
# Line 3837  if LFORMINFO is nil (meaning all binding Line 3858  if LFORMINFO is nil (meaning all binding
3858      (byte-compile-set-symbol-position 'defun)      (byte-compile-set-symbol-position 'defun)
3859      (error "defun name must be a symbol, not %s" (car form)))      (error "defun name must be a symbol, not %s" (car form)))
3860    (let ((for-effect nil))    (let ((for-effect nil))
3861        (byte-compile-push-constant 'defalias)
3862      (byte-compile-push-constant (nth 1 form))      (byte-compile-push-constant (nth 1 form))
3863      (byte-compile-closure (cons 'lambda (cdr (cdr form))))      (byte-compile-closure (cons 'lambda (cdr (cdr form)))))
3864      (byte-compile-out 'byte-fset)    (byte-compile-out 'byte-call 2))
     (byte-compile-discard))  
   (byte-compile-constant (nth 1 form)))  
3865    
3866  (defun byte-compile-defmacro (form)  (defun byte-compile-defmacro (form)
3867    ;; This is not used for file-level defmacros with doc strings.    ;; This is not used for file-level defmacros with doc strings.
# Line 3865  if LFORMINFO is nil (meaning all binding Line 3885  if LFORMINFO is nil (meaning all binding
3885          (value (nth 2 form))          (value (nth 2 form))
3886          (string (nth 3 form)))          (string (nth 3 form)))
3887      (byte-compile-set-symbol-position fun)      (byte-compile-set-symbol-position fun)
3888      (when (> (length form) 4)      (when (or (> (length form) 4)
3889        (byte-compile-warn                (and (eq fun 'defconst) (null (cddr form))))
3890         "%s %s called with %d arguments, but accepts only %s"        (let ((ncall (length (cdr form))))
3891         fun var (length (cdr form)) 3))          (byte-compile-warn
3892             "%s called with %d argument%s, but %s %s"
3893             fun ncall
3894             (if (= 1 ncall) "" "s")
3895             (if (< ncall 2) "requires" "accepts only")
3896             "2-3")))
3897      (when (memq 'free-vars byte-compile-warnings)      (when (memq 'free-vars byte-compile-warnings)
3898        (setq byte-compile-bound-variables        (push var byte-compile-bound-variables)
3899              (cons var byte-compile-bound-variables)))        (if (eq fun 'defconst)
3900              (push var byte-compile-const-variables)))
3901      (byte-compile-body-do-effect      (byte-compile-body-do-effect
3902       (list       (list
3903        ;; Put the defined variable in this library's load-history entry        ;; Put the defined variable in this library's load-history entry
# Line 3884  if LFORMINFO is nil (meaning all binding Line 3910  if LFORMINFO is nil (meaning all binding
3910                               fun var string))                               fun var string))
3911          `(put ',var 'variable-documentation ,string))          `(put ',var 'variable-documentation ,string))
3912        (if (cddr form)           ; `value' provided        (if (cddr form)           ; `value' provided
3913            (if (eq fun 'defconst)            (let ((byte-compile-not-obsolete-var var))
3914                ;; `defconst' sets `var' unconditionally.              (if (eq fun 'defconst)
3915                (let ((tmp (make-symbol "defconst-tmp-var")))                  ;; `defconst' sets `var' unconditionally.
3916                  `(let ((,tmp ,value))                  (let ((tmp (make-symbol "defconst-tmp-var")))
3917                     (eval '(defconst ,var ,tmp))))                    `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
3918              ;; `defvar' sets `var' only when unbound.                              ,value))
3919              `(if (not (boundp ',var)) (setq ,var ,value))))                ;; `defvar' sets `var' only when unbound.
3920                  `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
3921            (when (eq fun 'defconst)
3922              ;; This will signal an appropriate error at runtime.
3923              `(eval ',form)))
3924        `',var))))        `',var))))
3925    
3926  (defun byte-compile-autoload (form)  (defun byte-compile-autoload (form)
# Line 3923  if LFORMINFO is nil (meaning all binding Line 3953  if LFORMINFO is nil (meaning all binding
3953             (consp (cdr (nth 2 form)))             (consp (cdr (nth 2 form)))
3954             (symbolp (nth 1 (nth 2 form))))             (symbolp (nth 1 (nth 2 form))))
3955        (progn        (progn
3956          (byte-compile-defalias-warn (nth 1 (nth 1 form))          (byte-compile-defalias-warn (nth 1 (nth 1 form)))
                                     (nth 1 (nth 2 form)))  
3957          (setq byte-compile-function-environment          (setq byte-compile-function-environment
3958                (cons (cons (nth 1 (nth 1 form))                (cons (cons (nth 1 (nth 1 form))
3959                            (nth 1 (nth 2 form)))                            (nth 1 (nth 2 form)))
# Line 3934  if LFORMINFO is nil (meaning all binding Line 3963  if LFORMINFO is nil (meaning all binding
3963  ;; Turn off warnings about prior calls to the function being defalias'd.  ;; Turn off warnings about prior calls to the function being defalias'd.
3964  ;; This could be smarter and compare those calls with  ;; This could be smarter and compare those calls with
3965  ;; the function it is being aliased to.  ;; the function it is being aliased to.
3966  (defun byte-compile-defalias-warn (new alias)  (defun byte-compile-defalias-warn (new)
3967    (let ((calls (assq new byte-compile-unresolved-functions)))    (let ((calls (assq new byte-compile-unresolved-functions)))
3968      (if calls      (if calls
3969          (setq byte-compile-unresolved-functions          (setq byte-compile-unresolved-functions
3970                (delq calls byte-compile-unresolved-functions)))))                (delq calls byte-compile-unresolved-functions)))))
3971    
3972    (byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
3973    (defun byte-compile-no-warnings (form)
3974      (let (byte-compile-warnings)
3975        (byte-compile-form (cadr form))))
3976    
3977  ;;; tags  ;;; tags
3978    
# Line 3961  if LFORMINFO is nil (meaning all binding Line 3995  if LFORMINFO is nil (meaning all binding
3995      (setcdr (cdr tag) byte-compile-depth)))      (setcdr (cdr tag) byte-compile-depth)))
3996    
3997  (defun byte-compile-goto (opcode tag)  (defun byte-compile-goto (opcode tag)
3998    (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))    (push (cons opcode tag) byte-compile-output)
3999    (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)    (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
4000                          (1- byte-compile-depth)                          (1- byte-compile-depth)
4001                        byte-compile-depth))                        byte-compile-depth))
# Line 4304  For example, invoke `emacs -batch -f bat Line 4338  For example, invoke `emacs -batch -f bat
4338    
4339  ;;; report metering (see the hacks in bytecode.c)  ;;; report metering (see the hacks in bytecode.c)
4340    
4341    (defvar byte-code-meter)
4342  (defun byte-compile-report-ops ()  (defun byte-compile-report-ops ()
   (defvar byte-code-meter)  
4343    (with-output-to-temp-buffer "*Meter*"    (with-output-to-temp-buffer "*Meter*"
4344      (set-buffer "*Meter*")      (set-buffer "*Meter*")
4345      (let ((i 0) n op off)      (let ((i 0) n op off)
# Line 4354  For example, invoke `emacs -batch -f bat Line 4388  For example, invoke `emacs -batch -f bat
4388    
4389  (run-hooks 'bytecomp-load-hook)  (run-hooks 'bytecomp-load-hook)
4390    
4391    ;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a
4392  ;;; bytecomp.el ends here  ;;; bytecomp.el ends here

Legend:
Removed from v.2.98.2.9  
changed lines
  Added in v.2.98.2.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26