diff lisp/bytecomp.el @ 367:a4f53d9b3154 r21-1-13

Import from CVS: tag r21-1-13
author cvs
date Mon, 13 Aug 2007 11:01:07 +0200
parents 182f72e8cd0d
children cc15677e0335
line wrap: on
line diff
--- a/lisp/bytecomp.el	Mon Aug 13 11:00:13 2007 +0200
+++ b/lisp/bytecomp.el	Mon Aug 13 11:01:07 2007 +0200
@@ -3,13 +3,14 @@
 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
 ;;; Copyright (C) 1996 Ben Wing.
 
-;; Author: Jamie Zawinski <jwz@netscape.com>
-;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
-
-;; Subsequently modified by RMS and others.
-
-(defconst byte-compile-version (purecopy  "2.25 XEmacs; 22-Mar-96."))
+;; Authors: Jamie Zawinski <jwz@jwz.org>
+;;    Hallvard Furuseth <hbf@ulrik.uio.no>
+;;    Ben Wing <ben@xemacs.org>
+;;    Martin Buchholz <martin@xemacs.org>
+;;    Richard Stallman <rms@gnu.org>
+;; Keywords: internal lisp
+  
+(defconst byte-compile-version (purecopy  "2.27 XEmacs; 2000-09-12."))
 
 ;; This file is part of XEmacs.
 
@@ -33,8 +34,15 @@
 ;;; Commentary:
 
 ;; The Emacs Lisp byte compiler.  This crunches lisp source into a
-;; sort of p-code which takes up less space and can be interpreted
-;; faster.  The user entry points are byte-compile-file,
+;; sort of p-code (`bytecode') which takes up less space and can be
+;; interpreted faster.  First, the source code forms are converted to
+;; an intermediate form, `lapcode' [`LAP' == `Lisp Assembly Program']
+;; which is much easier to manipulate than bytecode.  Then the lapcode
+;; is converted to bytecode, which can be considered to be actual
+;; machine language.  Optimizations can occur at either the source
+;; level or the lapcode level.
+
+;; The user entry points are byte-compile-file,
 ;; byte-recompile-directory and byte-compile-buffer.
 
 ;;; Code:
@@ -2006,12 +2014,14 @@
     ;; No doc string, so we can compile this as a normal form.
     (byte-compile-keep-pending form 'byte-compile-normal-call)))
 
-(put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar)
-(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile-file-form-defvar (form)
+(put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
+(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
+(defun byte-compile-file-form-defvar-or-defconst (form)
+  ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
   (if (> (length form) 4)
-      (byte-compile-warn "%s used with too many args (%s)"
-			 (car form) (nth 1 form)))
+      (byte-compile-warn
+       "%s %s called with %d arguments, but accepts only %s"
+       (car form) (nth 1 form) (length (cdr form)) 3))
   (if (and (> (length form) 3) (not (stringp (nth 3 form))))
       (byte-compile-warn "Third arg to %s %s is not a string: %s"
 			 (car form) (nth 1 form) (nth 3 form)))
@@ -3704,7 +3714,8 @@
 (byte-defop-compiler-1 defun)
 (byte-defop-compiler-1 defmacro)
 (byte-defop-compiler-1 defvar)
-(byte-defop-compiler-1 defconst byte-compile-defvar)
+(byte-defop-compiler-1 defvar   byte-compile-defvar-or-defconst)
+(byte-defop-compiler-1 defconst byte-compile-defvar-or-defconst)
 (byte-defop-compiler-1 autoload)
 ;; According to Mly this can go now that lambda is a macro
 ;(byte-defop-compiler-1 lambda byte-compile-lambda-form)
@@ -3732,32 +3743,38 @@
 		   (list 'quote (cons 'macro (eval code))))))
 	 (list 'quote (nth 1 form)))))
 
-(defun byte-compile-defvar (form)
-  ;; This is not used for file-level defvar/consts with doc strings:
-  ;; byte-compile-file-form-defvar will be used in that case.
-  (let ((var (nth 1 form))
+(defun byte-compile-defvar-or-defconst (form)
+  ;; This is not used for file-level defvar/defconsts with doc strings:
+  ;; byte-compile-file-form-defvar-or-defconst will be used in that case.
+  ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
+  (let ((fun (nth 0 form))
+	(var (nth 1 form))
 	(value (nth 2 form))
 	(string (nth 3 form)))
-    (if (> (length form) 4)
-	(byte-compile-warn "%s used with too many args" (car form)))
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons (cons var byte-compile-global-bit)
-		    byte-compile-bound-variables)))
+    (when (> (length form) 4)
+      (byte-compile-warn
+       "%s %s called with %d arguments, but accepts only %s"
+       fun var (length (cdr form)) 3))
+    (when (memq 'free-vars byte-compile-warnings)
+      (push (cons var byte-compile-global-bit) byte-compile-bound-variables))
     (byte-compile-body-do-effect
-     (list (if (cdr (cdr form))
-	       (if (eq (car form) 'defconst)
-		   (list 'setq var value)
-		 (list 'or (list 'boundp (list 'quote var))
-		       (list 'setq var value))))
+     (list
 	   ;; Put the defined variable in this library's load-history entry
-	   ;; just as a real defvar would.
-	   (list 'setq 'current-load-list
-		 (list 'cons (list 'quote var)
-		       'current-load-list))
-	   (if string
-	       (list 'put (list 'quote var) ''variable-documentation string))
-	   (list 'quote var)))))
+      ;; just as a real defvar would, but only in top-level forms.
+      (when (null byte-compile-current-form)
+	`(push ',var current-load-list))
+      (when (> (length form) 3)
+	(when (and string (not (stringp string)))
+	  (byte-compile-warn "Third arg to %s %s is not a string: %s"
+			     fun var string))
+	`(put ',var 'variable-documentation ,string))
+      (if (cdr (cdr form))		; `value' provided
+	  (if (eq fun 'defconst)
+	      ;; `defconst' sets `var' unconditionally.
+	      `(setq ,var ,value)
+	    ;; `defvar' sets `var' only when unbound.
+	    `(if (not (boundp ',var)) (setq ,var ,value))))
+      `',var))))
 
 (defun byte-compile-autoload (form)
   (and (byte-compile-constp (nth 1 form))