Mercurial > emacs
changeset 848:58d3ed08f776
*** empty log message ***
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Wed, 22 Jul 1992 16:55:01 +0000 |
| parents | 8d43bfe19803 |
| children | c7b49118e101 |
| files | lisp/emacs-lisp/byte-opt.el lisp/emacs-lisp/bytecomp.el src/fileio.c |
| diffstat | 3 files changed, 41 insertions(+), 76 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/emacs-lisp/byte-opt.el Wed Jul 22 16:15:36 1992 +0000 +++ b/lisp/emacs-lisp/byte-opt.el Wed Jul 22 16:55:01 1992 +0000 @@ -1,12 +1,16 @@ -;;; 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 @@ byte-optimize-form-code-walker byte-optimize-lapcode)))) nil) + +;;; byte-opt.el ends here
--- a/lisp/emacs-lisp/bytecomp.el Wed Jul 22 16:15:36 1992 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Wed Jul 22 16:55:01 1992 +0000 @@ -543,15 +543,7 @@ (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 @@ (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 @@ (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))
--- a/src/fileio.c Wed Jul 22 16:15:36 1992 +0000 +++ b/src/fileio.c Wed Jul 22 16:55:01 1992 +0000 @@ -157,7 +157,7 @@ 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 @@ 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 @@ #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 @@ /* 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 @@ /* 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 @@ { register Lisp_Object filename; struct stat st; + Lisp_Object handler; filename = Fexpand_file_name (current_buffer->filename, Qnil);