Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 371:cc15677e0335 r21-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents a4f53d9b3154
children 6240c7796c7a
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
1 ;;; bytecomp.el --- compilation of Lisp code into byte code. 1 ;;; bytecomp.el --- compilation of Lisp code into byte code.
2 2
3 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc. 3 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
4 ;;; Copyright (C) 1996 Ben Wing. 4 ;;; Copyright (C) 1996 Ben Wing.
5 5
6 ;; Authors: Jamie Zawinski <jwz@jwz.org> 6 ;; Author: Jamie Zawinski <jwz@netscape.com>
7 ;; Hallvard Furuseth <hbf@ulrik.uio.no> 7 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
8 ;; Ben Wing <ben@xemacs.org> 8 ;; Keywords: internal
9 ;; Martin Buchholz <martin@xemacs.org> 9
10 ;; Richard Stallman <rms@gnu.org> 10 ;; Subsequently modified by RMS and others.
11 ;; Keywords: internal lisp 11
12 12 (defconst byte-compile-version (purecopy "2.25 XEmacs; 22-Mar-96."))
13 (defconst byte-compile-version (purecopy "2.27 XEmacs; 2000-09-12."))
14 13
15 ;; This file is part of XEmacs. 14 ;; This file is part of XEmacs.
16 15
17 ;; XEmacs is free software; you can redistribute it and/or modify it 16 ;; XEmacs is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by 17 ;; under the terms of the GNU General Public License as published by
32 ;;; Synched up with: FSF 19.30. 31 ;;; Synched up with: FSF 19.30.
33 32
34 ;;; Commentary: 33 ;;; Commentary:
35 34
36 ;; The Emacs Lisp byte compiler. This crunches lisp source into a 35 ;; The Emacs Lisp byte compiler. This crunches lisp source into a
37 ;; sort of p-code (`bytecode') which takes up less space and can be 36 ;; sort of p-code which takes up less space and can be interpreted
38 ;; interpreted faster. First, the source code forms are converted to 37 ;; faster. The user entry points are byte-compile-file,
39 ;; an intermediate form, `lapcode' [`LAP' == `Lisp Assembly Program']
40 ;; which is much easier to manipulate than bytecode. Then the lapcode
41 ;; is converted to bytecode, which can be considered to be actual
42 ;; machine language. Optimizations can occur at either the source
43 ;; level or the lapcode level.
44
45 ;; The user entry points are byte-compile-file,
46 ;; byte-recompile-directory and byte-compile-buffer. 38 ;; byte-recompile-directory and byte-compile-buffer.
47 39
48 ;;; Code: 40 ;;; Code:
49 41
50 ;;; ======================================================================== 42 ;;; ========================================================================
2012 (if (stringp (nth 3 form)) 2004 (if (stringp (nth 3 form))
2013 form 2005 form
2014 ;; No doc string, so we can compile this as a normal form. 2006 ;; No doc string, so we can compile this as a normal form.
2015 (byte-compile-keep-pending form 'byte-compile-normal-call))) 2007 (byte-compile-keep-pending form 'byte-compile-normal-call)))
2016 2008
2017 (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst) 2009 (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
2018 (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst) 2010 (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
2019 (defun byte-compile-file-form-defvar-or-defconst (form) 2011 (defun byte-compile-file-form-defvar (form)
2020 ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
2021 (if (> (length form) 4) 2012 (if (> (length form) 4)
2022 (byte-compile-warn 2013 (byte-compile-warn "%s used with too many args (%s)"
2023 "%s %s called with %d arguments, but accepts only %s" 2014 (car form) (nth 1 form)))
2024 (car form) (nth 1 form) (length (cdr form)) 3))
2025 (if (and (> (length form) 3) (not (stringp (nth 3 form)))) 2015 (if (and (> (length form) 3) (not (stringp (nth 3 form))))
2026 (byte-compile-warn "Third arg to %s %s is not a string: %s" 2016 (byte-compile-warn "Third arg to %s %s is not a string: %s"
2027 (car form) (nth 1 form) (nth 3 form))) 2017 (car form) (nth 1 form) (nth 3 form)))
2028 (if (null (nth 3 form)) 2018 (if (null (nth 3 form))
2029 ;; Since there is no doc string, we can compile this as a normal form, 2019 ;; Since there is no doc string, we can compile this as a normal form,
2844 (put 'byte-concat3 'byte-opcode-invert 'concat) 2834 (put 'byte-concat3 'byte-opcode-invert 'concat)
2845 (put 'byte-concat4 'byte-opcode-invert 'concat) 2835 (put 'byte-concat4 'byte-opcode-invert 'concat)
2846 (put 'byte-concatN 'byte-opcode-invert 'concat) 2836 (put 'byte-concatN 'byte-opcode-invert 'concat)
2847 (put 'byte-insertN 'byte-opcode-invert 'insert) 2837 (put 'byte-insertN 'byte-opcode-invert 'insert)
2848 2838
2849 (byte-defop-compiler (dot byte-point) 0+1) 2839 ;; How old is this stuff? -slb
2850 (byte-defop-compiler (dot-max byte-point-max) 0+1) 2840 ;(byte-defop-compiler (dot byte-point) 0+1)
2851 (byte-defop-compiler (dot-min byte-point-min) 0+1) 2841 ;(byte-defop-compiler (dot-max byte-point-max) 0+1)
2842 ;(byte-defop-compiler (dot-min byte-point-min) 0+1)
2852 (byte-defop-compiler point 0+1) 2843 (byte-defop-compiler point 0+1)
2853 (byte-defop-compiler-rmsfun eq 2) 2844 (byte-defop-compiler-rmsfun eq 2)
2854 (byte-defop-compiler point-max 0+1) 2845 (byte-defop-compiler point-max 0+1)
2855 (byte-defop-compiler point-min 0+1) 2846 (byte-defop-compiler point-min 0+1)
2856 (byte-defop-compiler following-char 0+1) 2847 (byte-defop-compiler following-char 0+1)
3136 (defun byte-compile-buffer-substring (form) 3127 (defun byte-compile-buffer-substring (form)
3137 (let ((len (length form))) 3128 (let ((len (length form)))
3138 ;; buffer-substring used to take exactly two args, but now takes 0-3. 3129 ;; buffer-substring used to take exactly two args, but now takes 0-3.
3139 ;; convert 0-2 to two args and use special bytecode operand. 3130 ;; convert 0-2 to two args and use special bytecode operand.
3140 ;; convert 3 args to a normal call. 3131 ;; convert 3 args to a normal call.
3141 (cond ((= len 1) (byte-compile-two-args (append form '(nil nil)))) 3132 (cond ((= len 1) (setq form (append form '(nil nil)))
3142 ((= len 2) (byte-compile-two-args (append form '(nil)))) 3133 (= len 2) (setq form (append form '(nil)))))
3143 ((= len 3) (byte-compile-two-args form)) 3134 (cond ((= len 3) (byte-compile-two-args form))
3144 ((= len 4) (byte-compile-normal-call form)) 3135 ((= len 4) (byte-compile-normal-call form))
3145 (t (byte-compile-subr-wrong-args form "0-3"))))) 3136 (t (byte-compile-subr-wrong-args form "0-3")))))
3146 3137
3147 (defun byte-compile-list (form) 3138 (defun byte-compile-list (form)
3148 (let ((count (length (cdr form)))) 3139 (let ((count (length (cdr form))))
3712 ;;; top-level forms elsewhere 3703 ;;; top-level forms elsewhere
3713 3704
3714 (byte-defop-compiler-1 defun) 3705 (byte-defop-compiler-1 defun)
3715 (byte-defop-compiler-1 defmacro) 3706 (byte-defop-compiler-1 defmacro)
3716 (byte-defop-compiler-1 defvar) 3707 (byte-defop-compiler-1 defvar)
3717 (byte-defop-compiler-1 defvar byte-compile-defvar-or-defconst) 3708 (byte-defop-compiler-1 defconst byte-compile-defvar)
3718 (byte-defop-compiler-1 defconst byte-compile-defvar-or-defconst)
3719 (byte-defop-compiler-1 autoload) 3709 (byte-defop-compiler-1 autoload)
3720 ;; According to Mly this can go now that lambda is a macro 3710 ;; According to Mly this can go now that lambda is a macro
3721 ;(byte-defop-compiler-1 lambda byte-compile-lambda-form) 3711 ;(byte-defop-compiler-1 lambda byte-compile-lambda-form)
3722 (byte-defop-compiler-1 defalias) 3712 (byte-defop-compiler-1 defalias)
3723 (byte-defop-compiler-1 define-function) 3713 (byte-defop-compiler-1 define-function)
3741 (if (eq (car-safe code) 'make-byte-code) 3731 (if (eq (car-safe code) 'make-byte-code)
3742 (list 'cons ''macro code) 3732 (list 'cons ''macro code)
3743 (list 'quote (cons 'macro (eval code)))))) 3733 (list 'quote (cons 'macro (eval code))))))
3744 (list 'quote (nth 1 form))))) 3734 (list 'quote (nth 1 form)))))
3745 3735
3746 (defun byte-compile-defvar-or-defconst (form) 3736 (defun byte-compile-defvar (form)
3747 ;; This is not used for file-level defvar/defconsts with doc strings: 3737 ;; This is not used for file-level defvar/consts with doc strings:
3748 ;; byte-compile-file-form-defvar-or-defconst will be used in that case. 3738 ;; byte-compile-file-form-defvar will be used in that case.
3749 ;; (defvar|defconst VAR [VALUE [DOCSTRING]]) 3739 (let ((var (nth 1 form))
3750 (let ((fun (nth 0 form))
3751 (var (nth 1 form))
3752 (value (nth 2 form)) 3740 (value (nth 2 form))
3753 (string (nth 3 form))) 3741 (string (nth 3 form)))
3754 (when (> (length form) 4) 3742 (if (> (length form) 4)
3755 (byte-compile-warn 3743 (byte-compile-warn "%s used with too many args" (car form)))
3756 "%s %s called with %d arguments, but accepts only %s" 3744 (if (memq 'free-vars byte-compile-warnings)
3757 fun var (length (cdr form)) 3)) 3745 (setq byte-compile-bound-variables
3758 (when (memq 'free-vars byte-compile-warnings) 3746 (cons (cons var byte-compile-global-bit)
3759 (push (cons var byte-compile-global-bit) byte-compile-bound-variables)) 3747 byte-compile-bound-variables)))
3760 (byte-compile-body-do-effect 3748 (byte-compile-body-do-effect
3761 (list 3749 (list (if (cdr (cdr form))
3750 (if (eq (car form) 'defconst)
3751 (list 'setq var value)
3752 (list 'or (list 'boundp (list 'quote var))
3753 (list 'setq var value))))
3762 ;; Put the defined variable in this library's load-history entry 3754 ;; Put the defined variable in this library's load-history entry
3763 ;; just as a real defvar would, but only in top-level forms. 3755 ;; just as a real defvar would.
3764 (when (null byte-compile-current-form) 3756 (list 'setq 'current-load-list
3765 `(push ',var current-load-list)) 3757 (list 'cons (list 'quote var)
3766 (when (> (length form) 3) 3758 'current-load-list))
3767 (when (and string (not (stringp string))) 3759 (if string
3768 (byte-compile-warn "Third arg to %s %s is not a string: %s" 3760 (list 'put (list 'quote var) ''variable-documentation string))
3769 fun var string)) 3761 (list 'quote var)))))
3770 `(put ',var 'variable-documentation ,string))
3771 (if (cdr (cdr form)) ; `value' provided
3772 (if (eq fun 'defconst)
3773 ;; `defconst' sets `var' unconditionally.
3774 `(setq ,var ,value)
3775 ;; `defvar' sets `var' only when unbound.
3776 `(if (not (boundp ',var)) (setq ,var ,value))))
3777 `',var))))
3778 3762
3779 (defun byte-compile-autoload (form) 3763 (defun byte-compile-autoload (form)
3780 (and (byte-compile-constp (nth 1 form)) 3764 (and (byte-compile-constp (nth 1 form))
3781 (byte-compile-constp (nth 5 form)) 3765 (byte-compile-constp (nth 5 form))
3782 (memq (eval (nth 5 form)) '(t macro)) ; macro-p 3766 (memq (eval (nth 5 form)) '(t macro)) ; macro-p