Mercurial > hg > xemacs-beta
diff lisp/bytecomp.el @ 371:cc15677e0335 r21-2b1
Import from CVS: tag r21-2b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:03:08 +0200 |
parents | a4f53d9b3154 |
children | 6240c7796c7a |
line wrap: on
line diff
--- a/lisp/bytecomp.el Mon Aug 13 11:01:58 2007 +0200 +++ b/lisp/bytecomp.el Mon Aug 13 11:03:08 2007 +0200 @@ -3,14 +3,13 @@ ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc. ;;; Copyright (C) 1996 Ben Wing. -;; 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.")) +;; 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.")) ;; This file is part of XEmacs. @@ -34,15 +33,8 @@ ;;; Commentary: ;; The Emacs Lisp byte compiler. This crunches lisp source into a -;; 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, +;; sort of p-code which takes up less space and can be interpreted +;; faster. The user entry points are byte-compile-file, ;; byte-recompile-directory and byte-compile-buffer. ;;; Code: @@ -2014,14 +2006,12 @@ ;; 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-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]]) +(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) (if (> (length form) 4) - (byte-compile-warn - "%s %s called with %d arguments, but accepts only %s" - (car form) (nth 1 form) (length (cdr form)) 3)) + (byte-compile-warn "%s used with too many args (%s)" + (car form) (nth 1 form))) (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))) @@ -2846,9 +2836,10 @@ (put 'byte-concatN 'byte-opcode-invert 'concat) (put 'byte-insertN 'byte-opcode-invert 'insert) -(byte-defop-compiler (dot byte-point) 0+1) -(byte-defop-compiler (dot-max byte-point-max) 0+1) -(byte-defop-compiler (dot-min byte-point-min) 0+1) +;; How old is this stuff? -slb +;(byte-defop-compiler (dot byte-point) 0+1) +;(byte-defop-compiler (dot-max byte-point-max) 0+1) +;(byte-defop-compiler (dot-min byte-point-min) 0+1) (byte-defop-compiler point 0+1) (byte-defop-compiler-rmsfun eq 2) (byte-defop-compiler point-max 0+1) @@ -3138,9 +3129,9 @@ ;; buffer-substring used to take exactly two args, but now takes 0-3. ;; convert 0-2 to two args and use special bytecode operand. ;; convert 3 args to a normal call. - (cond ((= len 1) (byte-compile-two-args (append form '(nil nil)))) - ((= len 2) (byte-compile-two-args (append form '(nil)))) - ((= len 3) (byte-compile-two-args form)) + (cond ((= len 1) (setq form (append form '(nil nil))) + (= len 2) (setq form (append form '(nil))))) + (cond ((= len 3) (byte-compile-two-args form)) ((= len 4) (byte-compile-normal-call form)) (t (byte-compile-subr-wrong-args form "0-3"))))) @@ -3714,8 +3705,7 @@ (byte-defop-compiler-1 defun) (byte-defop-compiler-1 defmacro) (byte-defop-compiler-1 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 defconst byte-compile-defvar) (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) @@ -3743,38 +3733,32 @@ (list 'quote (cons 'macro (eval code)))))) (list 'quote (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)) +(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)) (value (nth 2 form)) (string (nth 3 form))) - (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)) + (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))) (byte-compile-body-do-effect - (list + (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, 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)))) + ;; 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))))) (defun byte-compile-autoload (form) (and (byte-compile-constp (nth 1 form))