Mercurial > emacs
comparison lisp/emacs-lisp/bytecomp.el @ 15954:57a05abfc723
(byte-compile-out-toplevel): Always compile to byte code
if an uninterned symbol appears.
(byte-compile-byte-code-maker): Handle uninterned symbols
in the constant vector.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Wed, 28 Aug 1996 22:40:09 +0000 |
| parents | 38a50022d610 |
| children | b741b3129c1b |
comparison
equal
deleted
inserted
replaced
| 15953:38a50022d610 | 15954:57a05abfc723 |
|---|---|
| 8 | 8 |
| 9 ;; Subsequently modified by RMS. | 9 ;; Subsequently modified by RMS. |
| 10 | 10 |
| 11 ;;; This version incorporates changes up to version 2.10 of the | 11 ;;; This version incorporates changes up to version 2.10 of the |
| 12 ;;; Zawinski-Furuseth compiler. | 12 ;;; Zawinski-Furuseth compiler. |
| 13 (defconst byte-compile-version "$Revision: 2.14 $") | 13 (defconst byte-compile-version "$Revision: 2.15 $") |
| 14 | 14 |
| 15 ;; This file is part of GNU Emacs. | 15 ;; This file is part of GNU Emacs. |
| 16 | 16 |
| 17 ;; GNU Emacs is free software; you can redistribute it and/or modify | 17 ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 18 ;; it under the terms of the GNU General Public License as published by | 18 ;; it under the terms of the GNU General Public License as published by |
| 1844 (list 'quote (byte-compile-byte-code-unmake fun))) | 1844 (list 'quote (byte-compile-byte-code-unmake fun))) |
| 1845 ;; ## atom is faster than compiled-func-p. | 1845 ;; ## atom is faster than compiled-func-p. |
| 1846 ((atom fun) ; compiled function. | 1846 ((atom fun) ; compiled function. |
| 1847 ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda | 1847 ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda |
| 1848 ;; would have produced a lambda. | 1848 ;; would have produced a lambda. |
| 1849 fun) | 1849 (let ((const-vector (aref fun 2)) |
| 1850 (i 0) | |
| 1851 (uninterned nil)) | |
| 1852 ;; Find all the uninterned symbols that appear | |
| 1853 ;; as constants in this function. | |
| 1854 (while (< i (length const-vector)) | |
| 1855 (and (symbolp (aref const-vector i)) | |
| 1856 (not (eq (aref const-vector i) | |
| 1857 (intern-soft (symbol-name (aref const-vector i))))) | |
| 1858 (setq uninterned (cons i uninterned))) | |
| 1859 (setq i (1+ i))) | |
| 1860 ;; Arrange to regenrate the uninterned symbols | |
| 1861 ;; when we read in this code to produce the compiled function. | |
| 1862 (if uninterned | |
| 1863 (let (modifiers) | |
| 1864 (while uninterned | |
| 1865 (let ((symbol (aref const-vector (car uninterned))) | |
| 1866 fixup) | |
| 1867 (setq fixup | |
| 1868 ;; Some uninterned symbols specify how to | |
| 1869 ;; regenerate them. | |
| 1870 (if (get symbol 'byte-compile-regenerate) | |
| 1871 `(aset const-vector ,(car uninterned) | |
| 1872 ,(get symbol 'byte-compile-regenerate)) | |
| 1873 `(aset const-vector ,(car uninterned) | |
| 1874 (make-symbol ',(symbol-name symbol))))) | |
| 1875 (setq modifiers (cons fixup modifiers))) | |
| 1876 (setq uninterned (cdr uninterned))) | |
| 1877 `(let* ((function ,fun) (const-vector (aref function 2))) | |
| 1878 ,@modifiers | |
| 1879 function)) | |
| 1880 fun))) | |
| 1850 ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial | 1881 ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial |
| 1851 ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. | 1882 ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. |
| 1852 ((let (tmp) | 1883 ((let (tmp) |
| 1853 (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) | 1884 (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) |
| 1854 (null (cdr (memq tmp fun)))) | 1885 (null (cdr (memq tmp fun)))) |
| 2055 (setq rest (nreverse | 2086 (setq rest (nreverse |
| 2056 (cdr (memq tmp (reverse byte-compile-output))))) | 2087 (cdr (memq tmp (reverse byte-compile-output))))) |
| 2057 (while (cond | 2088 (while (cond |
| 2058 ((memq (car (car rest)) '(byte-varref byte-constant)) | 2089 ((memq (car (car rest)) '(byte-varref byte-constant)) |
| 2059 (setq tmp (car (cdr (car rest)))) | 2090 (setq tmp (car (cdr (car rest)))) |
| 2060 (if (if (eq (car (car rest)) 'byte-constant) | 2091 ;; If we find an uninterned symbol as a constant |
| 2061 (or (consp tmp) | 2092 ;; or variable, this expression must be compiled! |
| 2062 (and (symbolp tmp) | 2093 ;; That is because byte-compile-byte-code-maker |
| 2063 (not (memq tmp '(nil t)))))) | 2094 ;; must get a chance to process the uninterned symbol. |
| 2064 (if maycall | 2095 (if (and (symbolp tmp) |
| 2065 (setq body (cons (list 'quote tmp) body))) | 2096 (not (eq tmp (intern-soft (symbol-name tmp))))) |
| 2066 (setq body (cons tmp body)))) | 2097 nil |
| 2098 (if (if (eq (car (car rest)) 'byte-constant) | |
| 2099 (or (consp tmp) | |
| 2100 (and (symbolp tmp) | |
| 2101 (not (memq tmp '(nil t)))))) | |
| 2102 (if maycall | |
| 2103 (setq body (cons (list 'quote tmp) body))) | |
| 2104 (setq body (cons tmp body))))) | |
| 2067 ((and maycall | 2105 ((and maycall |
| 2068 ;; Allow a funcall if at most one atom follows it. | 2106 ;; Allow a funcall if at most one atom follows it. |
| 2069 (null (nthcdr 3 rest)) | 2107 (null (nthcdr 3 rest)) |
| 2070 (setq tmp (get (car (car rest)) 'byte-opcode-invert)) | 2108 (setq tmp (get (car (car rest)) 'byte-opcode-invert)) |
| 2071 (or (null (cdr rest)) | 2109 (or (null (cdr rest)) |