diff options
| author | Richard M. Stallman | 1992-07-15 20:26:37 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-07-15 20:26:37 +0000 |
| commit | 52799cb807287a949bcf79ab1254f85529b03ca9 (patch) | |
| tree | dd86e09ba820a357496047f88e89f0f457a5b3bb | |
| parent | 83023647e0c1769ad958d0c87618955f04d6b618 (diff) | |
| download | emacs-52799cb807287a949bcf79ab1254f85529b03ca9.tar.gz emacs-52799cb807287a949bcf79ab1254f85529b03ca9.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 589 |
1 files changed, 275 insertions, 314 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1b30194690e..57f83ca57b6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -1,10 +1,11 @@ | |||
| 1 | ;;; -*- Mode: Emacs-Lisp -*- | 1 | ;;; -*- Mode: Emacs-Lisp -*- |
| 2 | ;;; Compilation of Lisp code into byte code. | 2 | ;;; Compilation of Lisp code into byte code. |
| 3 | ;;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. | 3 | ;;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; By Jamie Zawinski <jwz@lucid.com> and Hallvard Furuseth <hbf@ulrik.uio.no>. | 5 | ;; By Jamie Zawinski <jwz@lucid.com> and Hallvard Furuseth <hbf@ulrik.uio.no>. |
| 6 | ;; Subsequently modified by RMS. | ||
| 6 | 7 | ||
| 7 | (defconst byte-compile-version "2.04; 5-feb-92.") | 8 | (defconst byte-compile-version "FSF 2.1") |
| 8 | 9 | ||
| 9 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| 10 | 11 | ||
| @@ -24,12 +25,13 @@ | |||
| 24 | 25 | ||
| 25 | ;;; ======================================================================== | 26 | ;;; ======================================================================== |
| 26 | ;;; Entry points: | 27 | ;;; Entry points: |
| 27 | ;;; byte-recompile-directory, byte-compile-file, | 28 | ;;; byte-recompile-directory, byte-compile-file, batch-byte-compile, |
| 28 | ;;; byte-compile-and-load-file byte-compile-buffer, batch-byte-compile, | 29 | ;;; byte-compile, compile-defun |
| 29 | ;;; byte-compile, byte-compile-sexp, elisp-compile-defun, | 30 | ;;; display-call-tree |
| 30 | ;;; byte-compile-report-call-tree | 31 | ;;; (byte-compile-buffer and byte-compile-and-load-file were turned off |
| 32 | ;;; because they are not terribly useful and get in the way of completion.) | ||
| 31 | 33 | ||
| 32 | ;;; This version of the elisp byte compiler has the following improvements: | 34 | ;;; This version of the byte compiler has the following improvements: |
| 33 | ;;; + optimization of compiled code: | 35 | ;;; + optimization of compiled code: |
| 34 | ;;; - removal of unreachable code; | 36 | ;;; - removal of unreachable code; |
| 35 | ;;; - removal of calls to side-effectless functions whose return-value | 37 | ;;; - removal of calls to side-effectless functions whose return-value |
| @@ -83,47 +85,27 @@ | |||
| 83 | ;;; or redefined to take other args) | 85 | ;;; or redefined to take other args) |
| 84 | ;;; This defaults to nil in -batch mode, which is | 86 | ;;; This defaults to nil in -batch mode, which is |
| 85 | ;;; slightly faster. | 87 | ;;; slightly faster. |
| 86 | ;;; byte-compile-emacs18-compatibility Whether the compiler should | 88 | ;;; byte-compile-compatibility Whether the compiler should |
| 87 | ;;; generate .elc files which can be loaded into | 89 | ;;; generate .elc files which can be loaded into |
| 88 | ;;; generic emacs 18's which don't have the file | 90 | ;;; generic emacs 18. |
| 89 | ;;; bytecomp-runtime.el loaded as well; | ||
| 90 | ;;; byte-compile-generate-emacs19-bytecodes Whether to generate bytecodes | ||
| 91 | ;;; which exist only in emacs19. This is a more | ||
| 92 | ;;; extreme step than setting emacs18-compatibility | ||
| 93 | ;;; to nil, because there is no elisp you can load | ||
| 94 | ;;; into an emacs18 to make files compiled this | ||
| 95 | ;;; way work. | ||
| 96 | ;;; byte-compile-single-version Normally the byte-compiler will consult the | 91 | ;;; byte-compile-single-version Normally the byte-compiler will consult the |
| 97 | ;;; above two variables at runtime, but if this | 92 | ;;; above two variables at runtime, but if this |
| 98 | ;;; variable is true when the compiler itself is | 93 | ;;; variable is true when the compiler itself is |
| 99 | ;;; compiled, then the runtime checks will not be | 94 | ;;; compiled, then the runtime checks will not be |
| 100 | ;;; made, and compilation will be slightly faster. | 95 | ;;; made, and compilation will be slightly faster. |
| 101 | ;;; elisp-source-extention-re Regexp for the extention of elisp source-files; | ||
| 102 | ;;; see also the function byte-compile-dest-file. | ||
| 103 | ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. | 96 | ;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. |
| 104 | ;;; | ||
| 105 | ;;; Most of the above parameters can also be set on a file-by-file basis; see | ||
| 106 | ;;; the documentation of the `byte-compiler-options' macro. | ||
| 107 | 97 | ||
| 108 | ;;; New Features: | 98 | ;;; New Features: |
| 109 | ;;; | 99 | ;;; |
| 110 | ;;; o The form `defsubst' is just like `defun', except that the function | 100 | ;;; o The form `defsubst' is just like `defun', except that the function |
| 111 | ;;; generated will be open-coded in compiled code which uses it. This | 101 | ;;; generated will be open-coded in compiled code which uses it. This |
| 112 | ;;; means that no function call will be generated, it will simply be | 102 | ;;; means that no function call will be generated, it will simply be |
| 113 | ;;; spliced in. Elisp functions calls are very slow, so this can be a | 103 | ;;; spliced in. Lisp functions calls are very slow, so this can be a |
| 114 | ;;; big win. | 104 | ;;; big win. |
| 115 | ;;; | 105 | ;;; |
| 116 | ;;; You can generally accomplish the same thing with `defmacro', but in | 106 | ;;; You can generally accomplish the same thing with `defmacro', but in |
| 117 | ;;; that case, the defined procedure can't be used as an argument to | 107 | ;;; that case, the defined procedure can't be used as an argument to |
| 118 | ;;; mapcar, etc. | 108 | ;;; mapcar, etc. |
| 119 | ;;; | ||
| 120 | ;;; o You can make a given function be inline even if it has already been | ||
| 121 | ;;; defined with `defun' by using the `proclaim-inline' form like so: | ||
| 122 | ;;; (proclaim-inline my-function) | ||
| 123 | ;;; This is, in fact, exactly what `defsubst' does. To make a function no | ||
| 124 | ;;; longer be inline, you must use `proclaim-notinline'. Beware that if | ||
| 125 | ;;; you define a function with `defsubst' and later redefine it with | ||
| 126 | ;;; `defun', it will still be open-coded until you use proclaim-notinline. | ||
| 127 | ;;; | 109 | ;;; |
| 128 | ;;; o You can also open-code one particular call to a function without | 110 | ;;; o You can also open-code one particular call to a function without |
| 129 | ;;; open-coding all calls. Use the 'inline' form to do this, like so: | 111 | ;;; open-coding all calls. Use the 'inline' form to do this, like so: |
| @@ -153,7 +135,7 @@ | |||
| 153 | ;;; | 135 | ;;; |
| 154 | ;;; o The command Meta-X byte-compile-and-load-file does what you'd think. | 136 | ;;; o The command Meta-X byte-compile-and-load-file does what you'd think. |
| 155 | ;;; | 137 | ;;; |
| 156 | ;;; o The command elisp-compile-defun is analogous to eval-defun. | 138 | ;;; o The command compile-defun is analogous to eval-defun. |
| 157 | ;;; | 139 | ;;; |
| 158 | ;;; o If you run byte-compile-file on a filename which is visited in a | 140 | ;;; o If you run byte-compile-file on a filename which is visited in a |
| 159 | ;;; buffer, and that buffer is modified, you are asked whether you want | 141 | ;;; buffer, and that buffer is modified, you are asked whether you want |
| @@ -161,21 +143,12 @@ | |||
| 161 | 143 | ||
| 162 | (or (fboundp 'defsubst) | 144 | (or (fboundp 'defsubst) |
| 163 | ;; This really ought to be loaded already! | 145 | ;; This really ought to be loaded already! |
| 164 | (load-library "bytecomp-runtime")) | 146 | (load-library "byte-run")) |
| 165 | 147 | ||
| 166 | (eval-when-compile | 148 | ;;; The feature of compiling in a specific target Emacs version |
| 167 | (defvar byte-compile-single-version nil | 149 | ;;; has been turned off because compile time options are a bad idea. |
| 168 | "If this is true, the choice of emacs version (v18 or v19) byte-codes will | 150 | (defmacro byte-compile-single-version () nil) |
| 169 | be hard-coded into bytecomp when it compiles itself. If the compiler itself | 151 | (defmacro byte-compile-version-cond (cond) cond) |
| 170 | is compiled with optimization, this causes a speedup.") | ||
| 171 | |||
| 172 | (cond (byte-compile-single-version | ||
| 173 | (defmacro byte-compile-single-version () t) | ||
| 174 | (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond)))) | ||
| 175 | (t | ||
| 176 | (defmacro byte-compile-single-version () nil) | ||
| 177 | (defmacro byte-compile-version-cond (cond) cond))) | ||
| 178 | ) | ||
| 179 | 152 | ||
| 180 | ;;; The crud you see scattered through this file of the form | 153 | ;;; The crud you see scattered through this file of the form |
| 181 | ;;; (or (and (boundp 'epoch::version) epoch::version) | 154 | ;;; (or (and (boundp 'epoch::version) epoch::version) |
| @@ -183,74 +156,65 @@ is compiled with optimization, this causes a speedup.") | |||
| 183 | ;;; is because the Epoch folks couldn't be bothered to follow the | 156 | ;;; is because the Epoch folks couldn't be bothered to follow the |
| 184 | ;;; normal emacs version numbering convention. | 157 | ;;; normal emacs version numbering convention. |
| 185 | 158 | ||
| 186 | (if (byte-compile-version-cond | 159 | ;; (if (byte-compile-version-cond |
| 187 | (or (and (boundp 'epoch::version) epoch::version) | 160 | ;; (or (and (boundp 'epoch::version) epoch::version) |
| 188 | (string-lessp emacs-version "19"))) | 161 | ;; (string-lessp emacs-version "19"))) |
| 189 | (progn | 162 | ;; (progn |
| 190 | ;; emacs-18 compatibility. | 163 | ;; ;; emacs-18 compatibility. |
| 191 | (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined | 164 | ;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined |
| 192 | 165 | ;; | |
| 193 | (if (byte-compile-single-version) | 166 | ;; (if (byte-compile-single-version) |
| 194 | (defmacro compiled-function-p (x) "Emacs 18 doesn't have these." nil) | 167 | ;; (defmacro compiled-function-p (x) "Emacs 18 doesn't have these." nil) |
| 195 | (defun compiled-function-p (x) "Emacs 18 doesn't have these." nil)) | 168 | ;; (defun compiled-function-p (x) "Emacs 18 doesn't have these." nil)) |
| 196 | 169 | ;; | |
| 197 | (or (and (fboundp 'member) | 170 | ;; (or (and (fboundp 'member) |
| 198 | ;; avoid using someone else's possibly bogus definition of this. | 171 | ;; ;; avoid using someone else's possibly bogus definition of this. |
| 199 | (subrp (symbol-function 'member))) | 172 | ;; (subrp (symbol-function 'member))) |
| 200 | (defun member (elt list) | 173 | ;; (defun member (elt list) |
| 201 | "like memq, but uses equal instead of eq. In v19, this is a subr." | 174 | ;; "like memq, but uses equal instead of eq. In v19, this is a subr." |
| 202 | (while (and list (not (equal elt (car list)))) | 175 | ;; (while (and list (not (equal elt (car list)))) |
| 203 | (setq list (cdr list))) | 176 | ;; (setq list (cdr list))) |
| 204 | list)) | 177 | ;; list)))) |
| 205 | )) | 178 | |
| 206 | 179 | ||
| 207 | 180 | (defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms) | |
| 208 | (defvar elisp-source-extention-re (if (eq system-type 'vax-vms) | 181 | "\\.EL\\(;[0-9]+\\)?$" |
| 209 | "\\.EL\\(;[0-9]+\\)?$" | 182 | "\\.el$") |
| 210 | "\\.el$") | 183 | "*Regexp which matches Emacs Lisp source files. |
| 211 | "*Regexp which matches the extention of elisp source-files. | 184 | You may want to redefine `byte-compile-dest-file' if you change this.") |
| 212 | You may want to redefine defun byte-compile-dest-file to match this.") | ||
| 213 | 185 | ||
| 214 | (or (fboundp 'byte-compile-dest-file) | 186 | (or (fboundp 'byte-compile-dest-file) |
| 215 | ;; The user may want to redefine this along with elisp-source-extention-re, | 187 | ;; The user may want to redefine this, |
| 216 | ;; so only define it if it is undefined. | 188 | ;; so only define it if it is undefined. |
| 217 | (defun byte-compile-dest-file (filename) | 189 | (defun byte-compile-dest-file (filename) |
| 218 | "Converts an emacs-lisp source-filename to a compiled-filename." | 190 | "Convert an Emacs Lisp source file name to a compiled file name." |
| 219 | (setq filename (file-name-sans-versions filename)) | 191 | (setq filename (file-name-sans-versions filename)) |
| 220 | (cond ((eq system-type 'vax-vms) | 192 | (cond ((eq system-type 'vax-vms) |
| 221 | (concat (substring filename 0 (string-match ";" filename)) "c")) | 193 | (concat (substring filename 0 (string-match ";" filename)) "c")) |
| 222 | ((string-match elisp-source-extention-re filename) | ||
| 223 | (concat (substring filename 0 (match-beginning 0)) ".elc")) | ||
| 224 | (t (concat filename "c"))))) | 194 | (t (concat filename "c"))))) |
| 225 | 195 | ||
| 226 | ;; This can be the 'byte-compile property of any symbol. | 196 | ;; This can be the 'byte-compile property of any symbol. |
| 227 | (autoload 'byte-compile-inline-expand "byte-optimize") | 197 | (autoload 'byte-compile-inline-expand "byte-opt") |
| 228 | 198 | ||
| 229 | ;; This is the entrypoint to the lapcode optimizer pass1. | 199 | ;; This is the entrypoint to the lapcode optimizer pass1. |
| 230 | (autoload 'byte-optimize-form "byte-optimize") | 200 | (autoload 'byte-optimize-form "byte-opt") |
| 231 | ;; This is the entrypoint to the lapcode optimizer pass2. | 201 | ;; This is the entrypoint to the lapcode optimizer pass2. |
| 232 | (autoload 'byte-optimize-lapcode "byte-optimize") | 202 | (autoload 'byte-optimize-lapcode "byte-opt") |
| 233 | (autoload 'byte-compile-unfold-lambda "byte-optimize") | 203 | (autoload 'byte-compile-unfold-lambda "byte-opt") |
| 234 | 204 | ||
| 235 | (defvar byte-compile-verbose | 205 | (defvar byte-compile-verbose |
| 236 | (and (not noninteractive) (> baud-rate search-slow-speed)) | 206 | (and (not noninteractive) (> baud-rate search-slow-speed)) |
| 237 | "*Non-nil means print messages describing progress of byte-compiler.") | 207 | "*Non-nil means print messages describing progress of byte-compiler.") |
| 238 | 208 | ||
| 239 | (defvar byte-compile-emacs18-compatibility | 209 | (defvar byte-compile-compatibility nil |
| 240 | (or (and (boundp 'epoch::version) epoch::version) | 210 | "*Non-nil means generate output that can run in Emacs 18.") |
| 241 | (string-lessp emacs-version "19")) | 211 | |
| 242 | "*If this is true, then the byte compiler will generate .elc files which will | 212 | ;; (defvar byte-compile-generate-emacs19-bytecodes |
| 243 | work in generic version 18 emacses without having bytecomp-runtime.el loaded. | 213 | ;; (not (or (and (boundp 'epoch::version) epoch::version) |
| 244 | If this is false, the generated code will be more efficient in emacs 19, and | 214 | ;; (string-lessp emacs-version "19"))) |
| 245 | will be loadable in emacs 18 only if bytecomp-runtime.el is loaded. | 215 | ;; "*If this is true, then the byte-compiler will generate bytecode which |
| 246 | See also byte-compile-generate-emacs19-bytecodes.") | 216 | ;; makes use of byte-ops which are present only in Emacs 19. Code generated |
| 247 | 217 | ;; this way can never be run in Emacs 18, and may even cause it to crash.") | |
| 248 | (defvar byte-compile-generate-emacs19-bytecodes | ||
| 249 | (not (or (and (boundp 'epoch::version) epoch::version) | ||
| 250 | (string-lessp emacs-version "19"))) | ||
| 251 | "*If this is true, then the byte-compiler will generate bytecode which | ||
| 252 | makes use of byte-ops which are present only in emacs19. Code generated | ||
| 253 | this way can never be run in emacs18, and may even cause it to crash.") | ||
| 254 | 218 | ||
| 255 | (defvar byte-optimize t | 219 | (defvar byte-optimize t |
| 256 | "*If nil, no compile-optimizations will be done. | 220 | "*If nil, no compile-optimizations will be done. |
| @@ -275,20 +239,22 @@ of `message.'") | |||
| 275 | (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved)) | 239 | (defconst byte-compile-warning-types '(redefine callargs free-vars unresolved)) |
| 276 | (defvar byte-compile-warnings (not noninteractive) | 240 | (defvar byte-compile-warnings (not noninteractive) |
| 277 | "*List of warnings that the byte-compiler should issue (t for all). | 241 | "*List of warnings that the byte-compiler should issue (t for all). |
| 278 | See doc of macro byte-compiler-options.") | 242 | Valid elements of this list are `callargs', `redefine', `free-vars', |
| 243 | and `unresolved'.") | ||
| 279 | 244 | ||
| 280 | (defvar byte-compile-generate-call-tree nil | 245 | (defvar byte-compile-generate-call-tree nil |
| 281 | "*If this is true, then the compiler will collect statistics on what | 246 | "*Non-nil means collect call-graph information when compiling. |
| 282 | functions were called and from where. This will be displayed after the | 247 | This records functions were called and from where. |
| 283 | compilation completes. If it is non-nil, but not t, you will be asked | 248 | If the value is t, compilation displays the call graph when it finishes. |
| 284 | for whether to display this. | 249 | If the value is neither t nor nil, compilation asks you whether to display |
| 250 | the graph. | ||
| 285 | 251 | ||
| 286 | The call tree only lists functions called, not macros used. Those functions | 252 | The call tree only lists functions called, not macros used. Those functions |
| 287 | which the byte-code interpreter knows about directly (eq, cons, etc.) are | 253 | which the byte-code interpreter knows about directly (eq, cons, etc.) are |
| 288 | not reported. | 254 | not reported. |
| 289 | 255 | ||
| 290 | The call tree also lists those functions which are not known to be called | 256 | The call tree also lists those functions which are not known to be called |
| 291 | (that is, to which no calls have been compiled.) Functions which can be | 257 | \(that is, to which no calls have been compiled.) Functions which can be |
| 292 | invoked interactively are excluded from this list.") | 258 | invoked interactively are excluded from this list.") |
| 293 | 259 | ||
| 294 | (defconst byte-compile-call-tree nil "Alist of functions and their call tree. | 260 | (defconst byte-compile-call-tree nil "Alist of functions and their call tree. |
| @@ -301,17 +267,17 @@ is a list of functions for which calls were generated while compiling | |||
| 301 | FUNCTION.") | 267 | FUNCTION.") |
| 302 | 268 | ||
| 303 | (defvar byte-compile-call-tree-sort 'name | 269 | (defvar byte-compile-call-tree-sort 'name |
| 304 | "*If non nil, the call tree is sorted. | 270 | "*If non-nil, sort the call tree. |
| 305 | The values 'name, 'callers, 'calls, 'calls+callers means to sort on | 271 | The values `name', `callers', `calls', `calls+callers' |
| 306 | the those fields.") | 272 | specify different fields to sort on.") |
| 307 | 273 | ||
| 308 | (defvar byte-compile-overwrite-file t | 274 | ;; (defvar byte-compile-overwrite-file t |
| 309 | "If nil, old .elc files are deleted before the new is saved, and .elc | 275 | ;; "If nil, old .elc files are deleted before the new is saved, and .elc |
| 310 | files will have the same modes as the corresponding .el file. Otherwise, | 276 | ;; files will have the same modes as the corresponding .el file. Otherwise, |
| 311 | existing .elc files will simply be overwritten, and the existing modes | 277 | ;; existing .elc files will simply be overwritten, and the existing modes |
| 312 | will not be changed. If this variable is nil, then an .elc file which | 278 | ;; will not be changed. If this variable is nil, then an .elc file which |
| 313 | is a symbolic link will be turned into a normal file, instead of the file | 279 | ;; is a symbolic link will be turned into a normal file, instead of the file |
| 314 | which the link points to being overwritten.") | 280 | ;; which the link points to being overwritten.") |
| 315 | 281 | ||
| 316 | (defvar byte-compile-constants nil | 282 | (defvar byte-compile-constants nil |
| 317 | "list of all constants encountered during compilation of this form") | 283 | "list of all constants encountered during compilation of this form") |
| @@ -324,8 +290,9 @@ lives partly on the stack.") | |||
| 324 | (defvar byte-compile-free-assignments) | 290 | (defvar byte-compile-free-assignments) |
| 325 | 291 | ||
| 326 | (defconst byte-compile-initial-macro-environment | 292 | (defconst byte-compile-initial-macro-environment |
| 327 | '((byte-compiler-options . (lambda (&rest forms) | 293 | '( |
| 328 | (apply 'byte-compiler-options-handler forms))) | 294 | ;; (byte-compiler-options . (lambda (&rest forms) |
| 295 | ;; (apply 'byte-compiler-options-handler forms))) | ||
| 329 | (eval-when-compile . (lambda (&rest body) | 296 | (eval-when-compile . (lambda (&rest body) |
| 330 | (list 'quote (eval (byte-compile-top-level | 297 | (list 'quote (eval (byte-compile-top-level |
| 331 | (cons 'progn body)))))) | 298 | (cons 'progn body)))))) |
| @@ -337,13 +304,15 @@ Placing a macro here will cause a macro to have different semantics when | |||
| 337 | expanded by the compiler as when expanded by the interpreter.") | 304 | expanded by the compiler as when expanded by the interpreter.") |
| 338 | 305 | ||
| 339 | (defvar byte-compile-macro-environment byte-compile-initial-macro-environment | 306 | (defvar byte-compile-macro-environment byte-compile-initial-macro-environment |
| 340 | "Alist of (MACRONAME . DEFINITION) macros defined in the file which is being | 307 | "Alist of macros defined in the file being compiled. |
| 341 | compiled. It is (MACRONAME . nil) when a macro is redefined as a function.") | 308 | Each element looks like (MACRONAME . DEFINITION). It is |
| 309 | \(MACRONAME . nil) when a function is redefined as a function.") | ||
| 342 | 310 | ||
| 343 | (defvar byte-compile-function-environment nil | 311 | (defvar byte-compile-function-environment nil |
| 344 | "Alist of (FUNCTIONNAME . DEFINITION) functions defined in the file which | 312 | "Alist of functions defined in the file being compiled. |
| 345 | is being compiled (this is so we can inline them if necessary). It is | 313 | This is so we can inline them when necessary. |
| 346 | (FUNCTIONNAME . nil) when a function is redefined as a macro.") | 314 | Each element looks like (FUNCTIONNAME . DEFINITION). It is |
| 315 | \(FUNCTIONNAME . nil) when a function is redefined as a macro.") | ||
| 347 | 316 | ||
| 348 | (defvar byte-compile-unresolved-functions nil | 317 | (defvar byte-compile-unresolved-functions nil |
| 349 | "Alist of undefined functions to which calls have been compiled (used for | 318 | "Alist of undefined functions to which calls have been compiled (used for |
| @@ -514,25 +483,27 @@ otherwise pop it") | |||
| 514 | (byte-defop 142 -1 byte-unwind-protect | 483 | (byte-defop 142 -1 byte-unwind-protect |
| 515 | "for unwind-protect. Takes, on stack, an expression for the unwind-action") | 484 | "for unwind-protect. Takes, on stack, an expression for the unwind-action") |
| 516 | 485 | ||
| 517 | (byte-defop 143 -2 byte-condition-case | 486 | ;; For condition-case. Takes, on stack, the variable to bind, |
| 518 | "for condition-case. Takes, on stack, the variable to bind, | 487 | ;; an expression for the body, and a list of clauses. |
| 519 | an expression for the body, and a list of clauses") | 488 | (byte-defop 143 -2 byte-condition-case) |
| 520 | 489 | ||
| 521 | (byte-defop 144 0 byte-temp-output-buffer-setup | 490 | ;; For entry to with-output-to-temp-buffer. |
| 522 | "for entry to with-output-to-temp-buffer. | 491 | ;; Takes, on stack, the buffer name. |
| 523 | Takes, on stack, the buffer name. | 492 | ;; Binds standard-output and does some other things. |
| 524 | Binds standard-output and does some other things. | 493 | ;; Returns with temp buffer on the stack in place of buffer name. |
| 525 | Returns with temp buffer on the stack in place of buffer name") | 494 | (byte-defop 144 0 byte-temp-output-buffer-setup) |
| 526 | 495 | ||
| 527 | (byte-defop 145 -1 byte-temp-output-buffer-show | 496 | ;; For exit from with-output-to-temp-buffer. |
| 528 | "for exit from with-output-to-temp-buffer. | 497 | ;; Expects the temp buffer on the stack underneath value to return. |
| 529 | Expects the temp buffer on the stack underneath value to return. | 498 | ;; Pops them both, then pushes the value back on. |
| 530 | Pops them both, then pushes the value back on. | 499 | ;; Unbinds standard-output and makes the temp buffer visible. |
| 531 | Unbinds standard-output and makes the temp buffer visible") | 500 | (byte-defop 145 -1 byte-temp-output-buffer-show) |
| 532 | 501 | ||
| 533 | ;; these ops are new to v19 | 502 | ;; these ops are new to v19 |
| 534 | (byte-defop 146 0 byte-unbind-all "to unbind back to the beginning of | 503 | |
| 535 | this frame. Not used yet, but wil be needed for tail-recursion elimination.") | 504 | ;; To unbind back to the beginning of this frame. |
| 505 | ;; Not used yet, but wil be needed for tail-recursion elimination. | ||
| 506 | (byte-defop 146 0 byte-unbind-all) | ||
| 536 | 507 | ||
| 537 | ;; these ops are new to v19 | 508 | ;; these ops are new to v19 |
| 538 | (byte-defop 147 -2 byte-set-marker) | 509 | (byte-defop 147 -2 byte-set-marker) |
| @@ -581,7 +552,7 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 581 | (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil | 552 | (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil |
| 582 | byte-goto-if-nil-else-pop | 553 | byte-goto-if-nil-else-pop |
| 583 | byte-goto-if-not-nil-else-pop) | 554 | byte-goto-if-not-nil-else-pop) |
| 584 | "those byte-codes whose offset is a pc.") | 555 | "List of byte-codes whose offset is a pc.") |
| 585 | 556 | ||
| 586 | (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) | 557 | (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) |
| 587 | 558 | ||
| @@ -589,7 +560,7 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 589 | byte-rel-goto-if-nil byte-rel-goto-if-not-nil | 560 | byte-rel-goto-if-nil byte-rel-goto-if-not-nil |
| 590 | byte-rel-goto-if-nil-else-pop | 561 | byte-rel-goto-if-nil-else-pop |
| 591 | byte-rel-goto-if-not-nil-else-pop) | 562 | byte-rel-goto-if-not-nil-else-pop) |
| 592 | "byte-codes for relative jumps.") | 563 | "List of byte-codes for relative jumps.") |
| 593 | 564 | ||
| 594 | (byte-extrude-byte-code-vectors) | 565 | (byte-extrude-byte-code-vectors) |
| 595 | 566 | ||
| @@ -636,7 +607,7 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 636 | (setq op (car (car lap)) | 607 | (setq op (car (car lap)) |
| 637 | off (cdr (car lap))) | 608 | off (cdr (car lap))) |
| 638 | (cond ((not (symbolp op)) | 609 | (cond ((not (symbolp op)) |
| 639 | (error "non-symbolic opcode %s" op)) | 610 | (error "Non-symbolic opcode `%s'" op)) |
| 640 | ((eq op 'TAG) | 611 | ((eq op 'TAG) |
| 641 | (setcar off pc) | 612 | (setcar off pc) |
| 642 | (setq patchlist (cons off patchlist))) | 613 | (setq patchlist (cons off patchlist))) |
| @@ -677,8 +648,8 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 677 | bytes)))))))) | 648 | bytes)))))))) |
| 678 | (setq lap (cdr lap))) | 649 | (setq lap (cdr lap))) |
| 679 | ;;(if (not (= pc (length bytes))) | 650 | ;;(if (not (= pc (length bytes))) |
| 680 | ;; (error "compiler error: pc mismatch - %s %s" pc (length bytes))) | 651 | ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) |
| 681 | (cond ((byte-compile-version-cond byte-compile-generate-emacs19-bytecodes) | 652 | (cond ((byte-compile-version-cond byte-compile-compatibility) |
| 682 | ;; Make relative jumps | 653 | ;; Make relative jumps |
| 683 | (setq patchlist (nreverse patchlist)) | 654 | (setq patchlist (nreverse patchlist)) |
| 684 | (while (progn | 655 | (while (progn |
| @@ -800,61 +771,61 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 800 | 771 | ||
| 801 | ;; Compiler options | 772 | ;; Compiler options |
| 802 | 773 | ||
| 803 | (defvar byte-compiler-legal-options | 774 | ;; (defvar byte-compiler-valid-options |
| 804 | '((optimize byte-optimize (t nil source byte) val) | 775 | ;; '((optimize byte-optimize (t nil source byte) val) |
| 805 | (file-format byte-compile-emacs18-compatibility (emacs18 emacs19) | 776 | ;; (file-format byte-compile-compatibility (emacs18 emacs19) |
| 806 | (eq val 'emacs18)) | 777 | ;; (eq val 'emacs18)) |
| 807 | (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val) | 778 | ;; ;; (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val) |
| 808 | (delete-errors byte-compile-delete-errors (t nil) val) | 779 | ;; (delete-errors byte-compile-delete-errors (t nil) val) |
| 809 | (verbose byte-compile-verbose (t nil) val) | 780 | ;; (verbose byte-compile-verbose (t nil) val) |
| 810 | (warnings byte-compile-warnings ((callargs redefine free-vars unresolved)) | 781 | ;; (warnings byte-compile-warnings ((callargs redefine free-vars unresolved)) |
| 811 | val))) | 782 | ;; val))) |
| 812 | 783 | ||
| 813 | ;; Inhibit v18/v19 selectors if the version is hardcoded. | 784 | ;; Inhibit v18/v19 selectors if the version is hardcoded. |
| 814 | ;; #### This should print a warning if the user tries to change something | 785 | ;; #### This should print a warning if the user tries to change something |
| 815 | ;; than can't be changed because the running compiler doesn't support it. | 786 | ;; than can't be changed because the running compiler doesn't support it. |
| 816 | (cond | 787 | ;; (cond |
| 817 | ((byte-compile-single-version) | 788 | ;; ((byte-compile-single-version) |
| 818 | (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-legal-options))) | 789 | ;; (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options))) |
| 819 | (list (byte-compile-version-cond | 790 | ;; (list (byte-compile-version-cond |
| 820 | byte-compile-generate-emacs19-bytecodes))) | 791 | ;; byte-compile-generate-emacs19-bytecodes))) |
| 821 | (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options))) | 792 | ;; (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options))) |
| 822 | (if (byte-compile-version-cond byte-compile-emacs18-compatibility) | 793 | ;; (if (byte-compile-version-cond byte-compile-compatibility) |
| 823 | '(emacs18) '(emacs19))))) | 794 | ;; '(emacs18) '(emacs19))))) |
| 824 | 795 | ||
| 825 | (defun byte-compiler-options-handler (&rest args) | 796 | ;; (defun byte-compiler-options-handler (&rest args) |
| 826 | (let (key val desc choices) | 797 | ;; (let (key val desc choices) |
| 827 | (while args | 798 | ;; (while args |
| 828 | (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) | 799 | ;; (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) |
| 829 | (error "malformed byte-compiler-option %s" (car args))) | 800 | ;; (error "Malformed byte-compiler option `%s'" (car args))) |
| 830 | (setq key (car (car args)) | 801 | ;; (setq key (car (car args)) |
| 831 | val (car (cdr (car args))) | 802 | ;; val (car (cdr (car args))) |
| 832 | desc (assq key byte-compiler-legal-options)) | 803 | ;; desc (assq key byte-compiler-valid-options)) |
| 833 | (or desc | 804 | ;; (or desc |
| 834 | (error "unknown byte-compiler option %s" key)) | 805 | ;; (error "Unknown byte-compiler option `%s'" key)) |
| 835 | (setq choices (nth 2 desc)) | 806 | ;; (setq choices (nth 2 desc)) |
| 836 | (if (consp (car choices)) | 807 | ;; (if (consp (car choices)) |
| 837 | (let (this | 808 | ;; (let (this |
| 838 | (handler 'cons) | 809 | ;; (handler 'cons) |
| 839 | (ret (and (memq (car val) '(+ -)) | 810 | ;; (ret (and (memq (car val) '(+ -)) |
| 840 | (copy-sequence (if (eq t (symbol-value (nth 1 desc))) | 811 | ;; (copy-sequence (if (eq t (symbol-value (nth 1 desc))) |
| 841 | choices | 812 | ;; choices |
| 842 | (symbol-value (nth 1 desc))))))) | 813 | ;; (symbol-value (nth 1 desc))))))) |
| 843 | (setq choices (car choices)) | 814 | ;; (setq choices (car choices)) |
| 844 | (while val | 815 | ;; (while val |
| 845 | (setq this (car val)) | 816 | ;; (setq this (car val)) |
| 846 | (cond ((memq this choices) | 817 | ;; (cond ((memq this choices) |
| 847 | (setq ret (funcall handler this ret))) | 818 | ;; (setq ret (funcall handler this ret))) |
| 848 | ((eq this '+) (setq handler 'cons)) | 819 | ;; ((eq this '+) (setq handler 'cons)) |
| 849 | ((eq this '-) (setq handler 'delq)) | 820 | ;; ((eq this '-) (setq handler 'delq)) |
| 850 | ((error "%s only accepts %s." key choices))) | 821 | ;; ((error "`%s' only accepts %s" key choices))) |
| 851 | (setq val (cdr val))) | 822 | ;; (setq val (cdr val))) |
| 852 | (set (nth 1 desc) ret)) | 823 | ;; (set (nth 1 desc) ret)) |
| 853 | (or (memq val choices) | 824 | ;; (or (memq val choices) |
| 854 | (error "%s must be one of %s." key choices)) | 825 | ;; (error "`%s' must be one of `%s'" key choices)) |
| 855 | (set (nth 1 desc) (eval (nth 3 desc)))) | 826 | ;; (set (nth 1 desc) (eval (nth 3 desc)))) |
| 856 | (setq args (cdr args))) | 827 | ;; (setq args (cdr args))) |
| 857 | nil)) | 828 | ;; nil)) |
| 858 | 829 | ||
| 859 | ;;; sanity-checking arglists | 830 | ;;; sanity-checking arglists |
| 860 | 831 | ||
| @@ -919,8 +890,8 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 919 | (t (format "%d-%d" (car signature) (cdr signature))))) | 890 | (t (format "%d-%d" (car signature) (cdr signature))))) |
| 920 | 891 | ||
| 921 | 892 | ||
| 893 | ;; Warn if the form is calling a function with the wrong number of arguments. | ||
| 922 | (defun byte-compile-callargs-warn (form) | 894 | (defun byte-compile-callargs-warn (form) |
| 923 | "warn if the form is calling a function with the wrong number of arguments." | ||
| 924 | (let* ((def (or (byte-compile-fdefinition (car form) nil) | 895 | (let* ((def (or (byte-compile-fdefinition (car form) nil) |
| 925 | (byte-compile-fdefinition (car form) t))) | 896 | (byte-compile-fdefinition (car form) t))) |
| 926 | (sig (and def (byte-compile-arglist-signature | 897 | (sig (and def (byte-compile-arglist-signature |
| @@ -951,9 +922,9 @@ this frame. Not used yet, but wil be needed for tail-recursion elimination.") | |||
| 951 | (cons (list (car form) n) | 922 | (cons (list (car form) n) |
| 952 | byte-compile-unresolved-functions)))))))) | 923 | byte-compile-unresolved-functions)))))))) |
| 953 | 924 | ||
| 925 | ;; Warn if the function or macro is being redefined with a different | ||
| 926 | ;; number of arguments. | ||
| 954 | (defun byte-compile-arglist-warn (form macrop) | 927 | (defun byte-compile-arglist-warn (form macrop) |
| 955 | "warn if the function or macro is being redefined with a different | ||
| 956 | number of arguments." | ||
| 957 | (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) | 928 | (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) |
| 958 | (if old | 929 | (if old |
| 959 | (let ((sig1 (byte-compile-arglist-signature | 930 | (let ((sig1 (byte-compile-arglist-signature |
| @@ -990,10 +961,10 @@ number of arguments." | |||
| 990 | (delq calls byte-compile-unresolved-functions))))) | 961 | (delq calls byte-compile-unresolved-functions))))) |
| 991 | ))) | 962 | ))) |
| 992 | 963 | ||
| 964 | ;; If we have compiled any calls to functions which are not known to be | ||
| 965 | ;; defined, issue a warning enumerating them. | ||
| 966 | ;; `unresolved' in the list `byte-compile-warnings' disables this. | ||
| 993 | (defun byte-compile-warn-about-unresolved-functions () | 967 | (defun byte-compile-warn-about-unresolved-functions () |
| 994 | "If we have compiled any calls to functions which are not known to be | ||
| 995 | defined, issue a warning enumerating them. You can disable this by including | ||
| 996 | 'unresolved in variable byte-compile-warnings." | ||
| 997 | (if (memq 'unresolved byte-compile-warnings) | 968 | (if (memq 'unresolved byte-compile-warnings) |
| 998 | (let ((byte-compile-current-form "the end of the data")) | 969 | (let ((byte-compile-current-form "the end of the data")) |
| 999 | (if (cdr byte-compile-unresolved-functions) | 970 | (if (cdr byte-compile-unresolved-functions) |
| @@ -1042,8 +1013,8 @@ defined, issue a warning enumerating them. You can disable this by including | |||
| 1042 | ;; | 1013 | ;; |
| 1043 | (byte-compile-verbose byte-compile-verbose) | 1014 | (byte-compile-verbose byte-compile-verbose) |
| 1044 | (byte-optimize byte-optimize) | 1015 | (byte-optimize byte-optimize) |
| 1045 | (byte-compile-generate-emacs19-bytecodes | 1016 | ;; (byte-compile-generate-emacs19-bytecodes |
| 1046 | byte-compile-generate-emacs19-bytecodes) | 1017 | ;; byte-compile-generate-emacs19-bytecodes) |
| 1047 | (byte-compile-warnings (if (eq byte-compile-warnings t) | 1018 | (byte-compile-warnings (if (eq byte-compile-warnings t) |
| 1048 | byte-compile-warning-types | 1019 | byte-compile-warning-types |
| 1049 | byte-compile-warnings)) | 1020 | byte-compile-warnings)) |
| @@ -1083,7 +1054,7 @@ for each such `.el' file, whether to compile it." | |||
| 1083 | (save-some-buffers) | 1054 | (save-some-buffers) |
| 1084 | (set-buffer-modified-p (buffer-modified-p)) ;Update the mode line. | 1055 | (set-buffer-modified-p (buffer-modified-p)) ;Update the mode line. |
| 1085 | (setq directory (expand-file-name directory)) | 1056 | (setq directory (expand-file-name directory)) |
| 1086 | (let ((files (directory-files directory nil elisp-source-extention-re)) | 1057 | (let ((files (directory-files directory nil emacs-lisp-file-regexp)) |
| 1087 | (count 0) | 1058 | (count 0) |
| 1088 | source dest) | 1059 | source dest) |
| 1089 | (while files | 1060 | (while files |
| @@ -1113,18 +1084,11 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling." | |||
| 1113 | 'emacs-lisp-mode) | 1084 | 'emacs-lisp-mode) |
| 1114 | (setq file-name (file-name-nondirectory file) | 1085 | (setq file-name (file-name-nondirectory file) |
| 1115 | file-dir (file-name-directory file))) | 1086 | file-dir (file-name-directory file))) |
| 1116 | (list (if (byte-compile-version-cond | 1087 | (list (read-file-name (if current-prefix-arg |
| 1117 | (or (and (boundp 'epoch::version) epoch::version) | 1088 | "Byte compile and load file: " |
| 1118 | (string-lessp emacs-version "19"))) | 1089 | "Byte compile file: ") |
| 1119 | (read-file-name (if current-prefix-arg | 1090 | file-dir file-name nil)) |
| 1120 | "Byte compile and load file: " | 1091 | current-prefix-arg)) |
| 1121 | "Byte compile file: ") | ||
| 1122 | file-dir file-name nil) | ||
| 1123 | (read-file-name (if current-prefix-arg | ||
| 1124 | "Byte compile and load file: " | ||
| 1125 | "Byte compile file: ") | ||
| 1126 | file-dir nil nil file-name)) | ||
| 1127 | current-prefix-arg))) | ||
| 1128 | ;; Expand now so we get the current buffer's defaults | 1092 | ;; Expand now so we get the current buffer's defaults |
| 1129 | (setq filename (expand-file-name filename)) | 1093 | (setq filename (expand-file-name filename)) |
| 1130 | 1094 | ||
| @@ -1155,10 +1119,10 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling." | |||
| 1155 | (insert "\n") ; aaah, unix. | 1119 | (insert "\n") ; aaah, unix. |
| 1156 | (let ((vms-stmlf-recfm t)) | 1120 | (let ((vms-stmlf-recfm t)) |
| 1157 | (setq target-file (byte-compile-dest-file filename)) | 1121 | (setq target-file (byte-compile-dest-file filename)) |
| 1158 | (or byte-compile-overwrite-file | 1122 | ;; (or byte-compile-overwrite-file |
| 1159 | (condition-case () | 1123 | ;; (condition-case () |
| 1160 | (delete-file target-file) | 1124 | ;; (delete-file target-file) |
| 1161 | (error nil))) | 1125 | ;; (error nil))) |
| 1162 | (if (file-writable-p target-file) | 1126 | (if (file-writable-p target-file) |
| 1163 | (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki | 1127 | (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki |
| 1164 | (write-region 1 (point-max) target-file)) | 1128 | (write-region 1 (point-max) target-file)) |
| @@ -1168,10 +1132,11 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling." | |||
| 1168 | "cannot overwrite file" | 1132 | "cannot overwrite file" |
| 1169 | "directory not writable or nonexistent") | 1133 | "directory not writable or nonexistent") |
| 1170 | target-file))) | 1134 | target-file))) |
| 1171 | (or byte-compile-overwrite-file | 1135 | ;; (or byte-compile-overwrite-file |
| 1172 | (condition-case () | 1136 | ;; (condition-case () |
| 1173 | (set-file-modes target-file (file-modes filename)) | 1137 | ;; (set-file-modes target-file (file-modes filename)) |
| 1174 | (error nil)))) | 1138 | ;; (error nil))) |
| 1139 | ) | ||
| 1175 | (kill-buffer (current-buffer))) | 1140 | (kill-buffer (current-buffer))) |
| 1176 | (if (and byte-compile-generate-call-tree | 1141 | (if (and byte-compile-generate-call-tree |
| 1177 | (or (eq t byte-compile-generate-call-tree) | 1142 | (or (eq t byte-compile-generate-call-tree) |
| @@ -1182,31 +1147,30 @@ With prefix arg (noninteractively: 2nd arg), load the file after compiling." | |||
| 1182 | (load target-file))) | 1147 | (load target-file))) |
| 1183 | t) | 1148 | t) |
| 1184 | 1149 | ||
| 1185 | (defun byte-compile-and-load-file (&optional filename) | 1150 | ;;(defun byte-compile-and-load-file (&optional filename) |
| 1186 | "Compile a file of Lisp code named FILENAME into a file of byte code, | 1151 | ;; "Compile a file of Lisp code named FILENAME into a file of byte code, |
| 1187 | and then load it. The output file's name is made by appending \"c\" to | 1152 | ;;and then load it. The output file's name is made by appending \"c\" to |
| 1188 | the end of FILENAME." | 1153 | ;;the end of FILENAME." |
| 1189 | (interactive) | 1154 | ;; (interactive) |
| 1190 | (if filename ; I don't get it, (interactive-p) doesn't always work | 1155 | ;; (if filename ; I don't get it, (interactive-p) doesn't always work |
| 1191 | (byte-compile-file filename t) | 1156 | ;; (byte-compile-file filename t) |
| 1192 | (let ((current-prefix-arg '(4))) | 1157 | ;; (let ((current-prefix-arg '(4))) |
| 1193 | (call-interactively 'byte-compile-file)))) | 1158 | ;; (call-interactively 'byte-compile-file)))) |
| 1194 | 1159 | ||
| 1195 | 1160 | ;;(defun byte-compile-buffer (&optional buffer) | |
| 1196 | (defun byte-compile-buffer (&optional buffer) | 1161 | ;; "Byte-compile and evaluate contents of BUFFER (default: the current buffer)." |
| 1197 | "Byte-compile and evaluate contents of BUFFER (default: the current buffer)." | 1162 | ;; (interactive "bByte compile buffer: ") |
| 1198 | (interactive "bByte compile buffer: ") | 1163 | ;; (setq buffer (if buffer (get-buffer buffer) (current-buffer))) |
| 1199 | (setq buffer (if buffer (get-buffer buffer) (current-buffer))) | 1164 | ;; (message "Compiling %s..." (buffer-name buffer)) |
| 1200 | (message "Compiling %s..." (buffer-name buffer)) | 1165 | ;; (let* ((filename (or (buffer-file-name buffer) |
| 1201 | (let* ((filename (or (buffer-file-name buffer) | 1166 | ;; (concat "#<buffer " (buffer-name buffer) ">"))) |
| 1202 | (concat "#<buffer " (buffer-name buffer) ">"))) | 1167 | ;; (byte-compile-current-file buffer)) |
| 1203 | (byte-compile-current-file buffer)) | 1168 | ;; (byte-compile-from-buffer buffer t)) |
| 1204 | (byte-compile-from-buffer buffer t)) | 1169 | ;; (message "Compiling %s...done" (buffer-name buffer)) |
| 1205 | (message "Compiling %s...done" (buffer-name buffer)) | 1170 | ;; t) |
| 1206 | t) | ||
| 1207 | 1171 | ||
| 1208 | ;;; compiling a single function | 1172 | ;;; compiling a single function |
| 1209 | (defun elisp-compile-defun (&optional arg) | 1173 | (defun compile-defun (&optional arg) |
| 1210 | "Compile and evaluate the current top-level form. | 1174 | "Compile and evaluate the current top-level form. |
| 1211 | Print the result in the minibuffer. | 1175 | Print the result in the minibuffer. |
| 1212 | With argument, insert value in current buffer after the form." | 1176 | With argument, insert value in current buffer after the form." |
| @@ -1293,17 +1257,17 @@ With argument, insert value in current buffer after the form." | |||
| 1293 | ((eq byte-optimize 'byte) "byte-level optimization only") | 1257 | ((eq byte-optimize 'byte) "byte-level optimization only") |
| 1294 | (byte-optimize "optimization is on") | 1258 | (byte-optimize "optimization is on") |
| 1295 | (t "optimization is off")) | 1259 | (t "optimization is off")) |
| 1296 | (if (byte-compile-version-cond byte-compile-emacs18-compatibility) | 1260 | (if (byte-compile-version-cond byte-compile-compatibility) |
| 1297 | "; compiled with emacs18 compatibility.\n" | 1261 | "; compiled with Emacs 18 compatibility.\n" |
| 1298 | ".\n")) | 1262 | ".\n")) |
| 1299 | (if (byte-compile-version-cond byte-compile-generate-emacs19-bytecodes) | 1263 | (if (byte-compile-version-cond byte-compile-compatibility) |
| 1300 | (insert ";;; this file uses opcodes which do not exist in Emacs18.\n" | 1264 | (insert ";;; this file uses opcodes which do not exist in Emacs 18.\n" |
| 1301 | ;; Have to check if emacs-version is bound so that this works | 1265 | ;; Have to check if emacs-version is bound so that this works |
| 1302 | ;; in files loaded early in loadup.el. | 1266 | ;; in files loaded early in loadup.el. |
| 1303 | "\n(if (and (boundp 'emacs-version)\n" | 1267 | "\n(if (and (boundp 'emacs-version)\n" |
| 1304 | "\t (or (and (boundp 'epoch::version) epoch::version)\n" | 1268 | "\t (or (and (boundp 'epoch::version) epoch::version)\n" |
| 1305 | "\t (string-lessp emacs-version \"19\")))\n" | 1269 | "\t (string-lessp emacs-version \"19\")))\n" |
| 1306 | " (error \"This file was compiled for Emacs19.\"))\n" | 1270 | " (error \"This file was compiled for Emacs 19\"))\n" |
| 1307 | )) | 1271 | )) |
| 1308 | )) | 1272 | )) |
| 1309 | 1273 | ||
| @@ -1486,7 +1450,7 @@ With argument, insert value in current buffer after the form." | |||
| 1486 | (message "Compiling %s (%s)..." (or filename "") (nth 1 form))) | 1450 | (message "Compiling %s (%s)..." (or filename "") (nth 1 form))) |
| 1487 | (cond (that-one | 1451 | (cond (that-one |
| 1488 | (if (and (memq 'redefine byte-compile-warnings) | 1452 | (if (and (memq 'redefine byte-compile-warnings) |
| 1489 | ;; don't warn when compiling the stubs in bytecomp-runtime... | 1453 | ;; don't warn when compiling the stubs in byte-run... |
| 1490 | (not (assq (nth 1 form) | 1454 | (not (assq (nth 1 form) |
| 1491 | byte-compile-initial-macro-environment))) | 1455 | byte-compile-initial-macro-environment))) |
| 1492 | (byte-compile-warn | 1456 | (byte-compile-warn |
| @@ -1496,7 +1460,7 @@ With argument, insert value in current buffer after the form." | |||
| 1496 | (this-one | 1460 | (this-one |
| 1497 | (if (and (memq 'redefine byte-compile-warnings) | 1461 | (if (and (memq 'redefine byte-compile-warnings) |
| 1498 | ;; hack: don't warn when compiling the magic internal | 1462 | ;; hack: don't warn when compiling the magic internal |
| 1499 | ;; byte-compiler macros in bytecomp-runtime.el... | 1463 | ;; byte-compiler macros in byte-run.el... |
| 1500 | (not (assq (nth 1 form) | 1464 | (not (assq (nth 1 form) |
| 1501 | byte-compile-initial-macro-environment))) | 1465 | byte-compile-initial-macro-environment))) |
| 1502 | (byte-compile-warn "%s %s defined multiple times in this file" | 1466 | (byte-compile-warn "%s %s defined multiple times in this file" |
| @@ -1589,7 +1553,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1589 | ;; Given a function made by byte-compile-lambda, make a form which produces it. | 1553 | ;; Given a function made by byte-compile-lambda, make a form which produces it. |
| 1590 | (defun byte-compile-byte-code-maker (fun) | 1554 | (defun byte-compile-byte-code-maker (fun) |
| 1591 | (cond | 1555 | (cond |
| 1592 | ((byte-compile-version-cond byte-compile-emacs18-compatibility) | 1556 | ((byte-compile-version-cond byte-compile-compatibility) |
| 1593 | ;; Return (quote (lambda ...)). | 1557 | ;; Return (quote (lambda ...)). |
| 1594 | (list 'quote (byte-compile-byte-code-unmake fun))) | 1558 | (list 'quote (byte-compile-byte-code-unmake fun))) |
| 1595 | ;; ## atom is faster than compiled-func-p. | 1559 | ;; ## atom is faster than compiled-func-p. |
| @@ -1598,7 +1562,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1598 | ;; would have produced a lambda. | 1562 | ;; would have produced a lambda. |
| 1599 | fun) | 1563 | fun) |
| 1600 | ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial | 1564 | ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial |
| 1601 | ;; function, or this is emacs18, or generate-emacs19-bytecodes is off. | 1565 | ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. |
| 1602 | ((let (tmp) | 1566 | ((let (tmp) |
| 1603 | (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) | 1567 | (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) |
| 1604 | (null (cdr (memq tmp fun)))) | 1568 | (null (cdr (memq tmp fun)))) |
| @@ -1665,7 +1629,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1665 | (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) | 1629 | (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) |
| 1666 | (if (and (eq 'byte-code (car-safe compiled)) | 1630 | (if (and (eq 'byte-code (car-safe compiled)) |
| 1667 | (byte-compile-version-cond | 1631 | (byte-compile-version-cond |
| 1668 | byte-compile-generate-emacs19-bytecodes)) | 1632 | byte-compile-compatibility)) |
| 1669 | (apply 'make-byte-code | 1633 | (apply 'make-byte-code |
| 1670 | (append (list arglist) | 1634 | (append (list arglist) |
| 1671 | ;; byte-string, constants-vector, stack depth | 1635 | ;; byte-string, constants-vector, stack depth |
| @@ -1856,7 +1820,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1856 | (handler (get fn 'byte-compile))) | 1820 | (handler (get fn 'byte-compile))) |
| 1857 | (if (and handler | 1821 | (if (and handler |
| 1858 | (or (byte-compile-version-cond | 1822 | (or (byte-compile-version-cond |
| 1859 | byte-compile-generate-emacs19-bytecodes) | 1823 | byte-compile-compatibility) |
| 1860 | (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) | 1824 | (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) |
| 1861 | (funcall handler form) | 1825 | (funcall handler form) |
| 1862 | (if (memq 'callargs byte-compile-warnings) | 1826 | (if (memq 'callargs byte-compile-warnings) |
| @@ -1971,9 +1935,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1971 | 1935 | ||
| 1972 | (defmacro byte-defop-compiler19 (function &optional compile-handler) | 1936 | (defmacro byte-defop-compiler19 (function &optional compile-handler) |
| 1973 | ;; Just like byte-defop-compiler, but defines an opcode that will only | 1937 | ;; Just like byte-defop-compiler, but defines an opcode that will only |
| 1974 | ;; be used when byte-compile-generate-emacs19-bytecodes is true. | 1938 | ;; be used when byte-compile-compatibility is true. |
| 1975 | (if (and (byte-compile-single-version) | 1939 | (if (and (byte-compile-single-version) |
| 1976 | (not byte-compile-generate-emacs19-bytecodes)) | 1940 | (not byte-compile-compatibility)) |
| 1977 | nil | 1941 | nil |
| 1978 | (list 'progn | 1942 | (list 'progn |
| 1979 | (list 'put | 1943 | (list 'put |
| @@ -2188,7 +2152,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2188 | (byte-compile-out | 2152 | (byte-compile-out |
| 2189 | (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0)) | 2153 | (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0)) |
| 2190 | ((and (< count 256) (byte-compile-version-cond | 2154 | ((and (< count 256) (byte-compile-version-cond |
| 2191 | byte-compile-generate-emacs19-bytecodes)) | 2155 | byte-compile-compatibility)) |
| 2192 | (mapcar 'byte-compile-form (cdr form)) | 2156 | (mapcar 'byte-compile-form (cdr form)) |
| 2193 | (byte-compile-out 'byte-listN count)) | 2157 | (byte-compile-out 'byte-listN count)) |
| 2194 | (t (byte-compile-normal-call form))))) | 2158 | (t (byte-compile-normal-call form))))) |
| @@ -2204,7 +2168,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2204 | ((= count 0) | 2168 | ((= count 0) |
| 2205 | (byte-compile-form "")) | 2169 | (byte-compile-form "")) |
| 2206 | ((and (< count 256) (byte-compile-version-cond | 2170 | ((and (< count 256) (byte-compile-version-cond |
| 2207 | byte-compile-generate-emacs19-bytecodes)) | 2171 | byte-compile-compatibility)) |
| 2208 | (mapcar 'byte-compile-form (cdr form)) | 2172 | (mapcar 'byte-compile-form (cdr form)) |
| 2209 | (byte-compile-out 'byte-concatN count)) | 2173 | (byte-compile-out 'byte-concatN count)) |
| 2210 | ((byte-compile-normal-call form))))) | 2174 | ((byte-compile-normal-call form))))) |
| @@ -2285,7 +2249,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2285 | ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code. | 2249 | ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code. |
| 2286 | ;; In this situation, calling make-byte-code at run-time will usually | 2250 | ;; In this situation, calling make-byte-code at run-time will usually |
| 2287 | ;; be less efficient than processing a call to byte-code. | 2251 | ;; be less efficient than processing a call to byte-code. |
| 2288 | ((byte-compile-version-cond byte-compile-emacs18-compatibility) | 2252 | ((byte-compile-version-cond byte-compile-compatibility) |
| 2289 | (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form)))) | 2253 | (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form)))) |
| 2290 | ((byte-compile-lambda (nth 1 form)))))) | 2254 | ((byte-compile-lambda (nth 1 form)))))) |
| 2291 | 2255 | ||
| @@ -2304,7 +2268,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2304 | (cond ((null (cdr form)) | 2268 | (cond ((null (cdr form)) |
| 2305 | (byte-compile-constant nil)) | 2269 | (byte-compile-constant nil)) |
| 2306 | ((and (byte-compile-version-cond | 2270 | ((and (byte-compile-version-cond |
| 2307 | byte-compile-generate-emacs19-bytecodes) | 2271 | byte-compile-compatibility) |
| 2308 | (<= (length form) 256)) | 2272 | (<= (length form) 256)) |
| 2309 | (mapcar 'byte-compile-form (cdr form)) | 2273 | (mapcar 'byte-compile-form (cdr form)) |
| 2310 | (if (cdr (cdr form)) | 2274 | (if (cdr (cdr form)) |
| @@ -2372,13 +2336,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2372 | (setq body (cdr body))) | 2336 | (setq body (cdr body))) |
| 2373 | (byte-compile-form (car body) for-effect)) | 2337 | (byte-compile-form (car body) for-effect)) |
| 2374 | 2338 | ||
| 2375 | (proclaim-inline byte-compile-body-do-effect) | 2339 | (defsubst byte-compile-body-do-effect (body) |
| 2376 | (defun byte-compile-body-do-effect (body) | ||
| 2377 | (byte-compile-body body for-effect) | 2340 | (byte-compile-body body for-effect) |
| 2378 | (setq for-effect nil)) | 2341 | (setq for-effect nil)) |
| 2379 | 2342 | ||
| 2380 | (proclaim-inline byte-compile-form-do-effect) | 2343 | (defsubst byte-compile-form-do-effect (form) |
| 2381 | (defun byte-compile-form-do-effect (form) | ||
| 2382 | (byte-compile-form form for-effect) | 2344 | (byte-compile-form form for-effect) |
| 2383 | (setq for-effect nil)) | 2345 | (setq for-effect nil)) |
| 2384 | 2346 | ||
| @@ -2553,7 +2515,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2553 | (list 'not | 2515 | (list 'not |
| 2554 | (cons (or (get (car form) 'byte-compile-negated-op) | 2516 | (cons (or (get (car form) 'byte-compile-negated-op) |
| 2555 | (error | 2517 | (error |
| 2556 | "compiler error: %s has no byte-compile-negated-op property" | 2518 | "Compiler error: `%s' has no `byte-compile-negated-op' property" |
| 2557 | (car form))) | 2519 | (car form))) |
| 2558 | (cdr form)))) | 2520 | (cdr form)))) |
| 2559 | 2521 | ||
| @@ -2708,7 +2670,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2708 | ;; ## remove this someday | 2670 | ;; ## remove this someday |
| 2709 | (and byte-compile-depth | 2671 | (and byte-compile-depth |
| 2710 | (not (= (cdr (cdr tag)) byte-compile-depth)) | 2672 | (not (= (cdr (cdr tag)) byte-compile-depth)) |
| 2711 | (error "bytecomp bug: depth conflict at tag %d" (car (cdr tag)))) | 2673 | (error "Compiler bug: depth conflict at tag %d" (car (cdr tag)))) |
| 2712 | (setq byte-compile-depth (cdr (cdr tag)))) | 2674 | (setq byte-compile-depth (cdr (cdr tag)))) |
| 2713 | (setcdr (cdr tag) byte-compile-depth))) | 2675 | (setcdr (cdr tag) byte-compile-depth))) |
| 2714 | 2676 | ||
| @@ -2735,7 +2697,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2735 | (- (1- offset)))) | 2697 | (- (1- offset)))) |
| 2736 | byte-compile-maxdepth (max byte-compile-depth | 2698 | byte-compile-maxdepth (max byte-compile-depth |
| 2737 | byte-compile-maxdepth)))) | 2699 | byte-compile-maxdepth)))) |
| 2738 | ;;(if (< byte-compile-depth 0) (error "compiler error: stack underflow")) | 2700 | ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) |
| 2739 | ) | 2701 | ) |
| 2740 | 2702 | ||
| 2741 | 2703 | ||
| @@ -2761,19 +2723,22 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2761 | byte-compile-call-tree))) | 2723 | byte-compile-call-tree))) |
| 2762 | )) | 2724 | )) |
| 2763 | 2725 | ||
| 2764 | (defun byte-compile-report-call-tree (&optional filename) | 2726 | ;; Renamed from byte-compile-report-call-tree |
| 2765 | "Display a buffer describing which functions have been called, what functions | 2727 | ;; to avoid interfering with completion of byte-compile-file. |
| 2766 | called them, and what functions they call. This buffer will list all functions | 2728 | (defun display-call-tree (&optional filename) |
| 2767 | whose definitions have been compiled since this emacs session was started, as | 2729 | "Display a call graph of a specified file. |
| 2768 | well as all functions called by those functions. | 2730 | This lists which functions have been called, what functions called |
| 2731 | them, and what functions they call. The list includes all functions | ||
| 2732 | whose definitions have been compiled in this Emacs session, as well as | ||
| 2733 | all functions called by those functions. | ||
| 2769 | 2734 | ||
| 2770 | The call tree only lists functions called, not macros or inline functions | 2735 | The call graph does not include macros, inline functions, or |
| 2771 | expanded. Those functions which the byte-code interpreter knows about directly | 2736 | primitives that the byte-code interpreter knows about directly \(eq, |
| 2772 | \(eq, cons, etc.\) are not reported. | 2737 | cons, etc.\). |
| 2773 | 2738 | ||
| 2774 | The call tree also lists those functions which are not known to be called | 2739 | The call tree also lists those functions which are not known to be called |
| 2775 | \(that is, to which no calls have been compiled.\) Functions which can be | 2740 | \(that is, to which no calls have been compiled\), and which cannot be |
| 2776 | invoked interactively are excluded from this list." | 2741 | invoked interactively." |
| 2777 | (interactive) | 2742 | (interactive) |
| 2778 | (message "Generating call tree...") | 2743 | (message "Generating call tree...") |
| 2779 | (with-output-to-temp-buffer "*Call-Tree*" | 2744 | (with-output-to-temp-buffer "*Call-Tree*" |
| @@ -2806,7 +2771,7 @@ invoked interactively are excluded from this list." | |||
| 2806 | ((eq byte-compile-call-tree-sort 'name) | 2771 | ((eq byte-compile-call-tree-sort 'name) |
| 2807 | (function (lambda (x y) (string< (car x) | 2772 | (function (lambda (x y) (string< (car x) |
| 2808 | (car y))))) | 2773 | (car y))))) |
| 2809 | (t (error "byte-compile-call-tree-sort: %s - unknown sort mode" | 2774 | (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" |
| 2810 | byte-compile-call-tree-sort)))))) | 2775 | byte-compile-call-tree-sort)))))) |
| 2811 | (message "Generating call tree...") | 2776 | (message "Generating call tree...") |
| 2812 | (let ((rest byte-compile-call-tree) | 2777 | (let ((rest byte-compile-call-tree) |
| @@ -2889,21 +2854,22 @@ invoked interactively are excluded from this list." | |||
| 2889 | ;;; by crl@newton.purdue.edu | 2854 | ;;; by crl@newton.purdue.edu |
| 2890 | ;;; Only works noninteractively. | 2855 | ;;; Only works noninteractively. |
| 2891 | (defun batch-byte-compile () | 2856 | (defun batch-byte-compile () |
| 2892 | "Runs `byte-compile-file' on the files remaining on the command line. | 2857 | "Run `byte-compile-file' on the files remaining on the command line. |
| 2893 | Must be used only with -batch, and kills emacs on completion. | 2858 | Use this from the command line, with `-batch'; |
| 2894 | Each file will be processed even if an error occurred previously. | 2859 | it won't work in an interactive Emacs. |
| 2860 | Each file is processed even if an error occurred previously. | ||
| 2895 | For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" | 2861 | For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" |
| 2896 | ;; command-line-args-left is what is left of the command line (from startup.el) | 2862 | ;; command-line-args-left is what is left of the command line (from startup.el) |
| 2897 | (defvar command-line-args-left) ;Avoid 'free variable' warning | 2863 | (defvar command-line-args-left) ;Avoid 'free variable' warning |
| 2898 | (if (not noninteractive) | 2864 | (if (not noninteractive) |
| 2899 | (error "batch-byte-compile is to be used only with -batch")) | 2865 | (error "`batch-byte-compile' is to be used only with -batch")) |
| 2900 | (let ((error nil)) | 2866 | (let ((error nil)) |
| 2901 | (while command-line-args-left | 2867 | (while command-line-args-left |
| 2902 | (if (file-directory-p (expand-file-name (car command-line-args-left))) | 2868 | (if (file-directory-p (expand-file-name (car command-line-args-left))) |
| 2903 | (let ((files (directory-files (car command-line-args-left))) | 2869 | (let ((files (directory-files (car command-line-args-left))) |
| 2904 | source dest) | 2870 | source dest) |
| 2905 | (while files | 2871 | (while files |
| 2906 | (if (and (string-match elisp-source-extention-re (car files)) | 2872 | (if (and (string-match emacs-lisp-file-regexp (car files)) |
| 2907 | (not (auto-save-file-name-p (car files))) | 2873 | (not (auto-save-file-name-p (car files))) |
| 2908 | (setq source (expand-file-name (car files) | 2874 | (setq source (expand-file-name (car files) |
| 2909 | (car command-line-args-left))) | 2875 | (car command-line-args-left))) |
| @@ -2938,44 +2904,39 @@ For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" | |||
| 2938 | (make-obsolete 'dot-min 'point-min) | 2904 | (make-obsolete 'dot-min 'point-min) |
| 2939 | (make-obsolete 'dot-marker 'point-marker) | 2905 | (make-obsolete 'dot-marker 'point-marker) |
| 2940 | 2906 | ||
| 2941 | (cond ((not (or (and (boundp 'epoch::version) epoch::version) | 2907 | (make-obsolete 'buffer-flush-undo 'buffer-disable-undo) |
| 2942 | (string-lessp emacs-version "19"))) | 2908 | (make-obsolete 'baud-rate "use the baud-rate variable instead") |
| 2943 | (make-obsolete 'buffer-flush-undo 'buffer-disable-undo) | ||
| 2944 | (make-obsolete 'baud-rate "use the baud-rate variable instead") | ||
| 2945 | )) | ||
| 2946 | 2909 | ||
| 2947 | (provide 'byte-compile) | 2910 | (provide 'byte-compile) |
| 2948 | 2911 | ||
| 2949 | 2912 | ||
| 2950 | ;;; report metering (see the hacks in bytecode.c) | 2913 | ;;; report metering (see the hacks in bytecode.c) |
| 2951 | 2914 | ||
| 2952 | (if (boundp 'byte-code-meter) | 2915 | (defun byte-compile-report-ops () |
| 2953 | (defun byte-compile-report-ops () | 2916 | (defvar byte-code-meter) |
| 2954 | (defvar byte-code-meter) | 2917 | (with-output-to-temp-buffer "*Meter*" |
| 2955 | (with-output-to-temp-buffer "*Meter*" | 2918 | (set-buffer "*Meter*") |
| 2956 | (set-buffer "*Meter*") | 2919 | (let ((i 0) n op off) |
| 2957 | (let ((i 0) n op off) | 2920 | (while (< i 256) |
| 2958 | (while (< i 256) | 2921 | (setq n (aref (aref byte-code-meter 0) i) |
| 2959 | (setq n (aref (aref byte-code-meter 0) i) | 2922 | off nil) |
| 2960 | off nil) | 2923 | (if t ;(not (zerop n)) |
| 2961 | (if t ;(not (zerop n)) | 2924 | (progn |
| 2962 | (progn | 2925 | (setq op i) |
| 2963 | (setq op i) | 2926 | (setq off nil) |
| 2964 | (setq off nil) | 2927 | (cond ((< op byte-nth) |
| 2965 | (cond ((< op byte-nth) | 2928 | (setq off (logand op 7)) |
| 2966 | (setq off (logand op 7)) | 2929 | (setq op (logand op 248))) |
| 2967 | (setq op (logand op 248))) | 2930 | ((>= op byte-constant) |
| 2968 | ((>= op byte-constant) | 2931 | (setq off (- op byte-constant) |
| 2969 | (setq off (- op byte-constant) | 2932 | op byte-constant))) |
| 2970 | op byte-constant))) | 2933 | (setq op (aref byte-code-vector op)) |
| 2971 | (setq op (aref byte-code-vector op)) | 2934 | (insert (format "%-4d" i)) |
| 2972 | (insert (format "%-4d" i)) | 2935 | (insert (symbol-name op)) |
| 2973 | (insert (symbol-name op)) | 2936 | (if off (insert " [" (int-to-string off) "]")) |
| 2974 | (if off (insert " [" (int-to-string off) "]")) | 2937 | (indent-to 40) |
| 2975 | (indent-to 40) | 2938 | (insert (int-to-string n) "\n"))) |
| 2976 | (insert (int-to-string n) "\n"))) | 2939 | (setq i (1+ i)))))) |
| 2977 | (setq i (1+ i))))))) | ||
| 2978 | |||
| 2979 | 2940 | ||
| 2980 | ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles | 2941 | ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles |
| 2981 | ;; itself, compile some of its most used recursive functions (at load time). | 2942 | ;; itself, compile some of its most used recursive functions (at load time). |