aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1992-07-22 16:55:01 +0000
committerJim Blandy1992-07-22 16:55:01 +0000
commit3eac99106c84691923f004e3cd251c358c04276f (patch)
tree51e912b4cdbc50914538b71c3bf3fc72742eb0a4
parent434e6714820315c7e27ec615b0c9b8ab32435e7f (diff)
downloademacs-3eac99106c84691923f004e3cd251c358c04276f.tar.gz
emacs-3eac99106c84691923f004e3cd251c358c04276f.zip
*** empty log message ***
-rw-r--r--lisp/emacs-lisp/byte-opt.el61
-rw-r--r--lisp/emacs-lisp/bytecomp.el45
-rw-r--r--src/fileio.c11
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.
1190If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer 1193If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
1191may generate incorrect code.") 1194may 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