diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 138 |
1 files changed, 72 insertions, 66 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 771306bb0e6..6bc2b3b5617 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -794,10 +794,13 @@ CONST2 may be evaulated multiple times." ;; goto (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc) (push bytes patchlist)) - ((and (consp off) - ;; Variable or constant reference - (progn (setq off (cdr off)) - (eq op 'byte-constant))) + ((or (and (consp off) + ;; Variable or constant reference + (progn + (setq off (cdr off)) + (eq op 'byte-constant))) + (and (eq op 'byte-constant) ;; 'byte-closed-var + (integerp off))) ;; constant ref (if (< off byte-constant-limit) (byte-compile-push-bytecodes (+ byte-constant off) @@ -1480,6 +1483,7 @@ symbol itself." ((byte-compile-const-symbol-p ,form)))) (defmacro byte-compile-close-variables (&rest body) + (declare (debug t)) (cons 'let (cons '(;; ;; Close over these variables to encapsulate the @@ -1510,6 +1514,7 @@ symbol itself." body))) (defmacro displaying-byte-compile-warnings (&rest body) + (declare (debug t)) `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) (warning-series-started (and (markerp warning-series) @@ -1930,7 +1935,7 @@ With argument ARG, insert value in current buffer after the form." (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) - (byte-compile-file-form form))) + (byte-compile-toplevel-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) ;; Make warnings about unresolved functions @@ -2041,8 +2046,8 @@ Call from the source buffer." ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. - (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst autoload - custom-declare-variable)) + (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst + autoload custom-declare-variable)) (stringp (nth 3 form))) (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil (memq (car form) @@ -2182,12 +2187,17 @@ list that represents a doc string reference. byte-compile-maxdepth 0 byte-compile-output nil)))) -(defun byte-compile-file-form (form) - (let ((byte-compile-current-form nil) ; close over this for warnings. - bytecomp-handler) +;; byte-hunk-handlers cannot call this! +(defun byte-compile-toplevel-file-form (form) + (let ((byte-compile-current-form nil)) ; close over this for warnings. (setq form (macroexpand-all form byte-compile-macro-environment)) (if lexical-binding (setq form (cconv-closure-convert form))) + (byte-compile-file-form form))) + +;; byte-hunk-handlers can call this. +(defun byte-compile-file-form (form) + (let (bytecomp-handler) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) @@ -2541,7 +2551,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if lexical-binding (setq fun (cconv-closure-convert fun))) ;; Get rid of the `function' quote added by the `lambda' macro. - (setq fun (cadr fun)) + (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) (setq fun (if macro (cons 'macro (byte-compile-lambda fun)) (byte-compile-lambda fun))) @@ -2654,7 +2664,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; of the list FUN and `byte-compile-set-symbol-position' is not called. ;; Use this feature to avoid calling `byte-compile-set-symbol-position' ;; for symbols generated by the byte compiler itself. -(defun byte-compile-lambda (bytecomp-fun &optional add-lambda) +(defun byte-compile-lambda (bytecomp-fun &optional add-lambda reserved-csts) (if add-lambda (setq bytecomp-fun (cons 'lambda bytecomp-fun)) (unless (eq 'lambda (car-safe bytecomp-fun)) @@ -2702,14 +2712,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string bytecomp-int))))) ;; Process the body. - (let* ((byte-compile-lexical-environment - ;; If doing lexical binding, push a new lexical environment - ;; containing just the args (since lambda expressions - ;; should be closed by now). - (and lexical-binding - (byte-compile-make-lambda-lexenv bytecomp-fun))) - (compiled - (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda))) + (let* ((compiled + (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda + ;; If doing lexical binding, push a new + ;; lexical environment containing just the + ;; args (since lambda expressions should be + ;; closed by now). + (and lexical-binding + (byte-compile-make-lambda-lexenv + bytecomp-fun)) + reserved-csts))) ;; Build the actual byte-coded function. (if (eq 'byte-code (car-safe compiled)) (apply 'make-byte-code @@ -2740,6 +2752,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; A simple lambda is just a constant. (byte-compile-constant code))) +(defvar byte-compile-reserved-constants 0) + (defun byte-compile-constants-vector () ;; Builds the constants-vector from the current variables and constants. ;; This modifies the constants from (const . nil) to (const . offset). @@ -2748,7 +2762,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Next up to byte-constant-limit are constants, still with one-byte codes. ;; Next variables again, to get 2-byte codes for variable lookup. ;; The rest of the constants and variables need 3-byte byte-codes. - (let* ((i -1) + (let* ((i (1- byte-compile-reserved-constants)) (rest (nreverse byte-compile-variables)) ; nreverse because the first (other (nreverse byte-compile-constants)) ; vars often are used most. ret tmp @@ -2759,11 +2773,15 @@ If FORM is a lambda or a macro, byte-compile it as a function." limit) (while (or rest other) (setq limit (car limits)) - (while (and rest (not (eq i limit))) - (if (setq tmp (assq (car (car rest)) ret)) - (setcdr (car rest) (cdr tmp)) + (while (and rest (< i limit)) + (cond + ((numberp (car rest)) + (assert (< (car rest) byte-compile-reserved-constants))) + ((setq tmp (assq (car (car rest)) ret)) + (setcdr (car rest) (cdr tmp))) + (t (setcdr (car rest) (setq i (1+ i))) - (setq ret (cons (car rest) ret))) + (setq ret (cons (car rest) ret)))) (setq rest (cdr rest))) (setq limits (cdr limits) rest (prog1 other @@ -2772,7 +2790,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Given an expression FORM, compile it and return an equivalent byte-code ;; expression (a call to the function byte-code). -(defun byte-compile-top-level (form &optional for-effect output-type) +(defun byte-compile-top-level (form &optional for-effect output-type + lexenv reserved-csts) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, ;; 'progn or t -> a list of forms, @@ -2783,9 +2802,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) - (byte-compile-lexical-environment - (when (eq output-type 'lambda) - byte-compile-lexical-environment)) + (byte-compile-lexical-environment lexenv) + (byte-compile-reserved-constants (or reserved-csts 0)) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form for-effect))) @@ -2904,6 +2922,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (bytecomp-body (list bytecomp-body)))) +;; FIXME: Like defsubst's, this hunk-handler won't be called any more +;; because the macro is expanded away before we see it. (put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function) (defun byte-compile-declare-function (form) (push (cons (nth 1 form) @@ -2950,12 +2970,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." (memq bytecomp-fn byte-compile-interactive-only-functions) (byte-compile-warn "`%s' used from Lisp code\n\ That command is designed for interactive use only" bytecomp-fn)) - (when (byte-compile-warning-enabled-p 'callargs) - (if (memq bytecomp-fn - '(custom-declare-group custom-declare-variable - custom-declare-face)) - (byte-compile-nogroup-warn form)) - (byte-compile-callargs-warn form)) (if (and (fboundp (car form)) (eq (car-safe (symbol-function (car form))) 'macro)) (byte-compile-report-error @@ -2985,6 +2999,13 @@ That command is designed for interactive use only" bytecomp-fn)) (byte-compile-discard))) (defun byte-compile-normal-call (form) + (when (and (byte-compile-warning-enabled-p 'callargs) + (symbolp (car form))) + (if (memq (car form) + '(custom-declare-group custom-declare-variable + custom-declare-face)) + (byte-compile-nogroup-warn form)) + (byte-compile-callargs-warn form)) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (when (and for-effect (eq (car form) 'mapcar) @@ -3037,7 +3058,7 @@ If BINDING is non-nil, VAR is being bound." (boundp var) (memq var byte-compile-bound-variables) (memq var byte-compile-free-references)) - (byte-compile-warn "reference to free variable `%s'" var) + (byte-compile-warn "reference to free variable `%S'" var) (push var byte-compile-free-references)) (byte-compile-dynamic-variable-op 'byte-varref var)))) @@ -3082,26 +3103,6 @@ If BINDING is non-nil, VAR is being bound." (defun byte-compile-push-constant (const) (let ((for-effect nil)) (inline (byte-compile-constant const)))) - -(defun byte-compile-push-unknown-constant (&optional id) - "Generate code to push a `constant' who's value isn't known yet. -A tag is returned which may then later be passed to -`byte-compile-resolve-unknown-constant' to finalize the value. -The optional argument ID is a tag returned by an earlier call to -`byte-compile-push-unknown-constant', in which case the same constant is -pushed again." - (unless id - (setq id (list (make-symbol "unknown"))) - (push id byte-compile-constants)) - (byte-compile-out 'byte-constant id) - id) - -(defun byte-compile-resolve-unknown-constant (id value) - "Give an `unknown constant' a value. -ID is the tag returned by `byte-compile-push-unknown-constant'. and VALUE -is the value it should have." - (setcar id value)) - ;; Compile those primitive ordinary functions ;; which have special byte codes just for speed. @@ -3345,18 +3346,23 @@ discarding." (defconst byte-compile--env-var (make-symbol "env")) (defun byte-compile-make-closure (form) - ;; FIXME: don't use `curry'! - (byte-compile-form - (unless for-effect - `(curry (function (lambda (,byte-compile--env-var . ,(nth 1 form)) - . ,(nthcdr 3 form))) - (vector . ,(nth 2 form)))) - for-effect)) + (if for-effect (setq for-effect nil) + (let* ((vars (nth 1 form)) + (env (nth 2 form)) + (body (nthcdr 3 form)) + (fun + (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) + (assert (byte-code-function-p fun)) + (byte-compile-form `(make-byte-code + ',(aref fun 0) ',(aref fun 1) + (vconcat (vector . ,env) ',(aref fun 2)) + ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) + (defun byte-compile-get-closed-var (form) - (byte-compile-form (unless for-effect - `(aref ,byte-compile--env-var ,(nth 1 form))) - for-effect)) + (if for-effect (setq for-effect nil) + (byte-compile-out 'byte-constant ;; byte-closed-var + (nth 1 form)))) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations |