diff options
| author | Jim Blandy | 1992-07-22 16:55:01 +0000 |
|---|---|---|
| committer | Jim Blandy | 1992-07-22 16:55:01 +0000 |
| commit | 3eac99106c84691923f004e3cd251c358c04276f (patch) | |
| tree | 51e912b4cdbc50914538b71c3bf3fc72742eb0a4 | |
| parent | 434e6714820315c7e27ec615b0c9b8ab32435e7f (diff) | |
| download | emacs-3eac99106c84691923f004e3cd251c358c04276f.tar.gz emacs-3eac99106c84691923f004e3cd251c358c04276f.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 61 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 45 | ||||
| -rw-r--r-- | src/fileio.c | 11 |
3 files changed, 41 insertions, 76 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 8ed85ff805c..62a112debca 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el | |||
| @@ -1,12 +1,16 @@ | |||
| 1 | ;;; The optimization passes of the emacs-lisp byte compiler. | 1 | ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler. |
| 2 | |||
| 2 | ;;; Copyright (c) 1991 Free Software Foundation, Inc. | 3 | ;;; Copyright (c) 1991 Free Software Foundation, Inc. |
| 3 | ;; By Jamie Zawinski <jwz@lucid.com> and Hallvard Furuseth <hbf@ulrik.uio.no>. | 4 | |
| 5 | ;; Author: Jamie Zawinski <jwz@lucid.com> | ||
| 6 | ;; Hallvard Furuseth <hbf@ulrik.uio.no> | ||
| 7 | ;; Keywords: internal | ||
| 4 | 8 | ||
| 5 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| 6 | 10 | ||
| 7 | ;; GNU Emacs is free software; you can redistribute it and/or modify | 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 8 | ;; it under the terms of the GNU General Public License as published by | 12 | ;; it under the terms of the GNU General Public License as published by |
| 9 | ;; the Free Software Foundation; either version 1, or (at your option) | 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 10 | ;; any later version. | 14 | ;; any later version. |
| 11 | 15 | ||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| @@ -18,6 +22,8 @@ | |||
| 18 | ;; along with GNU Emacs; see the file COPYING. If not, write to | 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
| 19 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 23 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 20 | 24 | ||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 21 | ;;; ======================================================================== | 27 | ;;; ======================================================================== |
| 22 | ;;; "No matter how hard you try, you can't make a racehorse out of a pig. | 28 | ;;; "No matter how hard you try, you can't make a racehorse out of a pig. |
| 23 | ;;; you can, however, make a faster pig." | 29 | ;;; you can, however, make a faster pig." |
| @@ -69,13 +75,14 @@ | |||
| 69 | ;;; but beware of traps like | 75 | ;;; but beware of traps like |
| 70 | ;;; (cons (list x y) (list x y)) | 76 | ;;; (cons (list x y) (list x y)) |
| 71 | ;;; | 77 | ;;; |
| 72 | ;;; Tail-recursion elimination is not really possible in elisp. Tail-recursion | 78 | ;;; Tail-recursion elimination is not really possible in Emacs Lisp. |
| 73 | ;;; elimination is almost always impossible when all variables have dynamic | 79 | ;;; Tail-recursion elimination is almost always impossible when all variables |
| 74 | ;;; scope, but given that the "return" byteop requires the binding stack to be | 80 | ;;; have dynamic scope, but given that the "return" byteop requires the |
| 75 | ;;; empty (rather than emptying it itself), there can be no truly tail- | 81 | ;;; binding stack to be empty (rather than emptying it itself), there can be |
| 76 | ;;; recursive elisp functions that take any arguments or make any bindings. | 82 | ;;; no truly tail-recursive Emacs Lisp functions that take any arguments or |
| 83 | ;;; make any bindings. | ||
| 77 | ;;; | 84 | ;;; |
| 78 | ;;; Here is an example of an elisp function which could safely be | 85 | ;;; Here is an example of an Emacs Lisp function which could safely be |
| 79 | ;;; byte-compiled tail-recursively: | 86 | ;;; byte-compiled tail-recursively: |
| 80 | ;;; | 87 | ;;; |
| 81 | ;;; (defun tail-map (fn list) | 88 | ;;; (defun tail-map (fn list) |
| @@ -105,7 +112,7 @@ | |||
| 105 | ;;; overflow. I don't believe there is any way around this without lexical | 112 | ;;; overflow. I don't believe there is any way around this without lexical |
| 106 | ;;; scope. | 113 | ;;; scope. |
| 107 | ;;; | 114 | ;;; |
| 108 | ;;; Wouldn't it be nice if elisp had lexical scope. | 115 | ;;; Wouldn't it be nice if Emacs Lisp had lexical scope. |
| 109 | ;;; | 116 | ;;; |
| 110 | ;;; Idea: the form (lexical-scope) in a file means that the file may be | 117 | ;;; Idea: the form (lexical-scope) in a file means that the file may be |
| 111 | ;;; compiled lexically. This proclamation is file-local. Then, within | 118 | ;;; compiled lexically. This proclamation is file-local. Then, within |
| @@ -128,6 +135,7 @@ | |||
| 128 | ;;; the board, in the interpreter and compiler, and just FIX all of | 135 | ;;; the board, in the interpreter and compiler, and just FIX all of |
| 129 | ;;; the code that relies on dynamic scope of non-defvarred variables. | 136 | ;;; the code that relies on dynamic scope of non-defvarred variables. |
| 130 | 137 | ||
| 138 | ;;; Code: | ||
| 131 | 139 | ||
| 132 | (defun byte-compile-log-lap-1 (format &rest args) | 140 | (defun byte-compile-log-lap-1 (format &rest args) |
| 133 | (if (aref byte-code-vector 0) | 141 | (if (aref byte-code-vector 0) |
| @@ -1029,7 +1037,7 @@ | |||
| 1029 | (+ (aref bytes ptr) | 1037 | (+ (aref bytes ptr) |
| 1030 | (progn (setq ptr (1+ ptr)) | 1038 | (progn (setq ptr (1+ ptr)) |
| 1031 | (lsh (aref bytes ptr) 8)))) | 1039 | (lsh (aref bytes ptr) 8)))) |
| 1032 | ((and (>= op byte-rel-goto) | 1040 | ((and (>= op byte-listN) |
| 1033 | (<= op byte-insertN)) | 1041 | (<= op byte-insertN)) |
| 1034 | (setq ptr (1+ ptr)) ;offset in next byte | 1042 | (setq ptr (1+ ptr)) ;offset in next byte |
| 1035 | (aref bytes ptr)))) | 1043 | (aref bytes ptr)))) |
| @@ -1060,13 +1068,7 @@ | |||
| 1060 | optr ptr | 1068 | optr ptr |
| 1061 | offset (disassemble-offset)) ; this does dynamic-scope magic | 1069 | offset (disassemble-offset)) ; this does dynamic-scope magic |
| 1062 | (setq op (aref byte-code-vector op)) | 1070 | (setq op (aref byte-code-vector op)) |
| 1063 | (cond ((or (memq op byte-goto-ops) | 1071 | (cond ((memq op byte-goto-ops) |
| 1064 | (cond ((memq op byte-rel-goto-ops) | ||
| 1065 | (setq op (aref byte-code-vector | ||
| 1066 | (- (symbol-value op) | ||
| 1067 | (- byte-rel-goto byte-goto)))) | ||
| 1068 | (setq offset (+ ptr (- offset 127))) | ||
| 1069 | t))) | ||
| 1070 | ;; it's a pc | 1072 | ;; it's a pc |
| 1071 | (setq offset | 1073 | (setq offset |
| 1072 | (cdr (or (assq offset tags) | 1074 | (cdr (or (assq offset tags) |
| @@ -1176,16 +1178,17 @@ | |||
| 1176 | ;;; the BOOL variables are, and not perform this optimization on them. | 1178 | ;;; the BOOL variables are, and not perform this optimization on them. |
| 1177 | ;;; | 1179 | ;;; |
| 1178 | (defconst byte-boolean-vars | 1180 | (defconst byte-boolean-vars |
| 1179 | '(abbrevs-changed abbrev-all-caps inverse-video visible-bell | 1181 | '(abbrev-all-caps abbrevs-changed byte-metering-on |
| 1180 | check-protected-fields no-redraw-on-reenter cursor-in-echo-area | 1182 | check-protected-fields completion-auto-help completion-ignore-case |
| 1181 | noninteractive stack-trace-on-error debug-on-error debug-on-quit | 1183 | cursor-in-echo-area debug-on-next-call debug-on-quit |
| 1182 | debug-on-next-call insert-default-directory vms-stmlf-recfm | 1184 | defining-kbd-macro delete-exited-processes |
| 1183 | indent-tabs-mode meta-flag load-in-progress defining-kbd-macro | 1185 | enable-recursive-minibuffers indent-tabs-mode |
| 1184 | completion-auto-help completion-ignore-case enable-recursive-minibuffers | 1186 | insert-default-directory inverse-video load-in-progress |
| 1185 | print-escape-newlines delete-exited-processes parse-sexp-ignore-comments | 1187 | menu-prompting mode-line-inverse-video no-redraw-on-reenter |
| 1186 | words-include-escapes pop-up-windows auto-new-screen | 1188 | noninteractive parse-sexp-ignore-comments pop-up-frames |
| 1187 | reset-terminal-on-clear truncate-partial-width-windows | 1189 | pop-up-windows print-escape-newlines print-escape-newlines |
| 1188 | mode-line-inverse-video) | 1190 | truncate-partial-width-windows visible-bell vms-stmlf-recfm |
| 1191 | words-include-escapes x-save-under) | ||
| 1189 | "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. | 1192 | "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. |
| 1190 | If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer | 1193 | If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer |
| 1191 | may generate incorrect code.") | 1194 | may generate incorrect code.") |
| @@ -1721,3 +1724,5 @@ may generate incorrect code.") | |||
| 1721 | byte-optimize-form-code-walker | 1724 | byte-optimize-form-code-walker |
| 1722 | byte-optimize-lapcode)))) | 1725 | byte-optimize-lapcode)))) |
| 1723 | nil) | 1726 | nil) |
| 1727 | |||
| 1728 | ;;; byte-opt.el ends here | ||
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0a781d33344..344abcb5d11 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -543,15 +543,7 @@ otherwise pop it") | |||
| 543 | (byte-defop 167 0 byte-numberp) | 543 | (byte-defop 167 0 byte-numberp) |
| 544 | (byte-defop 168 0 byte-integerp) | 544 | (byte-defop 168 0 byte-integerp) |
| 545 | 545 | ||
| 546 | ;; unused: 169 | 546 | ;; unused: 169-174 |
| 547 | |||
| 548 | ;; New to v19. These store their arg in the next byte. | ||
| 549 | (byte-defop 170 0 byte-rel-goto) | ||
| 550 | (byte-defop 171 -1 byte-rel-goto-if-nil) | ||
| 551 | (byte-defop 172 -1 byte-rel-goto-if-not-nil) | ||
| 552 | (byte-defop 173 -1 byte-rel-goto-if-nil-else-pop) | ||
| 553 | (byte-defop 174 -1 byte-rel-goto-if-not-nil-else-pop) | ||
| 554 | |||
| 555 | (byte-defop 175 nil byte-listN) | 547 | (byte-defop 175 nil byte-listN) |
| 556 | (byte-defop 176 nil byte-concatN) | 548 | (byte-defop 176 nil byte-concatN) |
| 557 | (byte-defop 177 nil byte-insertN) | 549 | (byte-defop 177 nil byte-insertN) |
| @@ -570,12 +562,6 @@ otherwise pop it") | |||
| 570 | 562 | ||
| 571 | (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) | 563 | (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil)) |
| 572 | 564 | ||
| 573 | (defconst byte-rel-goto-ops '(byte-rel-goto | ||
| 574 | byte-rel-goto-if-nil byte-rel-goto-if-not-nil | ||
| 575 | byte-rel-goto-if-nil-else-pop | ||
| 576 | byte-rel-goto-if-not-nil-else-pop) | ||
| 577 | "List of byte-codes for relative jumps.") | ||
| 578 | |||
| 579 | (byte-extrude-byte-code-vectors) | 565 | (byte-extrude-byte-code-vectors) |
| 580 | 566 | ||
| 581 | ;;; lapcode generator | 567 | ;;; lapcode generator |
| @@ -663,40 +649,11 @@ otherwise pop it") | |||
| 663 | (setq lap (cdr lap))) | 649 | (setq lap (cdr lap))) |
| 664 | ;;(if (not (= pc (length bytes))) | 650 | ;;(if (not (= pc (length bytes))) |
| 665 | ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) | 651 | ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) |
| 666 | (cond ((byte-compile-version-cond byte-compile-compatibility) | ||
| 667 | ;; Make relative jumps | ||
| 668 | (setq patchlist (nreverse patchlist)) | ||
| 669 | (while (progn | ||
| 670 | (setq off 0) ; PC change because of deleted bytes | ||
| 671 | (setq rest patchlist) | ||
| 672 | (while rest | ||
| 673 | (setq tmp (car rest)) | ||
| 674 | (and (consp (car tmp)) ; Jump | ||
| 675 | (prog1 (null (nth 1 tmp)) ; Absolute jump | ||
| 676 | (setq tmp (car tmp))) | ||
| 677 | (progn | ||
| 678 | (setq rel (- (car (cdr tmp)) (car tmp))) | ||
| 679 | (and (<= -129 rel) (< rel 128))) | ||
| 680 | (progn | ||
| 681 | ;; Convert to relative jump. | ||
| 682 | (setcdr (car rest) (cdr (cdr (car rest)))) | ||
| 683 | (setcar (cdr (car rest)) | ||
| 684 | (+ (car (cdr (car rest))) | ||
| 685 | (- byte-rel-goto byte-goto))) | ||
| 686 | (setq off (1- off)))) | ||
| 687 | (setcar tmp (+ (car tmp) off)) ; Adjust PC | ||
| 688 | (setq rest (cdr rest))) | ||
| 689 | ;; If optimizing, repeat until no change. | ||
| 690 | (and byte-optimize | ||
| 691 | (not (zerop off))))))) | ||
| 692 | ;; Patch PC into jumps | 652 | ;; Patch PC into jumps |
| 693 | (let (bytes) | 653 | (let (bytes) |
| 694 | (while patchlist | 654 | (while patchlist |
| 695 | (setq bytes (car patchlist)) | 655 | (setq bytes (car patchlist)) |
| 696 | (cond ((atom (car bytes))) ; Tag | 656 | (cond ((atom (car bytes))) ; Tag |
| 697 | ((nth 1 bytes) ; Relative jump | ||
| 698 | (setcar bytes (+ (- (car (cdr (car bytes))) (car (car bytes))) | ||
| 699 | 128))) | ||
| 700 | (t ; Absolute jump | 657 | (t ; Absolute jump |
| 701 | (setq pc (car (cdr (car bytes)))) ; Pick PC from tag | 658 | (setq pc (car (cdr (car bytes)))) ; Pick PC from tag |
| 702 | (setcar (cdr bytes) (logand pc 255)) | 659 | (setcar (cdr bytes) (logand pc 255)) |
diff --git a/src/fileio.c b/src/fileio.c index 95e570a666d..9910fa3858a 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -157,7 +157,7 @@ find_file_handler (filename) | |||
| 157 | Lisp_Object filename; | 157 | Lisp_Object filename; |
| 158 | { | 158 | { |
| 159 | Lisp_Object chain; | 159 | Lisp_Object chain; |
| 160 | for (chain = Vfile_handler_alist; XTYPE (chain) == Lisp_Cons; | 160 | for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; |
| 161 | chain = XCONS (chain)->cdr) | 161 | chain = XCONS (chain)->cdr) |
| 162 | { | 162 | { |
| 163 | Lisp_Object elt; | 163 | Lisp_Object elt; |
| @@ -1705,7 +1705,7 @@ This happens for interactive use with M-x.") | |||
| 1705 | call the corresponding file handler. */ | 1705 | call the corresponding file handler. */ |
| 1706 | handler = find_file_handler (filename); | 1706 | handler = find_file_handler (filename); |
| 1707 | if (!NILP (handler)) | 1707 | if (!NILP (handler)) |
| 1708 | return call3 (handler, Qmake_symbolic_link, filename, newname); | 1708 | return call3 (handler, Qmake_symbolic_link, filename, linkname); |
| 1709 | 1709 | ||
| 1710 | if (NILP (ok_if_already_exists) | 1710 | if (NILP (ok_if_already_exists) |
| 1711 | || XTYPE (ok_if_already_exists) == Lisp_Int) | 1711 | || XTYPE (ok_if_already_exists) == Lisp_Int) |
| @@ -2336,6 +2336,7 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 2336 | #ifdef VMS | 2336 | #ifdef VMS |
| 2337 | unsigned char *fname = 0; /* If non-0, original filename (must rename) */ | 2337 | unsigned char *fname = 0; /* If non-0, original filename (must rename) */ |
| 2338 | #endif /* VMS */ | 2338 | #endif /* VMS */ |
| 2339 | Lisp_Object handler; | ||
| 2339 | 2340 | ||
| 2340 | /* Special kludge to simplify auto-saving */ | 2341 | /* Special kludge to simplify auto-saving */ |
| 2341 | if (NILP (start)) | 2342 | if (NILP (start)) |
| @@ -2352,6 +2353,7 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 2352 | /* If the file name has special constructs in it, | 2353 | /* If the file name has special constructs in it, |
| 2353 | call the corresponding file handler. */ | 2354 | call the corresponding file handler. */ |
| 2354 | handler = find_file_handler (filename); | 2355 | handler = find_file_handler (filename); |
| 2356 | |||
| 2355 | if (!NILP (handler)) | 2357 | if (!NILP (handler)) |
| 2356 | { | 2358 | { |
| 2357 | Lisp_Object args[7]; | 2359 | Lisp_Object args[7]; |
| @@ -2641,9 +2643,9 @@ This means that the file has not been changed since it was visited or saved.") | |||
| 2641 | 2643 | ||
| 2642 | /* If the file name has special constructs in it, | 2644 | /* If the file name has special constructs in it, |
| 2643 | call the corresponding file handler. */ | 2645 | call the corresponding file handler. */ |
| 2644 | handler = find_file_handler (filename); | 2646 | handler = find_file_handler (b->filename); |
| 2645 | if (!NILP (handler)) | 2647 | if (!NILP (handler)) |
| 2646 | return call2 (handler, Qverify_visited_file_modtime, filename); | 2648 | return call2 (handler, Qverify_visited_file_modtime, b->filename); |
| 2647 | 2649 | ||
| 2648 | if (stat (XSTRING (b->filename)->data, &st) < 0) | 2650 | if (stat (XSTRING (b->filename)->data, &st) < 0) |
| 2649 | { | 2651 | { |
| @@ -2682,6 +2684,7 @@ or if the file itself has been changed for some known benign reason.") | |||
| 2682 | { | 2684 | { |
| 2683 | register Lisp_Object filename; | 2685 | register Lisp_Object filename; |
| 2684 | struct stat st; | 2686 | struct stat st; |
| 2687 | Lisp_Object handler; | ||
| 2685 | 2688 | ||
| 2686 | filename = Fexpand_file_name (current_buffer->filename, Qnil); | 2689 | filename = Fexpand_file_name (current_buffer->filename, Qnil); |
| 2687 | 2690 | ||