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);