Commit 3eac9910 authored by Jim Blandy's avatar Jim Blandy

*** empty log message ***

parent 434e6714
;;; The optimization passes of the emacs-lisp byte compiler.
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
;;; Copyright (c) 1991 Free Software Foundation, Inc.
;; By Jamie Zawinski <jwz@lucid.com> and Hallvard Furuseth <hbf@ulrik.uio.no>.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; Keywords: internal
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
......@@ -18,6 +22,8 @@
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;;; ========================================================================
;;; "No matter how hard you try, you can't make a racehorse out of a pig.
;;; you can, however, make a faster pig."
......@@ -69,13 +75,14 @@
;;; but beware of traps like
;;; (cons (list x y) (list x y))
;;;
;;; Tail-recursion elimination is not really possible in elisp. Tail-recursion
;;; elimination is almost always impossible when all variables have dynamic
;;; scope, but given that the "return" byteop requires the binding stack to be
;;; empty (rather than emptying it itself), there can be no truly tail-
;;; recursive elisp functions that take any arguments or make any bindings.
;;; Tail-recursion elimination is not really possible in Emacs Lisp.
;;; Tail-recursion elimination is almost always impossible when all variables
;;; have dynamic scope, but given that the "return" byteop requires the
;;; binding stack to be empty (rather than emptying it itself), there can be
;;; no truly tail-recursive Emacs Lisp functions that take any arguments or
;;; make any bindings.
;;;
;;; Here is an example of an elisp function which could safely be
;;; Here is an example of an Emacs Lisp function which could safely be
;;; byte-compiled tail-recursively:
;;;
;;; (defun tail-map (fn list)
......@@ -105,7 +112,7 @@
;;; overflow. I don't believe there is any way around this without lexical
;;; scope.
;;;
;;; Wouldn't it be nice if elisp had lexical scope.
;;; Wouldn't it be nice if Emacs Lisp had lexical scope.
;;;
;;; Idea: the form (lexical-scope) in a file means that the file may be
;;; compiled lexically. This proclamation is file-local. Then, within
......@@ -128,6 +135,7 @@
;;; the board, in the interpreter and compiler, and just FIX all of
;;; the code that relies on dynamic scope of non-defvarred variables.
;;; Code:
(defun byte-compile-log-lap-1 (format &rest args)
(if (aref byte-code-vector 0)
......@@ -1029,7 +1037,7 @@
(+ (aref bytes ptr)
(progn (setq ptr (1+ ptr))
(lsh (aref bytes ptr) 8))))
((and (>= op byte-rel-goto)
((and (>= op byte-listN)
(<= op byte-insertN))
(setq ptr (1+ ptr)) ;offset in next byte
(aref bytes ptr))))
......@@ -1060,13 +1068,7 @@
optr ptr
offset (disassemble-offset)) ; this does dynamic-scope magic
(setq op (aref byte-code-vector op))
(cond ((or (memq op byte-goto-ops)
(cond ((memq op byte-rel-goto-ops)
(setq op (aref byte-code-vector
(- (symbol-value op)
(- byte-rel-goto byte-goto))))
(setq offset (+ ptr (- offset 127)))
t)))
(cond ((memq op byte-goto-ops)
;; it's a pc
(setq offset
(cdr (or (assq offset tags)
......@@ -1176,16 +1178,17 @@
;;; the BOOL variables are, and not perform this optimization on them.
;;;
(defconst byte-boolean-vars
'(abbrevs-changed abbrev-all-caps inverse-video visible-bell
check-protected-fields no-redraw-on-reenter cursor-in-echo-area
noninteractive stack-trace-on-error debug-on-error debug-on-quit
debug-on-next-call insert-default-directory vms-stmlf-recfm
indent-tabs-mode meta-flag load-in-progress defining-kbd-macro
completion-auto-help completion-ignore-case enable-recursive-minibuffers
print-escape-newlines delete-exited-processes parse-sexp-ignore-comments
words-include-escapes pop-up-windows auto-new-screen
reset-terminal-on-clear truncate-partial-width-windows
mode-line-inverse-video)
'(abbrev-all-caps abbrevs-changed byte-metering-on
check-protected-fields completion-auto-help completion-ignore-case
cursor-in-echo-area debug-on-next-call debug-on-quit
defining-kbd-macro delete-exited-processes
enable-recursive-minibuffers indent-tabs-mode
insert-default-directory inverse-video load-in-progress
menu-prompting mode-line-inverse-video no-redraw-on-reenter
noninteractive parse-sexp-ignore-comments pop-up-frames
pop-up-windows print-escape-newlines print-escape-newlines
truncate-partial-width-windows visible-bell vms-stmlf-recfm
words-include-escapes x-save-under)
"DEFVAR_BOOL variables. Giving these any non-nil value sets them to t.
If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
may generate incorrect code.")
......@@ -1721,3 +1724,5 @@ may generate incorrect code.")
byte-optimize-form-code-walker
byte-optimize-lapcode))))
nil)
;;; byte-opt.el ends here
......@@ -543,15 +543,7 @@ otherwise pop it")
(byte-defop 167 0 byte-numberp)
(byte-defop 168 0 byte-integerp)
;; unused: 169
;; New to v19. These store their arg in the next byte.
(byte-defop 170 0 byte-rel-goto)
(byte-defop 171 -1 byte-rel-goto-if-nil)
(byte-defop 172 -1 byte-rel-goto-if-not-nil)
(byte-defop 173 -1 byte-rel-goto-if-nil-else-pop)
(byte-defop 174 -1 byte-rel-goto-if-not-nil-else-pop)
;; unused: 169-174
(byte-defop 175 nil byte-listN)
(byte-defop 176 nil byte-concatN)
(byte-defop 177 nil byte-insertN)
......@@ -570,12 +562,6 @@ otherwise pop it")
(defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
(defconst byte-rel-goto-ops '(byte-rel-goto
byte-rel-goto-if-nil byte-rel-goto-if-not-nil
byte-rel-goto-if-nil-else-pop
byte-rel-goto-if-not-nil-else-pop)
"List of byte-codes for relative jumps.")
(byte-extrude-byte-code-vectors)
;;; lapcode generator
......@@ -663,40 +649,11 @@ otherwise pop it")
(setq lap (cdr lap)))
;;(if (not (= pc (length bytes)))
;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
(cond ((byte-compile-version-cond byte-compile-compatibility)
;; Make relative jumps
(setq patchlist (nreverse patchlist))
(while (progn
(setq off 0) ; PC change because of deleted bytes
(setq rest patchlist)
(while rest
(setq tmp (car rest))
(and (consp (car tmp)) ; Jump
(prog1 (null (nth 1 tmp)) ; Absolute jump
(setq tmp (car tmp)))
(progn
(setq rel (- (car (cdr tmp)) (car tmp)))
(and (<= -129 rel) (< rel 128)))
(progn
;; Convert to relative jump.
(setcdr (car rest) (cdr (cdr (car rest))))
(setcar (cdr (car rest))
(+ (car (cdr (car rest)))
(- byte-rel-goto byte-goto)))
(setq off (1- off))))
(setcar tmp (+ (car tmp) off)) ; Adjust PC
(setq rest (cdr rest)))
;; If optimizing, repeat until no change.
(and byte-optimize
(not (zerop off)))))))
;; Patch PC into jumps
(let (bytes)
(while patchlist
(setq bytes (car patchlist))
(cond ((atom (car bytes))) ; Tag
((nth 1 bytes) ; Relative jump
(setcar bytes (+ (- (car (cdr (car bytes))) (car (car bytes)))
128)))
(t ; Absolute jump
(setq pc (car (cdr (car bytes)))) ; Pick PC from tag
(setcar (cdr bytes) (logand pc 255))
......
......@@ -157,7 +157,7 @@ find_file_handler (filename)
Lisp_Object filename;
{
Lisp_Object chain;
for (chain = Vfile_handler_alist; XTYPE (chain) == Lisp_Cons;
for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
chain = XCONS (chain)->cdr)
{
Lisp_Object elt;
......@@ -1705,7 +1705,7 @@ This happens for interactive use with M-x.")
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
return call3 (handler, Qmake_symbolic_link, filename, newname);
return call3 (handler, Qmake_symbolic_link, filename, linkname);
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
......@@ -2336,6 +2336,7 @@ to the file, instead of any buffer contents, and END is ignored.")
#ifdef VMS
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
#endif /* VMS */
Lisp_Object handler;
/* Special kludge to simplify auto-saving */
if (NILP (start))
......@@ -2352,6 +2353,7 @@ to the file, instead of any buffer contents, and END is ignored.")
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
if (!NILP (handler))
{
Lisp_Object args[7];
......@@ -2641,9 +2643,9 @@ This means that the file has not been changed since it was visited or saved.")
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = find_file_handler (filename);
handler = find_file_handler (b->filename);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, filename);
return call2 (handler, Qverify_visited_file_modtime, b->filename);
if (stat (XSTRING (b->filename)->data, &st) < 0)
{
......@@ -2682,6 +2684,7 @@ or if the file itself has been changed for some known benign reason.")
{
register Lisp_Object filename;
struct stat st;
Lisp_Object handler;
filename = Fexpand_file_name (current_buffer->filename, Qnil);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment