xemacs-beta: lisp/bytecomp.el comparison

comparison lisp/bytecomp.el @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 ;;; bytecomp.el --- compilation of Lisp code into byte code.
 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
 ;;; Copyright (C) 1996 Ben Wing.
-;; Author: Jamie Zawinski <jwz@jwz.org>
+;; Authors: Jamie Zawinski <jwz@jwz.org>
 ;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
+;;	Ben Wing <ben@xemacs.org>
+;;	Martin Buchholz <martin@xemacs.org>
-;; Subsequently modified by RMS and others.
+;;	Richard Stallman <rms@gnu.org>
+;; Keywords: internal lisp
-(defconst byte-compile-version (purecopy  "2.26 XEmacs; 1998-10-07."))
+(defconst byte-compile-version (purecopy  "2.27 XEmacs; 2000-09-12."))
 ;; This file is part of XEmacs.
 ;; XEmacs is free software; you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by
 ;;; Synched up with: FSF 19.30.
 ;;; 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
+;; sort of p-code (`bytecode') which takes up less space and can be
-;; faster.  The user entry points are byte-compile-file,
+;; 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:
 ;;; ========================================================================
 (setq byte-compiler-error-flag t)
 (byte-compile-log-1
 (concat "!! "
 	   (format (if (cdr error-info) "%s (%s)" "%s")
 		   (get (car error-info) 'error-message)
-		   (prin1-to-string (cdr error-info))))))
+		   (prin1-to-string (cdr error-info)))))
+(if stack-trace-on-error
+(backtrace nil t)))
 ;;; Used by make-obsolete.
 (defun byte-compile-obsolete (form)
 (let ((new (get (car form) 'byte-obsolete-info)))
 (if (memq 'obsolete byte-compile-warnings)
 	    (if (boundp 'byte-compile-warnings-beginning)
 		byte-compile-warnings-beginning
 	      (point-max byte-compile-log-buffer))))
 (unwind-protect
-	   (condition-case error-info
+	   (call-with-condition-handler
-	       (progn ,@body)
+	       #'(lambda (error-info)
-	     (error
+		   (byte-compile-report-error error-info))
-	      (byte-compile-report-error error-info)))
+	       #'(lambda ()
+		   (progn ,@body)))
 	 ;; Always set point in log to start of interesting output.
 	 (with-current-buffer byte-compile-log-buffer
 	   (let ((show-begin
 		  (progn (goto-char byte-compile-point-max-prev)
 			 (skip-chars-forward "\^L\n")
 ;;;###autoload
 (defun byte-force-recompile (directory)
 "Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
 Files in subdirectories of DIRECTORY are processed also."
 (interactive "DByte force recompile (directory): ")
-(byte-recompile-directory directory nil t))
+(byte-recompile-directory directory nil nil t))
 ;;;###autoload
 (defun byte-recompile-directory (directory &optional arg norecursion force)
 "Recompile every `.el' file in DIRECTORY that needs recompilation.
 This is if a `.elc' file exists but is older than the `.el' file.
 (if (stringp (nth 3 form))
 form
 ;; 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 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
-(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
+(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
-(defun byte-compile-file-form-defvar (form)
+(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)"
+(byte-compile-warn
-			 (car form) (nth 1 form)))
+"%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)))
 (if (null (nth 3 form))
 ;; Since there is no doc string, we can compile this as a normal form,
 ;;; top-level forms elsewhere
 (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)
 (byte-defop-compiler-1 defalias)
 (byte-defop-compiler-1 define-function)
 		 (if (eq (car-safe code) 'make-byte-code)
 		     (list 'cons ''macro code)
 		   (list 'quote (cons 'macro (eval code))))))
 	 (list 'quote (nth 1 form)))))
-(defun byte-compile-defvar (form)
+(defun byte-compile-defvar-or-defconst (form)
-;; This is not used for file-level defvar/consts with doc strings:
+;; This is not used for file-level defvar/defconsts with doc strings:
-;; byte-compile-file-form-defvar will be used in that case.
+;; byte-compile-file-form-defvar-or-defconst will be used in that case.
-(let ((var (nth 1 form))
+;; (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)
+(when (> (length form) 4)
-	(byte-compile-warn "%s used with too many args" (car form)))
+(byte-compile-warn
-(if (memq 'free-vars byte-compile-warnings)
+"%s %s called with %d arguments, but accepts only %s"
-	(setq byte-compile-bound-variables
+fun var (length (cdr form)) 3))
-	      (cons (cons var byte-compile-global-bit)
+(when (memq 'free-vars byte-compile-warnings)
-		    byte-compile-bound-variables)))
+(push (cons var byte-compile-global-bit) byte-compile-bound-variables))
 (byte-compile-body-do-effect
-(list (if (cdr (cdr form))
+(list
-	       (if (eq (car form) 'defconst)
+;; Put the defined variable in this library's load-history entry
-		   (list 'setq var value)
+;; just as a real defvar would, but only in top-level forms.
-		 (list 'or (list 'boundp (list 'quote var))
+(when (null byte-compile-current-form)
-		       (list 'setq var value))))
+	`(push ',var current-load-list))
-	   ;; Put the defined variable in this library's load-history entry
+(when (> (length form) 3)
-	   ;; just as a real defvar would.
+	(when (and string (not (stringp string)))
-	   (list 'setq 'current-load-list
+	  (byte-compile-warn "Third arg to %s %s is not a string: %s"
-		 (list 'cons (list 'quote var)
+			     fun var string))
-		       'current-load-list))
+	`(put ',var 'variable-documentation ,string))
-	   (if string
+(if (cdr (cdr form))		; `value' provided
-	       (list 'put (list 'quote var) ''variable-documentation string))
+	  (if (eq fun 'defconst)
-	   (list 'quote var)))))
+	      ;; `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))
 (byte-compile-constp (nth 5 form))
 (memq (eval (nth 5 form)) '(t macro))  ; macro-p
 (defvar command-line-args-left)	;Avoid 'free variable' warning
 (if (not noninteractive)
 (error "`batch-byte-compile' is to be used only with -batch"))
 (let ((error nil))
 (while command-line-args-left
-(if (file-directory-p (expand-file-name (car command-line-args-left)))
+(if (null (batch-byte-compile-one-file))
-	  (let ((files (directory-files (car command-line-args-left)))
+	  (setq error t)))
-		source dest)
-	    (while files
-	      (if (and (string-match emacs-lisp-file-regexp (car files))
-		       (not (auto-save-file-name-p (car files)))
-		       (setq source (expand-file-name
-				     (car files)
-				     (car command-line-args-left)))
-		       (setq dest (byte-compile-dest-file source))
-		       (file-exists-p dest)
-		       (file-newer-than-file-p source dest))
-		  (if (null (batch-byte-compile-1 source))
-		      (setq error t)))
-	      (setq files (cdr files))))
-	(if (null (batch-byte-compile-1 (car command-line-args-left)))
-	    (setq error t)))
-(setq command-line-args-left (cdr command-line-args-left)))
 (message "Done")
 (kill-emacs (if error 1 0))))
+;;;###autoload
+(defun batch-byte-compile-one-file ()
+"Run `byte-compile-file' on a single file remaining on the command line.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs."
+;; command-line-args-left is what is left of the command line (from
+;; startup.el)
+(defvar command-line-args-left)	;Avoid 'free variable' warning
+(if (not noninteractive)
+(error "`batch-byte-compile-one-file' is to be used only with -batch"))
+(let (error
+	(file-to-process (car command-line-args-left)))
+(setq command-line-args-left (cdr command-line-args-left))
+(if (file-directory-p (expand-file-name file-to-process))
+	(let ((files (directory-files file-to-process))
+	      source dest)
+	  (while files
+	    (if (and (string-match emacs-lisp-file-regexp (car files))
+		     (not (auto-save-file-name-p (car files)))
+		     (setq source (expand-file-name
+				   (car files)
+				   file-to-process))
+		     (setq dest (byte-compile-dest-file source))
+		     (file-exists-p dest)
+		     (file-newer-than-file-p source dest))
+		(if (null (batch-byte-compile-1 source))
+		    (setq error t)))
+	    (setq files (cdr files)))
+	  (null error))
+(batch-byte-compile-1 file-to-process))))
 (defun batch-byte-compile-1 (file)
 (condition-case err
 (progn (byte-compile-file file) t)
 (error

Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 442:abe6d1db359e r21-2-36