diff options
| author | Stefan Monnier | 2011-04-01 11:16:50 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2011-04-01 11:16:50 -0400 |
| commit | 7200d79c65c65686495dd95e9f6dd436cf6db55e (patch) | |
| tree | 5ad8e8f4ad0bb2dadfdc1d670cb3cd47db28a3f8 | |
| parent | 40d83b412f584cc02e68d4eac8fd5e6eb769e2fe (diff) | |
| download | emacs-old-branches/lexbind-new.tar.gz emacs-old-branches/lexbind-new.zip | |
Miscellanous cleanups in preparation for the merge.old-branches/lexbind-new
* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
Remove debug statement.
* lisp/emacs-lisp/bytecomp.el (byte-compile-single-version)
(byte-compile-version-cond, byte-compile-delay-out)
(byte-compile-delayed-out): Remove, unused.
* src/bytecode.c (Fbyte_code): Revert to old calling convention.
* src/lisp.h (COMPILED_PUSH_ARGS): Remove, unused.
| -rw-r--r-- | doc/lispref/variables.texi | 2 | ||||
| -rw-r--r-- | etc/NEWS.lexbind | 2 | ||||
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/Makefile.in | 6 | ||||
| -rw-r--r-- | lisp/cedet/semantic/wisent/comp.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 16 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 162 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/disass.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 2 | ||||
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/bytecode.c | 41 | ||||
| -rw-r--r-- | src/callint.c | 4 | ||||
| -rw-r--r-- | src/eval.c | 15 | ||||
| -rw-r--r-- | src/lisp.h | 3 | ||||
| -rw-r--r-- | src/lread.c | 33 | ||||
| -rw-r--r-- | src/window.c | 1 | ||||
| -rw-r--r-- | test/automated/lexbind-tests.el | 4 |
23 files changed, 138 insertions, 194 deletions
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index fad76ed39f8..7e2c32334a4 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi | |||
| @@ -1137,7 +1137,7 @@ by @code{funcall}, and they are represented by a cons cell whose @code{car} is | |||
| 1137 | the symbol @code{closure}. | 1137 | the symbol @code{closure}. |
| 1138 | 1138 | ||
| 1139 | @menu | 1139 | @menu |
| 1140 | * Converting to Lexical Binding:: How to start using lexical scoping | 1140 | * Converting to Lexical Binding:: How to start using lexical scoping |
| 1141 | @end menu | 1141 | @end menu |
| 1142 | 1142 | ||
| 1143 | @node Converting to Lexical Binding | 1143 | @node Converting to Lexical Binding |
diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind index de5d9a07715..a55b8e38dcf 100644 --- a/etc/NEWS.lexbind +++ b/etc/NEWS.lexbind | |||
| @@ -17,7 +17,7 @@ It is typically set via file-local variables, in which case it applies to | |||
| 17 | all the code in that file. | 17 | all the code in that file. |
| 18 | 18 | ||
| 19 | ** Lexically scoped interpreted functions are represented with a new form | 19 | ** Lexically scoped interpreted functions are represented with a new form |
| 20 | of function value which looks like (closure ENV lambda ARGS &rest BODY). | 20 | of function value which looks like (closure ENV ARGS &rest BODY). |
| 21 | ** New macro `letrec' to define recursive local functions. | 21 | ** New macro `letrec' to define recursive local functions. |
| 22 | 22 | ||
| 23 | ---------------------------------------------------------------------- | 23 | ---------------------------------------------------------------------- |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b517c48738f..f977b976c4b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,12 @@ | |||
| 1 | 2011-04-01 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/bytecomp.el (byte-compile-single-version) | ||
| 4 | (byte-compile-version-cond, byte-compile-delay-out) | ||
| 5 | (byte-compile-delayed-out): Remove, unused. | ||
| 6 | |||
| 7 | * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): | ||
| 8 | Remove debug statement. | ||
| 9 | |||
| 1 | 2011-03-30 Stefan Monnier <monnier@iro.umontreal.ca> | 10 | 2011-03-30 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 11 | ||
| 3 | * subr.el (apply-partially): Use a non-nil static environment. | 12 | * subr.el (apply-partially): Use a non-nil static environment. |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ab82c99ac33..083f312d613 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -206,8 +206,8 @@ compile-onefile: | |||
| 206 | @echo Compiling $(THEFILE) | 206 | @echo Compiling $(THEFILE) |
| 207 | @# Use byte-compile-refresh-preloaded to try and work around some of | 207 | @# Use byte-compile-refresh-preloaded to try and work around some of |
| 208 | @# the most common bootstrapping problems. | 208 | @# the most common bootstrapping problems. |
| 209 | @$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \ | 209 | @$(emacs) $(BYTE_COMPILE_FLAGS) \ |
| 210 | -f byte-compile-refresh-preloaded \ | 210 | -l bytecomp -f byte-compile-refresh-preloaded \ |
| 211 | -f batch-byte-compile $(THEFILE) | 211 | -f batch-byte-compile $(THEFILE) |
| 212 | 212 | ||
| 213 | # Files MUST be compiled one by one. If we compile several files in a | 213 | # Files MUST be compiled one by one. If we compile several files in a |
| @@ -292,7 +292,7 @@ compile-always: doit | |||
| 292 | compile-calc: | 292 | compile-calc: |
| 293 | for el in $(lisp)/calc/*.el; do \ | 293 | for el in $(lisp)/calc/*.el; do \ |
| 294 | echo Compiling $$el; \ | 294 | echo Compiling $$el; \ |
| 295 | $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ | 295 | $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1;\ |
| 296 | done | 296 | done |
| 297 | 297 | ||
| 298 | # Backup compiled Lisp files in elc.tar.gz. If that file already | 298 | # Backup compiled Lisp files in elc.tar.gz. If that file already |
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 6b473f9ad81..f92ae88c14e 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el | |||
| @@ -3484,6 +3484,9 @@ Automatically called by the Emacs Lisp byte compiler as a | |||
| 3484 | (macroexpand-all | 3484 | (macroexpand-all |
| 3485 | (wisent-automaton-lisp-form (eval form))))) | 3485 | (wisent-automaton-lisp-form (eval form))))) |
| 3486 | 3486 | ||
| 3487 | ;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table | ||
| 3488 | ;; instead of an obarray would work around the problem that obarrays | ||
| 3489 | ;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t). | ||
| 3487 | (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) | 3490 | (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) |
| 3488 | 3491 | ||
| 3489 | (defun wisent-automaton-lisp-form (automaton) | 3492 | (defun wisent-automaton-lisp-form (automaton) |
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 35c9a5ddf45..548fcd133df 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el | |||
| @@ -534,7 +534,6 @@ | |||
| 534 | (cons fn (mapcar #'byte-optimize-form (cdr form)))) | 534 | (cons fn (mapcar #'byte-optimize-form (cdr form)))) |
| 535 | 535 | ||
| 536 | ((not (symbolp fn)) | 536 | ((not (symbolp fn)) |
| 537 | (debug) | ||
| 538 | (byte-compile-warn "`%s' is a malformed function" | 537 | (byte-compile-warn "`%s' is a malformed function" |
| 539 | (prin1-to-string fn)) | 538 | (prin1-to-string fn)) |
| 540 | form) | 539 | form) |
| @@ -1455,8 +1454,7 @@ | |||
| 1455 | byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max | 1454 | byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max |
| 1456 | byte-point-min byte-following-char byte-preceding-char | 1455 | byte-point-min byte-following-char byte-preceding-char |
| 1457 | byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp | 1456 | byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp |
| 1458 | byte-current-buffer byte-stack-ref ;; byte-closed-var | 1457 | byte-current-buffer byte-stack-ref)) |
| 1459 | )) | ||
| 1460 | 1458 | ||
| 1461 | (defconst byte-compile-side-effect-free-ops | 1459 | (defconst byte-compile-side-effect-free-ops |
| 1462 | (nconc | 1460 | (nconc |
| @@ -2029,7 +2027,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." | |||
| 2029 | (+ (cdr lap0) (cdr lap1)))) | 2027 | (+ (cdr lap0) (cdr lap1)))) |
| 2030 | (setq lap (delq lap0 lap)) | 2028 | (setq lap (delq lap0 lap)) |
| 2031 | (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) | 2029 | (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) |
| 2032 | 2030 | ||
| 2033 | ;; | 2031 | ;; |
| 2034 | ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos | 2032 | ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos |
| 2035 | ;; stack-set-M [discard/discardN ...] --> discardN | 2033 | ;; stack-set-M [discard/discardN ...] --> discardN |
| @@ -2053,10 +2051,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." | |||
| 2053 | (setq lap (delq lap0 lap)) | 2051 | (setq lap (delq lap0 lap)) |
| 2054 | (setcar lap1 | 2052 | (setcar lap1 |
| 2055 | (if (= tmp2 tmp3) | 2053 | (if (= tmp2 tmp3) |
| 2056 | ;; The value stored is the new TOS, so pop | 2054 | ;; The value stored is the new TOS, so pop one more |
| 2057 | ;; one more value (to get rid of the old | 2055 | ;; value (to get rid of the old value) using the |
| 2058 | ;; value) using the TOS-preserving | 2056 | ;; TOS-preserving discard operator. |
| 2059 | ;; discard operator. | ||
| 2060 | 'byte-discardN-preserve-tos | 2057 | 'byte-discardN-preserve-tos |
| 2061 | ;; Otherwise, the value stored is lost, so just use a | 2058 | ;; Otherwise, the value stored is lost, so just use a |
| 2062 | ;; normal discard. | 2059 | ;; normal discard. |
| @@ -2071,8 +2068,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." | |||
| 2071 | ;; discardN-(X+Y) | 2068 | ;; discardN-(X+Y) |
| 2072 | ;; | 2069 | ;; |
| 2073 | ((and (memq (car lap0) | 2070 | ((and (memq (car lap0) |
| 2074 | '(byte-discard | 2071 | '(byte-discard byte-discardN |
| 2075 | byte-discardN | ||
| 2076 | byte-discardN-preserve-tos)) | 2072 | byte-discardN-preserve-tos)) |
| 2077 | (memq (car lap1) '(byte-discard byte-discardN))) | 2073 | (memq (car lap1) '(byte-discard byte-discardN))) |
| 2078 | (setq lap (delq lap0 lap)) | 2074 | (setq lap (delq lap0 lap)) |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5e671d7e694..7d259cda574 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -128,10 +128,6 @@ | |||
| 128 | 128 | ||
| 129 | ;; The feature of compiling in a specific target Emacs version | 129 | ;; The feature of compiling in a specific target Emacs version |
| 130 | ;; has been turned off because compile time options are a bad idea. | 130 | ;; has been turned off because compile time options are a bad idea. |
| 131 | (defmacro byte-compile-single-version () nil) | ||
| 132 | (defmacro byte-compile-version-cond (cond) cond) | ||
| 133 | |||
| 134 | |||
| 135 | (defgroup bytecomp nil | 131 | (defgroup bytecomp nil |
| 136 | "Emacs Lisp byte-compiler." | 132 | "Emacs Lisp byte-compiler." |
| 137 | :group 'lisp) | 133 | :group 'lisp) |
| @@ -404,9 +400,7 @@ specify different fields to sort on." | |||
| 404 | :type '(choice (const name) (const callers) (const calls) | 400 | :type '(choice (const name) (const callers) (const calls) |
| 405 | (const calls+callers) (const nil))) | 401 | (const calls+callers) (const nil))) |
| 406 | 402 | ||
| 407 | (defvar byte-compile-debug t) | 403 | (defvar byte-compile-debug nil) |
| 408 | (setq debug-on-error t) | ||
| 409 | |||
| 410 | (defvar byte-compile-constants nil | 404 | (defvar byte-compile-constants nil |
| 411 | "List of all constants encountered during compilation of this form.") | 405 | "List of all constants encountered during compilation of this form.") |
| 412 | (defvar byte-compile-variables nil | 406 | (defvar byte-compile-variables nil |
| @@ -465,7 +459,7 @@ Used for warnings about calling a function that is defined during compilation | |||
| 465 | but won't necessarily be defined when the compiled file is loaded.") | 459 | but won't necessarily be defined when the compiled file is loaded.") |
| 466 | 460 | ||
| 467 | ;; Variables for lexical binding | 461 | ;; Variables for lexical binding |
| 468 | (defvar byte-compile-lexical-environment nil | 462 | (defvar byte-compile--lexical-environment nil |
| 469 | "The current lexical environment.") | 463 | "The current lexical environment.") |
| 470 | 464 | ||
| 471 | (defvar byte-compile-tag-number 0) | 465 | (defvar byte-compile-tag-number 0) |
| @@ -586,6 +580,7 @@ Each element is (INDEX . VALUE)") | |||
| 586 | (byte-defop 114 0 byte-save-current-buffer | 580 | (byte-defop 114 0 byte-save-current-buffer |
| 587 | "To make a binding to record the current buffer") | 581 | "To make a binding to record the current buffer") |
| 588 | (byte-defop 115 0 byte-set-mark-OBSOLETE) | 582 | (byte-defop 115 0 byte-set-mark-OBSOLETE) |
| 583 | ;; (byte-defop 116 1 byte-interactive-p) ;Let's not use it any more. | ||
| 589 | 584 | ||
| 590 | ;; These ops are new to v19 | 585 | ;; These ops are new to v19 |
| 591 | (byte-defop 117 0 byte-forward-char) | 586 | (byte-defop 117 0 byte-forward-char) |
| @@ -621,6 +616,8 @@ otherwise pop it") | |||
| 621 | 616 | ||
| 622 | (byte-defop 138 0 byte-save-excursion | 617 | (byte-defop 138 0 byte-save-excursion |
| 623 | "to make a binding to record the buffer, point and mark") | 618 | "to make a binding to record the buffer, point and mark") |
| 619 | ;; (byte-defop 139 0 byte-save-window-excursion ; Obsolete: It's a macro now. | ||
| 620 | ;; "to make a binding to record entire window configuration") | ||
| 624 | (byte-defop 140 0 byte-save-restriction | 621 | (byte-defop 140 0 byte-save-restriction |
| 625 | "to make a binding to record the current buffer clipping restrictions") | 622 | "to make a binding to record the current buffer clipping restrictions") |
| 626 | (byte-defop 141 -1 byte-catch | 623 | (byte-defop 141 -1 byte-catch |
| @@ -632,16 +629,8 @@ otherwise pop it") | |||
| 632 | ;; an expression for the body, and a list of clauses. | 629 | ;; an expression for the body, and a list of clauses. |
| 633 | (byte-defop 143 -2 byte-condition-case) | 630 | (byte-defop 143 -2 byte-condition-case) |
| 634 | 631 | ||
| 635 | ;; For entry to with-output-to-temp-buffer. | 632 | ;; Obsolete: `with-output-to-temp-buffer' is a macro now. |
| 636 | ;; Takes, on stack, the buffer name. | ||
| 637 | ;; Binds standard-output and does some other things. | ||
| 638 | ;; Returns with temp buffer on the stack in place of buffer name. | ||
| 639 | ;; (byte-defop 144 0 byte-temp-output-buffer-setup) | 633 | ;; (byte-defop 144 0 byte-temp-output-buffer-setup) |
| 640 | |||
| 641 | ;; For exit from with-output-to-temp-buffer. | ||
| 642 | ;; Expects the temp buffer on the stack underneath value to return. | ||
| 643 | ;; Pops them both, then pushes the value back on. | ||
| 644 | ;; Unbinds standard-output and makes the temp buffer visible. | ||
| 645 | ;; (byte-defop 145 -1 byte-temp-output-buffer-show) | 634 | ;; (byte-defop 145 -1 byte-temp-output-buffer-show) |
| 646 | 635 | ||
| 647 | ;; these ops are new to v19 | 636 | ;; these ops are new to v19 |
| @@ -675,15 +664,14 @@ otherwise pop it") | |||
| 675 | (byte-defop 168 0 byte-integerp) | 664 | (byte-defop 168 0 byte-integerp) |
| 676 | 665 | ||
| 677 | ;; unused: 169-174 | 666 | ;; unused: 169-174 |
| 678 | |||
| 679 | (byte-defop 175 nil byte-listN) | 667 | (byte-defop 175 nil byte-listN) |
| 680 | (byte-defop 176 nil byte-concatN) | 668 | (byte-defop 176 nil byte-concatN) |
| 681 | (byte-defop 177 nil byte-insertN) | 669 | (byte-defop 177 nil byte-insertN) |
| 682 | 670 | ||
| 683 | (byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte | 671 | (byte-defop 178 -1 byte-stack-set) ; Stack offset in following one byte. |
| 684 | (byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes | 672 | (byte-defop 179 -1 byte-stack-set2) ; Stack offset in following two bytes. |
| 685 | 673 | ||
| 686 | ;; if (following one byte & 0x80) == 0 | 674 | ;; If (following one byte & 0x80) == 0 |
| 687 | ;; discard (following one byte & 0x7F) stack entries | 675 | ;; discard (following one byte & 0x7F) stack entries |
| 688 | ;; else | 676 | ;; else |
| 689 | ;; discard (following one byte & 0x7F) stack entries _underneath_ TOS | 677 | ;; discard (following one byte & 0x7F) stack entries _underneath_ TOS |
| @@ -776,12 +764,6 @@ CONST2 may be evaulated multiple times." | |||
| 776 | (error "Non-symbolic opcode `%s'" op)) | 764 | (error "Non-symbolic opcode `%s'" op)) |
| 777 | ((eq op 'TAG) | 765 | ((eq op 'TAG) |
| 778 | (setcar off pc)) | 766 | (setcar off pc)) |
| 779 | ((null op) | ||
| 780 | ;; a no-op added by `byte-compile-delay-out' | ||
| 781 | (unless (zerop off) | ||
| 782 | (error | ||
| 783 | "Placeholder added by `byte-compile-delay-out' not filled in.") | ||
| 784 | )) | ||
| 785 | (t | 767 | (t |
| 786 | (setq opcode | 768 | (setq opcode |
| 787 | (if (eq op 'byte-discardN-preserve-tos) | 769 | (if (eq op 'byte-discardN-preserve-tos) |
| @@ -793,13 +775,13 @@ CONST2 may be evaulated multiple times." | |||
| 793 | (cond ((memq op byte-goto-ops) | 775 | (cond ((memq op byte-goto-ops) |
| 794 | ;; goto | 776 | ;; goto |
| 795 | (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc) | 777 | (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc) |
| 796 | (push bytes patchlist)) | 778 | (push bytes patchlist)) |
| 797 | ((or (and (consp off) | 779 | ((or (and (consp off) |
| 798 | ;; Variable or constant reference | 780 | ;; Variable or constant reference |
| 799 | (progn | 781 | (progn |
| 800 | (setq off (cdr off)) | 782 | (setq off (cdr off)) |
| 801 | (eq op 'byte-constant))) | 783 | (eq op 'byte-constant))) |
| 802 | (and (eq op 'byte-constant) ;; 'byte-closed-var | 784 | (and (eq op 'byte-constant) |
| 803 | (integerp off))) | 785 | (integerp off))) |
| 804 | ;; constant ref | 786 | ;; constant ref |
| 805 | (if (< off byte-constant-limit) | 787 | (if (< off byte-constant-limit) |
| @@ -847,10 +829,9 @@ CONST2 may be evaulated multiple times." | |||
| 847 | bytes pc)))))) | 829 | bytes pc)))))) |
| 848 | ;;(if (not (= pc (length bytes))) | 830 | ;;(if (not (= pc (length bytes))) |
| 849 | ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) | 831 | ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) |
| 850 | 832 | ;; Patch tag PCs into absolute jumps. | |
| 851 | ;; Patch tag PCs into absolute jumps | ||
| 852 | (dolist (bytes-tail patchlist) | 833 | (dolist (bytes-tail patchlist) |
| 853 | (setq pc (caar bytes-tail)) ; Pick PC from goto's tag | 834 | (setq pc (caar bytes-tail)) ; Pick PC from goto's tag. |
| 854 | (setcar (cdr bytes-tail) (logand pc 255)) | 835 | (setcar (cdr bytes-tail) (logand pc 255)) |
| 855 | (setcar bytes-tail (lsh pc -8)) | 836 | (setcar bytes-tail (lsh pc -8)) |
| 856 | ;; FIXME: Replace this by some workaround. | 837 | ;; FIXME: Replace this by some workaround. |
| @@ -1861,10 +1842,10 @@ With argument ARG, insert value in current buffer after the form." | |||
| 1861 | 1842 | ||
| 1862 | ;; Dynamically bound in byte-compile-from-buffer. | 1843 | ;; Dynamically bound in byte-compile-from-buffer. |
| 1863 | ;; NB also used in cl.el and cl-macs.el. | 1844 | ;; NB also used in cl.el and cl-macs.el. |
| 1864 | (defvar byte-compile-outbuffer) | 1845 | (defvar byte-compile--outbuffer) |
| 1865 | 1846 | ||
| 1866 | (defun byte-compile-from-buffer (inbuffer) | 1847 | (defun byte-compile-from-buffer (inbuffer) |
| 1867 | (let (byte-compile-outbuffer | 1848 | (let (byte-compile--outbuffer |
| 1868 | (byte-compile-current-buffer inbuffer) | 1849 | (byte-compile-current-buffer inbuffer) |
| 1869 | (byte-compile-read-position nil) | 1850 | (byte-compile-read-position nil) |
| 1870 | (byte-compile-last-position nil) | 1851 | (byte-compile-last-position nil) |
| @@ -1893,7 +1874,8 @@ With argument ARG, insert value in current buffer after the form." | |||
| 1893 | ) | 1874 | ) |
| 1894 | (byte-compile-close-variables | 1875 | (byte-compile-close-variables |
| 1895 | (with-current-buffer | 1876 | (with-current-buffer |
| 1896 | (setq byte-compile-outbuffer (get-buffer-create " *Compiler Output*")) | 1877 | (setq byte-compile--outbuffer |
| 1878 | (get-buffer-create " *Compiler Output*")) | ||
| 1897 | (set-buffer-multibyte t) | 1879 | (set-buffer-multibyte t) |
| 1898 | (erase-buffer) | 1880 | (erase-buffer) |
| 1899 | ;; (emacs-lisp-mode) | 1881 | ;; (emacs-lisp-mode) |
| @@ -1902,7 +1884,7 @@ With argument ARG, insert value in current buffer after the form." | |||
| 1902 | (with-current-buffer inbuffer | 1884 | (with-current-buffer inbuffer |
| 1903 | (and byte-compile-current-file | 1885 | (and byte-compile-current-file |
| 1904 | (byte-compile-insert-header byte-compile-current-file | 1886 | (byte-compile-insert-header byte-compile-current-file |
| 1905 | byte-compile-outbuffer)) | 1887 | byte-compile--outbuffer)) |
| 1906 | (goto-char (point-min)) | 1888 | (goto-char (point-min)) |
| 1907 | ;; Should we always do this? When calling multiple files, it | 1889 | ;; Should we always do this? When calling multiple files, it |
| 1908 | ;; would be useful to delay this warning until all have been | 1890 | ;; would be useful to delay this warning until all have been |
| @@ -1935,9 +1917,9 @@ and will be removed soon. See (elisp)Backquote in the manual.")) | |||
| 1935 | ;; Fix up the header at the front of the output | 1917 | ;; Fix up the header at the front of the output |
| 1936 | ;; if the buffer contains multibyte characters. | 1918 | ;; if the buffer contains multibyte characters. |
| 1937 | (and byte-compile-current-file | 1919 | (and byte-compile-current-file |
| 1938 | (with-current-buffer byte-compile-outbuffer | 1920 | (with-current-buffer byte-compile--outbuffer |
| 1939 | (byte-compile-fix-header byte-compile-current-file))))) | 1921 | (byte-compile-fix-header byte-compile-current-file))))) |
| 1940 | byte-compile-outbuffer)) | 1922 | byte-compile--outbuffer)) |
| 1941 | 1923 | ||
| 1942 | (defun byte-compile-fix-header (filename) | 1924 | (defun byte-compile-fix-header (filename) |
| 1943 | "If the current buffer has any multibyte characters, insert a version test." | 1925 | "If the current buffer has any multibyte characters, insert a version test." |
| @@ -2046,8 +2028,8 @@ Call from the source buffer." | |||
| 2046 | (print-gensym t) | 2028 | (print-gensym t) |
| 2047 | (print-circle ; handle circular data structures | 2029 | (print-circle ; handle circular data structures |
| 2048 | (not byte-compile-disable-print-circle))) | 2030 | (not byte-compile-disable-print-circle))) |
| 2049 | (princ "\n" byte-compile-outbuffer) | 2031 | (princ "\n" byte-compile--outbuffer) |
| 2050 | (prin1 form byte-compile-outbuffer) | 2032 | (prin1 form byte-compile--outbuffer) |
| 2051 | nil))) | 2033 | nil))) |
| 2052 | 2034 | ||
| 2053 | (defvar print-gensym-alist) ;Used before print-circle existed. | 2035 | (defvar print-gensym-alist) ;Used before print-circle existed. |
| @@ -2067,7 +2049,7 @@ list that represents a doc string reference. | |||
| 2067 | ;; We need to examine byte-compile-dynamic-docstrings | 2049 | ;; We need to examine byte-compile-dynamic-docstrings |
| 2068 | ;; in the input buffer (now current), not in the output buffer. | 2050 | ;; in the input buffer (now current), not in the output buffer. |
| 2069 | (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) | 2051 | (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) |
| 2070 | (with-current-buffer byte-compile-outbuffer | 2052 | (with-current-buffer byte-compile--outbuffer |
| 2071 | (let (position) | 2053 | (let (position) |
| 2072 | 2054 | ||
| 2073 | ;; Insert the doc string, and make it a comment with #@LENGTH. | 2055 | ;; Insert the doc string, and make it a comment with #@LENGTH. |
| @@ -2091,7 +2073,7 @@ list that represents a doc string reference. | |||
| 2091 | (if preface | 2073 | (if preface |
| 2092 | (progn | 2074 | (progn |
| 2093 | (insert preface) | 2075 | (insert preface) |
| 2094 | (prin1 name byte-compile-outbuffer))) | 2076 | (prin1 name byte-compile--outbuffer))) |
| 2095 | (insert (car info)) | 2077 | (insert (car info)) |
| 2096 | (let ((print-escape-newlines t) | 2078 | (let ((print-escape-newlines t) |
| 2097 | (print-quoted t) | 2079 | (print-quoted t) |
| @@ -2106,7 +2088,7 @@ list that represents a doc string reference. | |||
| 2106 | (print-continuous-numbering t) | 2088 | (print-continuous-numbering t) |
| 2107 | print-number-table | 2089 | print-number-table |
| 2108 | (index 0)) | 2090 | (index 0)) |
| 2109 | (prin1 (car form) byte-compile-outbuffer) | 2091 | (prin1 (car form) byte-compile--outbuffer) |
| 2110 | (while (setq form (cdr form)) | 2092 | (while (setq form (cdr form)) |
| 2111 | (setq index (1+ index)) | 2093 | (setq index (1+ index)) |
| 2112 | (insert " ") | 2094 | (insert " ") |
| @@ -2129,21 +2111,22 @@ list that represents a doc string reference. | |||
| 2129 | (setq position (- (position-bytes position) | 2111 | (setq position (- (position-bytes position) |
| 2130 | (point-min) -1)) | 2112 | (point-min) -1)) |
| 2131 | (princ (format "(#$ . %d) nil" position) | 2113 | (princ (format "(#$ . %d) nil" position) |
| 2132 | byte-compile-outbuffer) | 2114 | byte-compile--outbuffer) |
| 2133 | (setq form (cdr form)) | 2115 | (setq form (cdr form)) |
| 2134 | (setq index (1+ index)))) | 2116 | (setq index (1+ index)))) |
| 2135 | ((= index (nth 1 info)) | 2117 | ((= index (nth 1 info)) |
| 2136 | (if position | 2118 | (if position |
| 2137 | (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") | 2119 | (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") |
| 2138 | position) | 2120 | position) |
| 2139 | byte-compile-outbuffer) | 2121 | byte-compile--outbuffer) |
| 2140 | (let ((print-escape-newlines nil)) | 2122 | (let ((print-escape-newlines nil)) |
| 2141 | (goto-char (prog1 (1+ (point)) | 2123 | (goto-char (prog1 (1+ (point)) |
| 2142 | (prin1 (car form) byte-compile-outbuffer))) | 2124 | (prin1 (car form) |
| 2125 | byte-compile--outbuffer))) | ||
| 2143 | (insert "\\\n") | 2126 | (insert "\\\n") |
| 2144 | (goto-char (point-max))))) | 2127 | (goto-char (point-max))))) |
| 2145 | (t | 2128 | (t |
| 2146 | (prin1 (car form) byte-compile-outbuffer))))) | 2129 | (prin1 (car form) byte-compile--outbuffer))))) |
| 2147 | (insert (nth 2 info))))) | 2130 | (insert (nth 2 info))))) |
| 2148 | nil) | 2131 | nil) |
| 2149 | 2132 | ||
| @@ -2428,7 +2411,7 @@ by side-effects." | |||
| 2428 | ;; Remove declarations from the body of the macro definition. | 2411 | ;; Remove declarations from the body of the macro definition. |
| 2429 | (when macrop | 2412 | (when macrop |
| 2430 | (dolist (decl (byte-compile-defmacro-declaration form)) | 2413 | (dolist (decl (byte-compile-defmacro-declaration form)) |
| 2431 | (prin1 decl byte-compile-outbuffer))) | 2414 | (prin1 decl byte-compile--outbuffer))) |
| 2432 | 2415 | ||
| 2433 | (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) | 2416 | (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) |
| 2434 | (if this-one | 2417 | (if this-one |
| @@ -2458,7 +2441,7 @@ by side-effects." | |||
| 2458 | (and (atom code) byte-compile-dynamic | 2441 | (and (atom code) byte-compile-dynamic |
| 2459 | 1) | 2442 | 1) |
| 2460 | nil)) | 2443 | nil)) |
| 2461 | (princ ")" byte-compile-outbuffer) | 2444 | (princ ")" byte-compile--outbuffer) |
| 2462 | nil))) | 2445 | nil))) |
| 2463 | 2446 | ||
| 2464 | ;; Print Lisp object EXP in the output file, inside a comment, | 2447 | ;; Print Lisp object EXP in the output file, inside a comment, |
| @@ -2466,13 +2449,13 @@ by side-effects." | |||
| 2466 | ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. | 2449 | ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. |
| 2467 | (defun byte-compile-output-as-comment (exp quoted) | 2450 | (defun byte-compile-output-as-comment (exp quoted) |
| 2468 | (let ((position (point))) | 2451 | (let ((position (point))) |
| 2469 | (with-current-buffer byte-compile-outbuffer | 2452 | (with-current-buffer byte-compile--outbuffer |
| 2470 | 2453 | ||
| 2471 | ;; Insert EXP, and make it a comment with #@LENGTH. | 2454 | ;; Insert EXP, and make it a comment with #@LENGTH. |
| 2472 | (insert " ") | 2455 | (insert " ") |
| 2473 | (if quoted | 2456 | (if quoted |
| 2474 | (prin1 exp byte-compile-outbuffer) | 2457 | (prin1 exp byte-compile--outbuffer) |
| 2475 | (princ exp byte-compile-outbuffer)) | 2458 | (princ exp byte-compile--outbuffer)) |
| 2476 | (goto-char position) | 2459 | (goto-char position) |
| 2477 | ;; Quote certain special characters as needed. | 2460 | ;; Quote certain special characters as needed. |
| 2478 | ;; get_doc_string in doc.c does the unquoting. | 2461 | ;; get_doc_string in doc.c does the unquoting. |
| @@ -2732,7 +2715,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2732 | (byte-compile-tag-number 0) | 2715 | (byte-compile-tag-number 0) |
| 2733 | (byte-compile-depth 0) | 2716 | (byte-compile-depth 0) |
| 2734 | (byte-compile-maxdepth 0) | 2717 | (byte-compile-maxdepth 0) |
| 2735 | (byte-compile-lexical-environment lexenv) | 2718 | (byte-compile--lexical-environment lexenv) |
| 2736 | (byte-compile-reserved-constants (or reserved-csts 0)) | 2719 | (byte-compile-reserved-constants (or reserved-csts 0)) |
| 2737 | (byte-compile-output nil)) | 2720 | (byte-compile-output nil)) |
| 2738 | (if (memq byte-optimize '(t source)) | 2721 | (if (memq byte-optimize '(t source)) |
| @@ -2743,7 +2726,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2743 | (when (and lexical-binding (eq output-type 'lambda)) | 2726 | (when (and lexical-binding (eq output-type 'lambda)) |
| 2744 | ;; See how many arguments there are, and set the current stack depth | 2727 | ;; See how many arguments there are, and set the current stack depth |
| 2745 | ;; accordingly. | 2728 | ;; accordingly. |
| 2746 | (setq byte-compile-depth (length byte-compile-lexical-environment)) | 2729 | (setq byte-compile-depth (length byte-compile--lexical-environment)) |
| 2747 | ;; If there are args, output a tag to record the initial | 2730 | ;; If there are args, output a tag to record the initial |
| 2748 | ;; stack-depth for the optimizer. | 2731 | ;; stack-depth for the optimizer. |
| 2749 | (when (> byte-compile-depth 0) | 2732 | (when (> byte-compile-depth 0) |
| @@ -2789,7 +2772,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2789 | ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) | 2772 | ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) |
| 2790 | ;; file -> as progn, but takes both quotes and atoms, and longer forms. | 2773 | ;; file -> as progn, but takes both quotes and atoms, and longer forms. |
| 2791 | (let (rest | 2774 | (let (rest |
| 2792 | (byte-compile--for-effect for-effect) ;FIXME: Probably unused! | ||
| 2793 | (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. | 2775 | (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. |
| 2794 | tmp body) | 2776 | tmp body) |
| 2795 | (cond | 2777 | (cond |
| @@ -2975,6 +2957,7 @@ That command is designed for interactive use only" fn)) | |||
| 2975 | (byte-compile-out-tag endtag))) | 2957 | (byte-compile-out-tag endtag))) |
| 2976 | 2958 | ||
| 2977 | (defun byte-compile-unfold-bcf (form) | 2959 | (defun byte-compile-unfold-bcf (form) |
| 2960 | "Inline call to byte-code-functions." | ||
| 2978 | (let* ((byte-compile-bound-variables byte-compile-bound-variables) | 2961 | (let* ((byte-compile-bound-variables byte-compile-bound-variables) |
| 2979 | (fun (car form)) | 2962 | (fun (car form)) |
| 2980 | (fargs (aref fun 0)) | 2963 | (fargs (aref fun 0)) |
| @@ -3056,7 +3039,7 @@ If BINDING is non-nil, VAR is being bound." | |||
| 3056 | (defun byte-compile-variable-ref (var) | 3039 | (defun byte-compile-variable-ref (var) |
| 3057 | "Generate code to push the value of the variable VAR on the stack." | 3040 | "Generate code to push the value of the variable VAR on the stack." |
| 3058 | (byte-compile-check-variable var) | 3041 | (byte-compile-check-variable var) |
| 3059 | (let ((lex-binding (assq var byte-compile-lexical-environment))) | 3042 | (let ((lex-binding (assq var byte-compile--lexical-environment))) |
| 3060 | (if lex-binding | 3043 | (if lex-binding |
| 3061 | ;; VAR is lexically bound | 3044 | ;; VAR is lexically bound |
| 3062 | (byte-compile-stack-ref (cdr lex-binding)) | 3045 | (byte-compile-stack-ref (cdr lex-binding)) |
| @@ -3072,7 +3055,7 @@ If BINDING is non-nil, VAR is being bound." | |||
| 3072 | (defun byte-compile-variable-set (var) | 3055 | (defun byte-compile-variable-set (var) |
| 3073 | "Generate code to set the variable VAR from the top-of-stack value." | 3056 | "Generate code to set the variable VAR from the top-of-stack value." |
| 3074 | (byte-compile-check-variable var) | 3057 | (byte-compile-check-variable var) |
| 3075 | (let ((lex-binding (assq var byte-compile-lexical-environment))) | 3058 | (let ((lex-binding (assq var byte-compile--lexical-environment))) |
| 3076 | (if lex-binding | 3059 | (if lex-binding |
| 3077 | ;; VAR is lexically bound | 3060 | ;; VAR is lexically bound |
| 3078 | (byte-compile-stack-set (cdr lex-binding)) | 3061 | (byte-compile-stack-set (cdr lex-binding)) |
| @@ -3181,6 +3164,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" | |||
| 3181 | (byte-defop-compiler bobp 0) | 3164 | (byte-defop-compiler bobp 0) |
| 3182 | (byte-defop-compiler current-buffer 0) | 3165 | (byte-defop-compiler current-buffer 0) |
| 3183 | ;;(byte-defop-compiler read-char 0) ;; obsolete | 3166 | ;;(byte-defop-compiler read-char 0) ;; obsolete |
| 3167 | ;; (byte-defop-compiler interactive-p 0) ;; Obsolete. | ||
| 3184 | (byte-defop-compiler widen 0) | 3168 | (byte-defop-compiler widen 0) |
| 3185 | (byte-defop-compiler end-of-line 0-1) | 3169 | (byte-defop-compiler end-of-line 0-1) |
| 3186 | (byte-defop-compiler forward-char 0-1) | 3170 | (byte-defop-compiler forward-char 0-1) |
| @@ -3355,6 +3339,7 @@ discarding." | |||
| 3355 | (defconst byte-compile--env-var (make-symbol "env")) | 3339 | (defconst byte-compile--env-var (make-symbol "env")) |
| 3356 | 3340 | ||
| 3357 | (defun byte-compile-make-closure (form) | 3341 | (defun byte-compile-make-closure (form) |
| 3342 | "Byte-compile the special `internal-make-closure' form." | ||
| 3358 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) | 3343 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3359 | (let* ((vars (nth 1 form)) | 3344 | (let* ((vars (nth 1 form)) |
| 3360 | (env (nth 2 form)) | 3345 | (env (nth 2 form)) |
| @@ -3366,12 +3351,11 @@ discarding." | |||
| 3366 | ',(aref fun 0) ',(aref fun 1) | 3351 | ',(aref fun 0) ',(aref fun 1) |
| 3367 | (vconcat (vector . ,env) ',(aref fun 2)) | 3352 | (vconcat (vector . ,env) ',(aref fun 2)) |
| 3368 | ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) | 3353 | ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) |
| 3369 | |||
| 3370 | 3354 | ||
| 3371 | (defun byte-compile-get-closed-var (form) | 3355 | (defun byte-compile-get-closed-var (form) |
| 3356 | "Byte-compile the special `internal-get-closed-var' form." | ||
| 3372 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) | 3357 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3373 | (byte-compile-out 'byte-constant ;; byte-closed-var | 3358 | (byte-compile-out 'byte-constant (nth 1 form)))) |
| 3374 | (nth 1 form)))) | ||
| 3375 | 3359 | ||
| 3376 | ;; Compile a function that accepts one or more args and is right-associative. | 3360 | ;; Compile a function that accepts one or more args and is right-associative. |
| 3377 | ;; We do it by left-associativity so that the operations | 3361 | ;; We do it by left-associativity so that the operations |
| @@ -3856,7 +3840,7 @@ Return the offset in the form (VAR . OFFSET)." | |||
| 3856 | (keywordp var))) | 3840 | (keywordp var))) |
| 3857 | 3841 | ||
| 3858 | (defun byte-compile-bind (var init-lexenv) | 3842 | (defun byte-compile-bind (var init-lexenv) |
| 3859 | "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'. | 3843 | "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'. |
| 3860 | INIT-LEXENV should be a lexical-environment alist describing the | 3844 | INIT-LEXENV should be a lexical-environment alist describing the |
| 3861 | positions of the init value that have been pushed on the stack. | 3845 | positions of the init value that have been pushed on the stack. |
| 3862 | Return non-nil if the TOS value was popped." | 3846 | Return non-nil if the TOS value was popped." |
| @@ -3866,7 +3850,7 @@ Return non-nil if the TOS value was popped." | |||
| 3866 | (cond ((not (byte-compile-not-lexical-var-p var)) | 3850 | (cond ((not (byte-compile-not-lexical-var-p var)) |
| 3867 | ;; VAR is a simple stack-allocated lexical variable | 3851 | ;; VAR is a simple stack-allocated lexical variable |
| 3868 | (push (assq var init-lexenv) | 3852 | (push (assq var init-lexenv) |
| 3869 | byte-compile-lexical-environment) | 3853 | byte-compile--lexical-environment) |
| 3870 | nil) | 3854 | nil) |
| 3871 | ((eq var (caar init-lexenv)) | 3855 | ((eq var (caar init-lexenv)) |
| 3872 | ;; VAR is dynamic and is on the top of the | 3856 | ;; VAR is dynamic and is on the top of the |
| @@ -3898,7 +3882,7 @@ binding slots have been popped." | |||
| 3898 | (let ((num-dynamic-bindings 0)) | 3882 | (let ((num-dynamic-bindings 0)) |
| 3899 | (dolist (clause clauses) | 3883 | (dolist (clause clauses) |
| 3900 | (unless (assq (if (consp clause) (car clause) clause) | 3884 | (unless (assq (if (consp clause) (car clause) clause) |
| 3901 | byte-compile-lexical-environment) | 3885 | byte-compile--lexical-environment) |
| 3902 | (setq num-dynamic-bindings (1+ num-dynamic-bindings)))) | 3886 | (setq num-dynamic-bindings (1+ num-dynamic-bindings)))) |
| 3903 | (unless (zerop num-dynamic-bindings) | 3887 | (unless (zerop num-dynamic-bindings) |
| 3904 | (byte-compile-out 'byte-unbind num-dynamic-bindings))) | 3888 | (byte-compile-out 'byte-unbind num-dynamic-bindings))) |
| @@ -3918,7 +3902,8 @@ binding slots have been popped." | |||
| 3918 | (push (byte-compile-push-binding-init var) init-lexenv))) | 3902 | (push (byte-compile-push-binding-init var) init-lexenv))) |
| 3919 | ;; New scope. | 3903 | ;; New scope. |
| 3920 | (let ((byte-compile-bound-variables byte-compile-bound-variables) | 3904 | (let ((byte-compile-bound-variables byte-compile-bound-variables) |
| 3921 | (byte-compile-lexical-environment byte-compile-lexical-environment)) | 3905 | (byte-compile--lexical-environment |
| 3906 | byte-compile--lexical-environment)) | ||
| 3922 | ;; Bind the variables. | 3907 | ;; Bind the variables. |
| 3923 | ;; For `let', do it in reverse order, because it makes no | 3908 | ;; For `let', do it in reverse order, because it makes no |
| 3924 | ;; semantic difference, but it is a lot more efficient since the | 3909 | ;; semantic difference, but it is a lot more efficient since the |
| @@ -3969,7 +3954,6 @@ binding slots have been popped." | |||
| 3969 | "Compiler error: `%s' has no `byte-compile-negated-op' property" | 3954 | "Compiler error: `%s' has no `byte-compile-negated-op' property" |
| 3970 | (car form))) | 3955 | (car form))) |
| 3971 | (cdr form)))) | 3956 | (cdr form)))) |
| 3972 | |||
| 3973 | 3957 | ||
| 3974 | ;;; other tricky macro-like special-forms | 3958 | ;;; other tricky macro-like special-forms |
| 3975 | 3959 | ||
| @@ -3979,6 +3963,8 @@ binding slots have been popped." | |||
| 3979 | (byte-defop-compiler-1 save-excursion) | 3963 | (byte-defop-compiler-1 save-excursion) |
| 3980 | (byte-defop-compiler-1 save-current-buffer) | 3964 | (byte-defop-compiler-1 save-current-buffer) |
| 3981 | (byte-defop-compiler-1 save-restriction) | 3965 | (byte-defop-compiler-1 save-restriction) |
| 3966 | ;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. | ||
| 3967 | ;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. | ||
| 3982 | (byte-defop-compiler-1 track-mouse) | 3968 | (byte-defop-compiler-1 track-mouse) |
| 3983 | 3969 | ||
| 3984 | (defun byte-compile-catch (form) | 3970 | (defun byte-compile-catch (form) |
| @@ -4286,7 +4272,7 @@ OP and OPERAND are as passed to `byte-compile-out'." | |||
| 4286 | ;; that take OPERAND values off the stack and push a result, for | 4272 | ;; that take OPERAND values off the stack and push a result, for |
| 4287 | ;; a total of 1 - OPERAND | 4273 | ;; a total of 1 - OPERAND |
| 4288 | (- 1 operand)))) | 4274 | (- 1 operand)))) |
| 4289 | 4275 | ||
| 4290 | (defun byte-compile-out (op &optional operand) | 4276 | (defun byte-compile-out (op &optional operand) |
| 4291 | (push (cons op operand) byte-compile-output) | 4277 | (push (cons op operand) byte-compile-output) |
| 4292 | (if (eq op 'byte-return) | 4278 | (if (eq op 'byte-return) |
| @@ -4298,50 +4284,6 @@ OP and OPERAND are as passed to `byte-compile-out'." | |||
| 4298 | (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth)) | 4284 | (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth)) |
| 4299 | ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) | 4285 | ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) |
| 4300 | )) | 4286 | )) |
| 4301 | |||
| 4302 | (defun byte-compile-delay-out (&optional stack-used stack-adjust) | ||
| 4303 | "Add a placeholder to the output, which can be used to later add byte-codes. | ||
| 4304 | Return a position tag that can be passed to `byte-compile-delayed-out' | ||
| 4305 | to add the delayed byte-codes. STACK-USED is the maximum amount of | ||
| 4306 | stack-spaced used by the delayed byte-codes (defaulting to 0), and | ||
| 4307 | STACK-ADJUST is the amount by which the later-added code will adjust the | ||
| 4308 | stack (defaulting to 0); the byte-codes added later _must_ adjust the | ||
| 4309 | stack by this amount! If STACK-ADJUST is 0, then it's not necessary to | ||
| 4310 | actually add anything later; the effect as if nothing was added at all." | ||
| 4311 | ;; We just add a no-op to `byte-compile-output', and return a pointer to | ||
| 4312 | ;; the tail of the list; `byte-compile-delayed-out' uses list surgery | ||
| 4313 | ;; to add the byte-codes. | ||
| 4314 | (when stack-used | ||
| 4315 | (setq byte-compile-maxdepth | ||
| 4316 | (max byte-compile-depth (+ byte-compile-depth (or stack-used 0))))) | ||
| 4317 | (when stack-adjust | ||
| 4318 | (setq byte-compile-depth | ||
| 4319 | (+ byte-compile-depth stack-adjust))) | ||
| 4320 | (push (cons nil (or stack-adjust 0)) byte-compile-output)) | ||
| 4321 | |||
| 4322 | (defun byte-compile-delayed-out (position op &optional operand) | ||
| 4323 | "Add at POSITION the byte-operation OP, with optional numeric arg OPERAND. | ||
| 4324 | POSITION should a position returned by `byte-compile-delay-out'. | ||
| 4325 | Return a new position, which can be used to add further operations." | ||
| 4326 | (unless (null (caar position)) | ||
| 4327 | (error "Bad POSITION arg to `byte-compile-delayed-out'")) | ||
| 4328 | ;; This is kind of like `byte-compile-out', but we splice into the list | ||
| 4329 | ;; where POSITION is. We don't bother updating `byte-compile-maxdepth' | ||
| 4330 | ;; because that was already done by `byte-compile-delay-out', but we do | ||
| 4331 | ;; update the relative operand stored in the no-op marker currently at | ||
| 4332 | ;; POSITION; since we insert before that marker, this means that if the | ||
| 4333 | ;; caller doesn't insert a sequence of byte-codes that matches the expected | ||
| 4334 | ;; operand passed to `byte-compile-delay-out', then the nop will still have | ||
| 4335 | ;; a non-zero operand when `byte-compile-lapcode' is called, which will | ||
| 4336 | ;; cause an error to be signaled. | ||
| 4337 | |||
| 4338 | ;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op | ||
| 4339 | (setcdr (car position) | ||
| 4340 | (- (cdar position) (byte-compile-stack-adjustment op operand))) | ||
| 4341 | ;; Add the new operation onto the list tail at POSITION | ||
| 4342 | (setcdr position (cons (cons op operand) (cdr position))) | ||
| 4343 | position) | ||
| 4344 | |||
| 4345 | 4287 | ||
| 4346 | ;;; call tree stuff | 4288 | ;;; call tree stuff |
| 4347 | 4289 | ||
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 46d14880a2c..5cc9ecb4cf7 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -67,15 +67,23 @@ | |||
| 67 | 67 | ||
| 68 | ;; TODO: (not just for cconv but also for the lexbind changes in general) | 68 | ;; TODO: (not just for cconv but also for the lexbind changes in general) |
| 69 | ;; - let (e)debug find the value of lexical variables from the stack. | 69 | ;; - let (e)debug find the value of lexical variables from the stack. |
| 70 | ;; - make eval-region do the eval-sexp-add-defvars danse. | ||
| 70 | ;; - byte-optimize-form should be applied before cconv. | 71 | ;; - byte-optimize-form should be applied before cconv. |
| 71 | ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize | 72 | ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize |
| 72 | ;; since afterwards they can because obnoxious (warnings about an "unused | 73 | ;; since afterwards they can because obnoxious (warnings about an "unused |
| 73 | ;; variable" should not be emitted when the variable use has simply been | 74 | ;; variable" should not be emitted when the variable use has simply been |
| 74 | ;; optimized away). | 75 | ;; optimized away). |
| 76 | ;; - turn defun and defmacro into macros (and remove special handling of | ||
| 77 | ;; `declare' afterwards). | ||
| 78 | ;; - let macros specify that some let-bindings come from the same source, | ||
| 79 | ;; so the unused warning takes all uses into account. | ||
| 80 | ;; - let interactive specs return a function to build the args (to stash into | ||
| 81 | ;; command-history). | ||
| 75 | ;; - canonize code in macro-expand so we don't have to handle (let (var) body) | 82 | ;; - canonize code in macro-expand so we don't have to handle (let (var) body) |
| 76 | ;; and other oddities. | 83 | ;; and other oddities. |
| 77 | ;; - new byte codes for unwind-protect, catch, and condition-case so that | 84 | ;; - new byte codes for unwind-protect, catch, and condition-case so that |
| 78 | ;; closures aren't needed at all. | 85 | ;; closures aren't needed at all. |
| 86 | ;; - inline source code of different binding mode by first compiling it. | ||
| 79 | ;; - a reference to a var that is known statically to always hold a constant | 87 | ;; - a reference to a var that is known statically to always hold a constant |
| 80 | ;; should be turned into a byte-constant rather than a byte-stack-ref. | 88 | ;; should be turned into a byte-constant rather than a byte-stack-ref. |
| 81 | ;; Hmm... right, that's called constant propagation and could be done here, | 89 | ;; Hmm... right, that's called constant propagation and could be done here, |
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 8bcbd67f46b..4c824d4a6d4 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el | |||
| @@ -282,7 +282,7 @@ Not documented | |||
| 282 | ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist | 282 | ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist |
| 283 | ;;;;;; do* do loop return-from return block etypecase typecase ecase | 283 | ;;;;;; do* do loop return-from return block etypecase typecase ecase |
| 284 | ;;;;;; case load-time-value eval-when destructuring-bind function* | 284 | ;;;;;; case load-time-value eval-when destructuring-bind function* |
| 285 | ;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c4734fbda33043d967624d39d80c3304") | 285 | ;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fe8a5acbe14e32846a77578b2165fab5") |
| 286 | ;;; Generated autoloads from cl-macs.el | 286 | ;;; Generated autoloads from cl-macs.el |
| 287 | 287 | ||
| 288 | (autoload 'gensym "cl-macs" "\ | 288 | (autoload 'gensym "cl-macs" "\ |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 7aac5bdaa01..9ce3dd6a7fe 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant." | |||
| 497 | (symbol-function 'byte-compile-file-form))) | 497 | (symbol-function 'byte-compile-file-form))) |
| 498 | (list 'byte-compile-file-form (list 'quote set)) | 498 | (list 'byte-compile-file-form (list 'quote set)) |
| 499 | '(byte-compile-file-form form))) | 499 | '(byte-compile-file-form form))) |
| 500 | (print set (symbol-value 'byte-compile-outbuffer))) | 500 | (print set (symbol-value 'byte-compile--outbuffer))) |
| 501 | (list 'symbol-value (list 'quote temp))) | 501 | (list 'symbol-value (list 'quote temp))) |
| 502 | (list 'quote (eval form)))) | 502 | (list 'quote (eval form)))) |
| 503 | 503 | ||
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 9c626dfcfa3..526475eb1bd 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el | |||
| @@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation. | |||
| 278 | (defvar cl-compiling-file nil) | 278 | (defvar cl-compiling-file nil) |
| 279 | (defun cl-compiling-file () | 279 | (defun cl-compiling-file () |
| 280 | (or cl-compiling-file | 280 | (or cl-compiling-file |
| 281 | (and (boundp 'byte-compile-outbuffer) | 281 | (and (boundp 'byte-compile--outbuffer) |
| 282 | (bufferp (symbol-value 'byte-compile-outbuffer)) | 282 | (bufferp (symbol-value 'byte-compile--outbuffer)) |
| 283 | (equal (buffer-name (symbol-value 'byte-compile-outbuffer)) | 283 | (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) |
| 284 | " *Compiler Output*")))) | 284 | " *Compiler Output*")))) |
| 285 | 285 | ||
| 286 | (defvar cl-proclaims-deferred nil) | 286 | (defvar cl-proclaims-deferred nil) |
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 9318876fe61..4fd10185c17 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el | |||
| @@ -72,7 +72,6 @@ redefine OBJECT if it is a symbol." | |||
| 72 | (let ((macro 'nil) | 72 | (let ((macro 'nil) |
| 73 | (name 'nil) | 73 | (name 'nil) |
| 74 | (doc 'nil) | 74 | (doc 'nil) |
| 75 | (lexical-binding nil) | ||
| 76 | args) | 75 | args) |
| 77 | (while (symbolp obj) | 76 | (while (symbolp obj) |
| 78 | (setq name obj | 77 | (setq name obj |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8135b5c4f24..f84de0308bf 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -3640,7 +3640,7 @@ Return the result of the last expression." | |||
| 3640 | (eval (if (bound-and-true-p cl-debug-env) | 3640 | (eval (if (bound-and-true-p cl-debug-env) |
| 3641 | (cl-macroexpand-all edebug-expr cl-debug-env) | 3641 | (cl-macroexpand-all edebug-expr cl-debug-env) |
| 3642 | edebug-expr) | 3642 | edebug-expr) |
| 3643 | lexical-binding)) ;; FIXME: lexbind. | 3643 | lexical-binding)) |
| 3644 | 3644 | ||
| 3645 | (defun edebug-safe-eval (edebug-expr) | 3645 | (defun edebug-safe-eval (edebug-expr) |
| 3646 | ;; Evaluate EXPR safely. | 3646 | ;; Evaluate EXPR safely. |
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 4e443452d8b..7a119e6bbc0 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el | |||
| @@ -96,6 +96,7 @@ default setting for optimization purposes.") | |||
| 96 | "Non-nil means to optimize the method dispatch on primary methods.") | 96 | "Non-nil means to optimize the method dispatch on primary methods.") |
| 97 | 97 | ||
| 98 | ;; State Variables | 98 | ;; State Variables |
| 99 | ;; FIXME: These two constants below should have an `eieio-' prefix added!! | ||
| 99 | (defvar this nil | 100 | (defvar this nil |
| 100 | "Inside a method, this variable is the object in question. | 101 | "Inside a method, this variable is the object in question. |
| 101 | DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. | 102 | DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. |
| @@ -122,7 +123,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!") | |||
| 122 | ;; while it is being built itself. | 123 | ;; while it is being built itself. |
| 123 | (defvar eieio-default-superclass nil) | 124 | (defvar eieio-default-superclass nil) |
| 124 | 125 | ||
| 125 | ;; FIXME: The constants below should have a `eieio-' prefix added!! | 126 | ;; FIXME: The constants below should have an `eieio-' prefix added!! |
| 126 | (defconst class-symbol 1 "Class's symbol (self-referencing.).") | 127 | (defconst class-symbol 1 "Class's symbol (self-referencing.).") |
| 127 | (defconst class-parent 2 "Class parent slot.") | 128 | (defconst class-parent 2 "Class parent slot.") |
| 128 | (defconst class-children 3 "Class children class slot.") | 129 | (defconst class-children 3 "Class children class slot.") |
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 408774fbbf1..39bdb505039 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el | |||
| @@ -745,7 +745,7 @@ POS specifies the starting position where EXP was found and defaults to point." | |||
| 745 | (unless (special-variable-p var) | 745 | (unless (special-variable-p var) |
| 746 | (push var vars)))) | 746 | (push var vars)))) |
| 747 | `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) | 747 | `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) |
| 748 | 748 | ||
| 749 | (defun eval-last-sexp (eval-last-sexp-arg-internal) | 749 | (defun eval-last-sexp (eval-last-sexp-arg-internal) |
| 750 | "Evaluate sexp before point; print value in minibuffer. | 750 | "Evaluate sexp before point; print value in minibuffer. |
| 751 | Interactively, with prefix argument, print output into current buffer. | 751 | Interactively, with prefix argument, print output into current buffer. |
diff --git a/src/ChangeLog b/src/ChangeLog index e34cd694321..04064adbaa3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2011-04-01 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * bytecode.c (Fbyte_code): Revert to old calling convention. | ||
| 4 | * lisp.h (COMPILED_PUSH_ARGS): Remove, unused. | ||
| 5 | |||
| 1 | 2011-03-16 Stefan Monnier <monnier@iro.umontreal.ca> | 6 | 2011-03-16 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 7 | ||
| 3 | * image.c (parse_image_spec): Use Ffunctionp. | 8 | * image.c (parse_image_spec): Use Ffunctionp. |
diff --git a/src/bytecode.c b/src/bytecode.c index 01ae8055ebf..5d94cb0fb39 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -51,7 +51,7 @@ by Hallvard: | |||
| 51 | * | 51 | * |
| 52 | * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. | 52 | * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. |
| 53 | */ | 53 | */ |
| 54 | #define BYTE_CODE_SAFE 1 | 54 | /* #define BYTE_CODE_SAFE */ |
| 55 | /* #define BYTE_CODE_METER */ | 55 | /* #define BYTE_CODE_METER */ |
| 56 | 56 | ||
| 57 | 57 | ||
| @@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest; | |||
| 160 | #ifdef BYTE_CODE_SAFE | 160 | #ifdef BYTE_CODE_SAFE |
| 161 | #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ | 161 | #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ |
| 162 | #endif | 162 | #endif |
| 163 | #define Binteractive_p 0164 /* Obsolete. */ | 163 | #define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */ |
| 164 | 164 | ||
| 165 | #define Bforward_char 0165 | 165 | #define Bforward_char 0165 |
| 166 | #define Bforward_word 0166 | 166 | #define Bforward_word 0166 |
| @@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest; | |||
| 185 | #define Bdup 0211 | 185 | #define Bdup 0211 |
| 186 | 186 | ||
| 187 | #define Bsave_excursion 0212 | 187 | #define Bsave_excursion 0212 |
| 188 | #define Bsave_window_excursion 0213 /* Obsolete. */ | 188 | #define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */ |
| 189 | #define Bsave_restriction 0214 | 189 | #define Bsave_restriction 0214 |
| 190 | #define Bcatch 0215 | 190 | #define Bcatch 0215 |
| 191 | 191 | ||
| 192 | #define Bunwind_protect 0216 | 192 | #define Bunwind_protect 0216 |
| 193 | #define Bcondition_case 0217 | 193 | #define Bcondition_case 0217 |
| 194 | #define Btemp_output_buffer_setup 0220 /* Obsolete. */ | 194 | #define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */ |
| 195 | #define Btemp_output_buffer_show 0221 /* Obsolete. */ | 195 | #define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */ |
| 196 | 196 | ||
| 197 | #define Bunbind_all 0222 /* Obsolete. */ | 197 | #define Bunbind_all 0222 /* Obsolete. Never used. */ |
| 198 | 198 | ||
| 199 | #define Bset_marker 0223 | 199 | #define Bset_marker 0223 |
| 200 | #define Bmatch_beginning 0224 | 200 | #define Bmatch_beginning 0224 |
| @@ -413,24 +413,15 @@ unmark_byte_stack (void) | |||
| 413 | } while (0) | 413 | } while (0) |
| 414 | 414 | ||
| 415 | 415 | ||
| 416 | DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0, | 416 | DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, |
| 417 | doc: /* Function used internally in byte-compiled code. | 417 | doc: /* Function used internally in byte-compiled code. |
| 418 | The first argument, BYTESTR, is a string of byte code; | 418 | The first argument, BYTESTR, is a string of byte code; |
| 419 | the second, VECTOR, a vector of constants; | 419 | the second, VECTOR, a vector of constants; |
| 420 | the third, MAXDEPTH, the maximum stack depth used in this function. | 420 | the third, MAXDEPTH, the maximum stack depth used in this function. |
| 421 | If the third argument is incorrect, Emacs may crash. | 421 | If the third argument is incorrect, Emacs may crash. */) |
| 422 | 422 | (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) | |
| 423 | If ARGS-TEMPLATE is specified, it is an argument list specification, | ||
| 424 | according to which any remaining arguments are pushed on the stack | ||
| 425 | before executing BYTESTR. | ||
| 426 | |||
| 427 | usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */) | ||
| 428 | (size_t nargs, Lisp_Object *args) | ||
| 429 | { | 423 | { |
| 430 | Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil; | 424 | return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); |
| 431 | int pnargs = nargs >= 4 ? nargs - 4 : 0; | ||
| 432 | Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0; | ||
| 433 | return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs); | ||
| 434 | } | 425 | } |
| 435 | 426 | ||
| 436 | /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and | 427 | /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and |
| @@ -810,7 +801,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 810 | AFTER_POTENTIAL_GC (); | 801 | AFTER_POTENTIAL_GC (); |
| 811 | break; | 802 | break; |
| 812 | 803 | ||
| 813 | case Bunbind_all: /* Obsolete. */ | 804 | case Bunbind_all: /* Obsolete. Never used. */ |
| 814 | /* To unbind back to the beginning of this frame. Not used yet, | 805 | /* To unbind back to the beginning of this frame. Not used yet, |
| 815 | but will be needed for tail-recursion elimination. */ | 806 | but will be needed for tail-recursion elimination. */ |
| 816 | BEFORE_POTENTIAL_GC (); | 807 | BEFORE_POTENTIAL_GC (); |
| @@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 938 | save_excursion_save ()); | 929 | save_excursion_save ()); |
| 939 | break; | 930 | break; |
| 940 | 931 | ||
| 941 | case Bsave_current_buffer: /* Obsolete. */ | 932 | case Bsave_current_buffer: /* Obsolete since ??. */ |
| 942 | case Bsave_current_buffer_1: | 933 | case Bsave_current_buffer_1: |
| 943 | record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); | 934 | record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); |
| 944 | break; | 935 | break; |
| 945 | 936 | ||
| 946 | case Bsave_window_excursion: /* Obsolete. */ | 937 | case Bsave_window_excursion: /* Obsolete since 24.1. */ |
| 947 | { | 938 | { |
| 948 | register int count = SPECPDL_INDEX (); | 939 | register int count = SPECPDL_INDEX (); |
| 949 | record_unwind_protect (Fset_window_configuration, | 940 | record_unwind_protect (Fset_window_configuration, |
| @@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 985 | break; | 976 | break; |
| 986 | } | 977 | } |
| 987 | 978 | ||
| 988 | case Btemp_output_buffer_setup: /* Obsolete. */ | 979 | case Btemp_output_buffer_setup: /* Obsolete since 24.1. */ |
| 989 | BEFORE_POTENTIAL_GC (); | 980 | BEFORE_POTENTIAL_GC (); |
| 990 | CHECK_STRING (TOP); | 981 | CHECK_STRING (TOP); |
| 991 | temp_output_buffer_setup (SSDATA (TOP)); | 982 | temp_output_buffer_setup (SSDATA (TOP)); |
| @@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 993 | TOP = Vstandard_output; | 984 | TOP = Vstandard_output; |
| 994 | break; | 985 | break; |
| 995 | 986 | ||
| 996 | case Btemp_output_buffer_show: /* Obsolete. */ | 987 | case Btemp_output_buffer_show: /* Obsolete since 24.1. */ |
| 997 | { | 988 | { |
| 998 | Lisp_Object v1; | 989 | Lisp_Object v1; |
| 999 | BEFORE_POTENTIAL_GC (); | 990 | BEFORE_POTENTIAL_GC (); |
| @@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1465 | AFTER_POTENTIAL_GC (); | 1456 | AFTER_POTENTIAL_GC (); |
| 1466 | break; | 1457 | break; |
| 1467 | 1458 | ||
| 1468 | case Binteractive_p: /* Obsolete. */ | 1459 | case Binteractive_p: /* Obsolete since 24.1. */ |
| 1469 | PUSH (Finteractive_p ()); | 1460 | PUSH (Finteractive_p ()); |
| 1470 | break; | 1461 | break; |
| 1471 | 1462 | ||
diff --git a/src/callint.c b/src/callint.c index 489fa392e46..60570369d9e 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -171,8 +171,8 @@ static void | |||
| 171 | fix_command (Lisp_Object input, Lisp_Object values) | 171 | fix_command (Lisp_Object input, Lisp_Object values) |
| 172 | { | 172 | { |
| 173 | /* FIXME: Instead of this ugly hack, we should provide a way for an | 173 | /* FIXME: Instead of this ugly hack, we should provide a way for an |
| 174 | interactive spec to return an expression that will re-build the args | 174 | interactive spec to return an expression/function that will re-build the |
| 175 | without user intervention. */ | 175 | args without user intervention. */ |
| 176 | if (CONSP (input)) | 176 | if (CONSP (input)) |
| 177 | { | 177 | { |
| 178 | Lisp_Object car; | 178 | Lisp_Object car; |
diff --git a/src/eval.c b/src/eval.c index 9f90e6df4b5..0e47d7c757c 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function; | |||
| 117 | 117 | ||
| 118 | int handling_signal; | 118 | int handling_signal; |
| 119 | 119 | ||
| 120 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | ||
| 121 | static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *); | 120 | static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *); |
| 122 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; | 121 | static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; |
| 123 | static int interactive_p (int); | 122 | static int interactive_p (int); |
| 123 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | ||
| 124 | 124 | ||
| 125 | void | 125 | void |
| 126 | init_eval_once (void) | 126 | init_eval_once (void) |
| @@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) | |||
| 684 | tail = Fcons (lambda_list, tail); | 684 | tail = Fcons (lambda_list, tail); |
| 685 | else | 685 | else |
| 686 | tail = Fcons (lambda_list, Fcons (doc, tail)); | 686 | tail = Fcons (lambda_list, Fcons (doc, tail)); |
| 687 | 687 | ||
| 688 | defn = Fcons (Qlambda, tail); | 688 | defn = Fcons (Qlambda, tail); |
| 689 | if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ | 689 | if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ |
| 690 | defn = Ffunction (Fcons (defn, Qnil)); | 690 | defn = Ffunction (Fcons (defn, Qnil)); |
| @@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */) | |||
| 1012 | 1012 | ||
| 1013 | varlist = XCDR (varlist); | 1013 | varlist = XCDR (varlist); |
| 1014 | } | 1014 | } |
| 1015 | |||
| 1016 | UNGCPRO; | 1015 | UNGCPRO; |
| 1017 | |||
| 1018 | val = Fprogn (Fcdr (args)); | 1016 | val = Fprogn (Fcdr (args)); |
| 1019 | |||
| 1020 | return unbind_to (count, val); | 1017 | return unbind_to (count, val); |
| 1021 | } | 1018 | } |
| 1022 | 1019 | ||
| @@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */) | |||
| 2083 | return Qnil; | 2080 | return Qnil; |
| 2084 | funcar = XCAR (fun); | 2081 | funcar = XCAR (fun); |
| 2085 | if (EQ (funcar, Qclosure)) | 2082 | if (EQ (funcar, Qclosure)) |
| 2086 | return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; | 2083 | return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) |
| 2084 | ? Qt : if_prop); | ||
| 2087 | else if (EQ (funcar, Qlambda)) | 2085 | else if (EQ (funcar, Qlambda)) |
| 2088 | return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; | 2086 | return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; |
| 2089 | else if (EQ (funcar, Qautoload)) | 2087 | else if (EQ (funcar, Qautoload)) |
| @@ -2898,7 +2896,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, | |||
| 2898 | /* The caller should GCPRO all the elements of ARGS. */ | 2896 | /* The caller should GCPRO all the elements of ARGS. */ |
| 2899 | 2897 | ||
| 2900 | DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, | 2898 | DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, |
| 2901 | doc: /* Return non-nil if OBJECT is a type of object that can be called as a function. */) | 2899 | doc: /* Non-nil if OBJECT is a function. */) |
| 2902 | (Lisp_Object object) | 2900 | (Lisp_Object object) |
| 2903 | { | 2901 | { |
| 2904 | if (SYMBOLP (object) && !NILP (Ffboundp (object))) | 2902 | if (SYMBOLP (object) && !NILP (Ffboundp (object))) |
| @@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs, | |||
| 3220 | xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); | 3218 | xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); |
| 3221 | else | 3219 | else |
| 3222 | val = Qnil; | 3220 | val = Qnil; |
| 3223 | 3221 | ||
| 3224 | /* Bind the argument. */ | 3222 | /* Bind the argument. */ |
| 3225 | if (!NILP (lexenv) && SYMBOLP (next)) | 3223 | if (!NILP (lexenv) && SYMBOLP (next)) |
| 3226 | /* Lexically bind NEXT by adding it to the lexenv alist. */ | 3224 | /* Lexically bind NEXT by adding it to the lexenv alist. */ |
| @@ -3501,7 +3499,6 @@ context where binding is lexical by default. */) | |||
| 3501 | } | 3499 | } |
| 3502 | 3500 | ||
| 3503 | 3501 | ||
| 3504 | |||
| 3505 | DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, | 3502 | DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, |
| 3506 | doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. | 3503 | doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. |
| 3507 | The debugger is entered when that frame exits, if the flag is non-nil. */) | 3504 | The debugger is entered when that frame exits, if the flag is non-nil. */) |
diff --git a/src/lisp.h b/src/lisp.h index bd70dcebbdb..580dbd11013 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR; | |||
| 1483 | #define COMPILED_STACK_DEPTH 3 | 1483 | #define COMPILED_STACK_DEPTH 3 |
| 1484 | #define COMPILED_DOC_STRING 4 | 1484 | #define COMPILED_DOC_STRING 4 |
| 1485 | #define COMPILED_INTERACTIVE 5 | 1485 | #define COMPILED_INTERACTIVE 5 |
| 1486 | #define COMPILED_PUSH_ARGS 6 | ||
| 1487 | 1486 | ||
| 1488 | /* Flag bits in a character. These also get used in termhooks.h. | 1487 | /* Flag bits in a character. These also get used in termhooks.h. |
| 1489 | Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE | 1488 | Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE |
| @@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int); | |||
| 3264 | 3263 | ||
| 3265 | /* Defined in bytecode.c */ | 3264 | /* Defined in bytecode.c */ |
| 3266 | extern Lisp_Object Qbytecode; | 3265 | extern Lisp_Object Qbytecode; |
| 3267 | EXFUN (Fbyte_code, MANY); | 3266 | EXFUN (Fbyte_code, 3); |
| 3268 | extern void syms_of_bytecode (void); | 3267 | extern void syms_of_bytecode (void); |
| 3269 | extern struct byte_stack *byte_stack_list; | 3268 | extern struct byte_stack *byte_stack_list; |
| 3270 | #ifdef BYTE_MARK_STACK | 3269 | #ifdef BYTE_MARK_STACK |
diff --git a/src/lread.c b/src/lread.c index 24183532527..6a24569f552 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) | |||
| 796 | } beg_end_state = NOMINAL; | 796 | } beg_end_state = NOMINAL; |
| 797 | int in_file_vars = 0; | 797 | int in_file_vars = 0; |
| 798 | 798 | ||
| 799 | #define UPDATE_BEG_END_STATE(ch) \ | 799 | #define UPDATE_BEG_END_STATE(ch) \ |
| 800 | if (beg_end_state == NOMINAL) \ | 800 | if (beg_end_state == NOMINAL) \ |
| 801 | beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ | 801 | beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ |
| 802 | else if (beg_end_state == AFTER_FIRST_DASH) \ | 802 | else if (beg_end_state == AFTER_FIRST_DASH) \ |
| 803 | beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ | 803 | beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ |
| 804 | else if (beg_end_state == AFTER_ASTERIX) \ | 804 | else if (beg_end_state == AFTER_ASTERIX) \ |
| 805 | { \ | 805 | { \ |
| 806 | if (ch == '-') \ | 806 | if (ch == '-') \ |
| 807 | in_file_vars = !in_file_vars; \ | 807 | in_file_vars = !in_file_vars; \ |
| 808 | beg_end_state = NOMINAL; \ | 808 | beg_end_state = NOMINAL; \ |
| 809 | } | 809 | } |
| 810 | 810 | ||
| 811 | /* Skip until we get to the file vars, if any. */ | 811 | /* Skip until we get to the file vars, if any. */ |
| @@ -834,7 +834,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) | |||
| 834 | UPDATE_BEG_END_STATE (ch); | 834 | UPDATE_BEG_END_STATE (ch); |
| 835 | ch = READCHAR; | 835 | ch = READCHAR; |
| 836 | } | 836 | } |
| 837 | 837 | ||
| 838 | while (var_end > var | 838 | while (var_end > var |
| 839 | && (var_end[-1] == ' ' || var_end[-1] == '\t')) | 839 | && (var_end[-1] == ' ' || var_end[-1] == '\t')) |
| 840 | var_end--; | 840 | var_end--; |
| @@ -880,7 +880,6 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) | |||
| 880 | return rv; | 880 | return rv; |
| 881 | } | 881 | } |
| 882 | } | 882 | } |
| 883 | |||
| 884 | 883 | ||
| 885 | /* Value is a version number of byte compiled code if the file | 884 | /* Value is a version number of byte compiled code if the file |
| 886 | associated with file descriptor FD is a compiled Lisp file that's | 885 | associated with file descriptor FD is a compiled Lisp file that's |
| @@ -1275,7 +1274,6 @@ Return t if the file exists and loads successfully. */) | |||
| 1275 | specbind (Qinhibit_file_name_operation, Qnil); | 1274 | specbind (Qinhibit_file_name_operation, Qnil); |
| 1276 | load_descriptor_list | 1275 | load_descriptor_list |
| 1277 | = Fcons (make_number (fileno (stream)), load_descriptor_list); | 1276 | = Fcons (make_number (fileno (stream)), load_descriptor_list); |
| 1278 | |||
| 1279 | specbind (Qload_in_progress, Qt); | 1277 | specbind (Qload_in_progress, Qt); |
| 1280 | 1278 | ||
| 1281 | instream = stream; | 1279 | instream = stream; |
| @@ -1863,11 +1861,9 @@ This function preserves the position of point. */) | |||
| 1863 | 1861 | ||
| 1864 | specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); | 1862 | specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); |
| 1865 | specbind (Qstandard_output, tem); | 1863 | specbind (Qstandard_output, tem); |
| 1866 | specbind (Qlexical_binding, Qnil); | ||
| 1867 | record_unwind_protect (save_excursion_restore, save_excursion_save ()); | 1864 | record_unwind_protect (save_excursion_restore, save_excursion_save ()); |
| 1868 | BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); | 1865 | BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); |
| 1869 | if (lisp_file_lexically_bound_p (buf)) | 1866 | specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); |
| 1870 | Fset (Qlexical_binding, Qt); | ||
| 1871 | readevalloop (buf, 0, filename, | 1867 | readevalloop (buf, 0, filename, |
| 1872 | !NILP (printflag), unibyte, Qnil, Qnil, Qnil); | 1868 | !NILP (printflag), unibyte, Qnil, Qnil, Qnil); |
| 1873 | unbind_to (count, Qnil); | 1869 | unbind_to (count, Qnil); |
| @@ -3336,7 +3332,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) | |||
| 3336 | for (i = 0; i < size; i++) | 3332 | for (i = 0; i < size; i++) |
| 3337 | { | 3333 | { |
| 3338 | item = Fcar (tem); | 3334 | item = Fcar (tem); |
| 3339 | |||
| 3340 | /* If `load-force-doc-strings' is t when reading a lazily-loaded | 3335 | /* If `load-force-doc-strings' is t when reading a lazily-loaded |
| 3341 | bytecode object, the docstring containing the bytecode and | 3336 | bytecode object, the docstring containing the bytecode and |
| 3342 | constants values must be treated as unibyte and passed to | 3337 | constants values must be treated as unibyte and passed to |
| @@ -3394,7 +3389,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) | |||
| 3394 | tem = Fcdr (tem); | 3389 | tem = Fcdr (tem); |
| 3395 | free_cons (otem); | 3390 | free_cons (otem); |
| 3396 | } | 3391 | } |
| 3397 | |||
| 3398 | return vector; | 3392 | return vector; |
| 3399 | } | 3393 | } |
| 3400 | 3394 | ||
| @@ -4024,7 +4018,6 @@ defvar_lisp (struct Lisp_Objfwd *o_fwd, | |||
| 4024 | staticpro (address); | 4018 | staticpro (address); |
| 4025 | } | 4019 | } |
| 4026 | 4020 | ||
| 4027 | |||
| 4028 | /* Similar but define a variable whose value is the Lisp Object stored | 4021 | /* Similar but define a variable whose value is the Lisp Object stored |
| 4029 | at a particular offset in the current kboard object. */ | 4022 | at a particular offset in the current kboard object. */ |
| 4030 | 4023 | ||
| @@ -4470,7 +4463,7 @@ to load. See also `load-dangerous-libraries'. */); | |||
| 4470 | doc: /* If non-nil, use lexical binding when evaluating code. | 4463 | doc: /* If non-nil, use lexical binding when evaluating code. |
| 4471 | This only applies to code evaluated by `eval-buffer' and `eval-region'. | 4464 | This only applies to code evaluated by `eval-buffer' and `eval-region'. |
| 4472 | This variable is automatically set from the file variables of an interpreted | 4465 | This variable is automatically set from the file variables of an interpreted |
| 4473 | lisp file read using `load'. */); | 4466 | Lisp file read using `load'. */); |
| 4474 | Fmake_variable_buffer_local (Qlexical_binding); | 4467 | Fmake_variable_buffer_local (Qlexical_binding); |
| 4475 | 4468 | ||
| 4476 | DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list, | 4469 | DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list, |
diff --git a/src/window.c b/src/window.c index 4bd533c22ac..7e40cdff42b 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -3649,6 +3649,7 @@ displaying that buffer. */) | |||
| 3649 | return Qnil; | 3649 | return Qnil; |
| 3650 | } | 3650 | } |
| 3651 | 3651 | ||
| 3652 | |||
| 3652 | void | 3653 | void |
| 3653 | temp_output_buffer_show (register Lisp_Object buf) | 3654 | temp_output_buffer_show (register Lisp_Object buf) |
| 3654 | { | 3655 | { |
diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el index 1ff31e2422d..95b8bbe8858 100644 --- a/test/automated/lexbind-tests.el +++ b/test/automated/lexbind-tests.el | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2011 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2011 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> |
| 6 | ;; Keywords: | 6 | ;; Keywords: |
| 7 | 7 | ||
| 8 | ;; This program is free software; you can redistribute it and/or modify | 8 | ;; This program is free software; you can redistribute it and/or modify |
| 9 | ;; it under the terms of the GNU General Public License as published by | 9 | ;; it under the terms of the GNU General Public License as published by |
| @@ -20,7 +20,7 @@ | |||
| 20 | 20 | ||
| 21 | ;;; Commentary: | 21 | ;;; Commentary: |
| 22 | 22 | ||
| 23 | ;; | 23 | ;; |
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||