;;; 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>
+;; Richard Stallman <rms@gnu.org>
+;; Keywords: internal lisp
-;; Subsequently modified by RMS and others.
-
-(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.
;;; 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:
(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)
(point-max byte-compile-log-buffer))))
(unwind-protect
- (condition-case error-info
- (progn ,@body)
- (error
- (byte-compile-report-error error-info)))
-
+ (call-with-condition-handler
+ #'(lambda (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
;; 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)))
(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)
(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))))
- ;; 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)))))
+ (list
+ ;; Put the defined variable in this library's load-history entry
+ ;; 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))
projects / chise / xemacs-chise.git.1 / blobdiff