Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-13
author cvs
date Mon, 13 Aug 2007 11:01:07 +0200
parents 182f72e8cd0d
children cc15677e0335
comparison
equal deleted inserted replaced
366:83d76f480a59 367:a4f53d9b3154
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 ;; Author: Jamie Zawinski <jwz@netscape.com> 6 ;; Authors: Jamie Zawinski <jwz@jwz.org>
7 ;; Hallvard Furuseth <hbf@ulrik.uio.no> 7 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
8 ;; Keywords: internal 8 ;; Ben Wing <ben@xemacs.org>
9 9 ;; Martin Buchholz <martin@xemacs.org>
10 ;; Subsequently modified by RMS and others. 10 ;; Richard Stallman <rms@gnu.org>
11 11 ;; Keywords: internal lisp
12 (defconst byte-compile-version (purecopy "2.25 XEmacs; 22-Mar-96.")) 12
13 (defconst byte-compile-version (purecopy "2.27 XEmacs; 2000-09-12."))
13 14
14 ;; This file is part of XEmacs. 15 ;; This file is part of XEmacs.
15 16
16 ;; XEmacs is free software; you can redistribute it and/or modify it 17 ;; XEmacs is free software; you can redistribute it and/or modify it
17 ;; under the terms of the GNU General Public License as published by 18 ;; under the terms of the GNU General Public License as published by
31 ;;; Synched up with: FSF 19.30. 32 ;;; Synched up with: FSF 19.30.
32 33
33 ;;; Commentary: 34 ;;; Commentary:
34 35
35 ;; The Emacs Lisp byte compiler. This crunches lisp source into a 36 ;; The Emacs Lisp byte compiler. This crunches lisp source into a
36 ;; sort of p-code which takes up less space and can be interpreted 37 ;; sort of p-code (`bytecode') which takes up less space and can be
37 ;; faster. The user entry points are byte-compile-file, 38 ;; interpreted faster. First, the source code forms are converted to
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,
38 ;; byte-recompile-directory and byte-compile-buffer. 46 ;; byte-recompile-directory and byte-compile-buffer.
39 47
40 ;;; Code: 48 ;;; Code:
41 49
42 ;;; ======================================================================== 50 ;;; ========================================================================
2004 (if (stringp (nth 3 form)) 2012 (if (stringp (nth 3 form))
2005 form 2013 form
2006 ;; No doc string, so we can compile this as a normal form. 2014 ;; No doc string, so we can compile this as a normal form.
2007 (byte-compile-keep-pending form 'byte-compile-normal-call))) 2015 (byte-compile-keep-pending form 'byte-compile-normal-call)))
2008 2016
2009 (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) 2017 (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
2010 (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) 2018 (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar-or-defconst)
2011 (defun byte-compile-file-form-defvar (form) 2019 (defun byte-compile-file-form-defvar-or-defconst (form)
2020 ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
2012 (if (> (length form) 4) 2021 (if (> (length form) 4)
2013 (byte-compile-warn "%s used with too many args (%s)" 2022 (byte-compile-warn
2014 (car form) (nth 1 form))) 2023 "%s %s called with %d arguments, but accepts only %s"
2024 (car form) (nth 1 form) (length (cdr form)) 3))
2015 (if (and (> (length form) 3) (not (stringp (nth 3 form)))) 2025 (if (and (> (length form) 3) (not (stringp (nth 3 form))))
2016 (byte-compile-warn "Third arg to %s %s is not a string: %s" 2026 (byte-compile-warn "Third arg to %s %s is not a string: %s"
2017 (car form) (nth 1 form) (nth 3 form))) 2027 (car form) (nth 1 form) (nth 3 form)))
2018 (if (null (nth 3 form)) 2028 (if (null (nth 3 form))
2019 ;; Since there is no doc string, we can compile this as a normal form, 2029 ;; Since there is no doc string, we can compile this as a normal form,
3702 ;;; top-level forms elsewhere 3712 ;;; top-level forms elsewhere
3703 3713
3704 (byte-defop-compiler-1 defun) 3714 (byte-defop-compiler-1 defun)
3705 (byte-defop-compiler-1 defmacro) 3715 (byte-defop-compiler-1 defmacro)
3706 (byte-defop-compiler-1 defvar) 3716 (byte-defop-compiler-1 defvar)
3707 (byte-defop-compiler-1 defconst byte-compile-defvar) 3717 (byte-defop-compiler-1 defvar byte-compile-defvar-or-defconst)
3718 (byte-defop-compiler-1 defconst byte-compile-defvar-or-defconst)
3708 (byte-defop-compiler-1 autoload) 3719 (byte-defop-compiler-1 autoload)
3709 ;; According to Mly this can go now that lambda is a macro 3720 ;; According to Mly this can go now that lambda is a macro
3710 ;(byte-defop-compiler-1 lambda byte-compile-lambda-form) 3721 ;(byte-defop-compiler-1 lambda byte-compile-lambda-form)
3711 (byte-defop-compiler-1 defalias) 3722 (byte-defop-compiler-1 defalias)
3712 (byte-defop-compiler-1 define-function) 3723 (byte-defop-compiler-1 define-function)
3730 (if (eq (car-safe code) 'make-byte-code) 3741 (if (eq (car-safe code) 'make-byte-code)
3731 (list 'cons ''macro code) 3742 (list 'cons ''macro code)
3732 (list 'quote (cons 'macro (eval code)))))) 3743 (list 'quote (cons 'macro (eval code))))))
3733 (list 'quote (nth 1 form))))) 3744 (list 'quote (nth 1 form)))))
3734 3745
3735 (defun byte-compile-defvar (form) 3746 (defun byte-compile-defvar-or-defconst (form)
3736 ;; This is not used for file-level defvar/consts with doc strings: 3747 ;; This is not used for file-level defvar/defconsts with doc strings:
3737 ;; byte-compile-file-form-defvar will be used in that case. 3748 ;; byte-compile-file-form-defvar-or-defconst will be used in that case.
3738 (let ((var (nth 1 form)) 3749 ;; (defvar|defconst VAR [VALUE [DOCSTRING]])
3750 (let ((fun (nth 0 form))
3751 (var (nth 1 form))
3739 (value (nth 2 form)) 3752 (value (nth 2 form))
3740 (string (nth 3 form))) 3753 (string (nth 3 form)))
3741 (if (> (length form) 4) 3754 (when (> (length form) 4)
3742 (byte-compile-warn "%s used with too many args" (car form))) 3755 (byte-compile-warn
3743 (if (memq 'free-vars byte-compile-warnings) 3756 "%s %s called with %d arguments, but accepts only %s"
3744 (setq byte-compile-bound-variables 3757 fun var (length (cdr form)) 3))
3745 (cons (cons var byte-compile-global-bit) 3758 (when (memq 'free-vars byte-compile-warnings)
3746 byte-compile-bound-variables))) 3759 (push (cons var byte-compile-global-bit) byte-compile-bound-variables))
3747 (byte-compile-body-do-effect 3760 (byte-compile-body-do-effect
3748 (list (if (cdr (cdr form)) 3761 (list
3749 (if (eq (car form) 'defconst)
3750 (list 'setq var value)
3751 (list 'or (list 'boundp (list 'quote var))
3752 (list 'setq var value))))
3753 ;; Put the defined variable in this library's load-history entry 3762 ;; Put the defined variable in this library's load-history entry
3754 ;; just as a real defvar would. 3763 ;; just as a real defvar would, but only in top-level forms.
3755 (list 'setq 'current-load-list 3764 (when (null byte-compile-current-form)
3756 (list 'cons (list 'quote var) 3765 `(push ',var current-load-list))
3757 'current-load-list)) 3766 (when (> (length form) 3)
3758 (if string 3767 (when (and string (not (stringp string)))
3759 (list 'put (list 'quote var) ''variable-documentation string)) 3768 (byte-compile-warn "Third arg to %s %s is not a string: %s"
3760 (list 'quote var))))) 3769 fun var string))
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))))
3761 3778
3762 (defun byte-compile-autoload (form) 3779 (defun byte-compile-autoload (form)
3763 (and (byte-compile-constp (nth 1 form)) 3780 (and (byte-compile-constp (nth 1 form))
3764 (byte-compile-constp (nth 5 form)) 3781 (byte-compile-constp (nth 5 form))
3765 (memq (eval (nth 5 form)) '(t macro)) ; macro-p 3782 (memq (eval (nth 5 form)) '(t macro)) ; macro-p