-(defun byte-compile-variable-ref (base-op bytecomp-var)
- (when (symbolp bytecomp-var)
- (byte-compile-set-symbol-position bytecomp-var))
- (if (or (not (symbolp bytecomp-var))
- (byte-compile-const-symbol-p bytecomp-var
- (not (eq base-op 'byte-varref))))
- (if (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn
- (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
- ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
- (t "variable reference to %s `%s'"))
- (if (symbolp bytecomp-var) "constant" "nonvariable")
- (prin1-to-string bytecomp-var)))
- (and (get bytecomp-var 'byte-obsolete-variable)
- (not (memq bytecomp-var byte-compile-not-obsolete-vars))
- (byte-compile-warn-obsolete bytecomp-var))
- (if (eq base-op 'byte-varbind)
- (push bytecomp-var byte-compile-bound-variables)
- (or (not (byte-compile-warning-enabled-p 'free-vars))
- (boundp bytecomp-var)
- (memq bytecomp-var byte-compile-bound-variables)
- (if (eq base-op 'byte-varset)
- (or (memq bytecomp-var byte-compile-free-assignments)
- (progn
- (byte-compile-warn "assignment to free variable `%s'"
- bytecomp-var)
- (push bytecomp-var byte-compile-free-assignments)))
- (or (memq bytecomp-var byte-compile-free-references)
- (progn
- (byte-compile-warn "reference to free variable `%s'"
- bytecomp-var)
- (push bytecomp-var byte-compile-free-references)))))))
- (let ((tmp (assq bytecomp-var byte-compile-variables)))
+
+;; Splice the given lap code into the current instruction stream.
+;; If it has any labels in it, you're responsible for making sure there
+;; are no collisions, and that byte-compile-tag-number is reasonable
+;; after this is spliced in. The provided list is destroyed.
+(defun byte-compile-inline-lapcode (lap end-depth)
+ ;; "Replay" the operations: we used to just do
+ ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))
+ ;; but that fails to update byte-compile-depth, so we had to assume
+ ;; that `lap' ends up adding exactly 1 element to the stack. This
+ ;; happens to be true for byte-code generated by bytecomp.el without
+ ;; lexical-binding, but it's not true in general, and it's not true for
+ ;; code output by bytecomp.el with lexical-binding.
+ (let ((endtag (byte-compile-make-tag)))
+ (dolist (op lap)
+ (cond
+ ((eq (car op) 'TAG) (byte-compile-out-tag op))
+ ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op)))
+ ((eq (car op) 'byte-return)
+ (byte-compile-discard (- byte-compile-depth end-depth) t)
+ (byte-compile-goto 'byte-goto endtag))
+ (t (byte-compile-out (car op) (cdr op)))))
+ (byte-compile-out-tag endtag)))
+
+(defun byte-compile-unfold-bcf (form)
+ "Inline call to byte-code-functions."
+ (let* ((byte-compile-bound-variables byte-compile-bound-variables)
+ (fun (car form))
+ (fargs (aref fun 0))
+ (start-depth byte-compile-depth)
+ (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest.
+ ;; (fmin (if (numberp fargs) (logand fargs 127)))
+ (alen (length (cdr form)))
+ (dynbinds ()))
+ (fetch-bytecode fun)
+ (mapc 'byte-compile-form (cdr form))
+ (unless fmax2
+ ;; Old-style byte-code.
+ (assert (listp fargs))
+ (while fargs
+ (case (car fargs)
+ (&optional (setq fargs (cdr fargs)))
+ (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
+ (push (cadr fargs) dynbinds)
+ (setq fargs nil))
+ (t (push (pop fargs) dynbinds))))
+ (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
+ (cond
+ ((<= (+ alen alen) fmax2)
+ ;; Add missing &optional (or &rest) arguments.
+ (dotimes (_ (- (/ (1+ fmax2) 2) alen))
+ (byte-compile-push-constant nil)))
+ ((zerop (logand fmax2 1))
+ (byte-compile-log-warning "Too many arguments for inlined function"
+ nil :error)
+ (byte-compile-discard (- alen (/ fmax2 2))))
+ (t
+ ;; Turn &rest args into a list.
+ (let ((n (- alen (/ (1- fmax2) 2))))
+ (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
+ (if (< n 5)
+ (byte-compile-out
+ (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
+ 0)
+ (byte-compile-out 'byte-listN n)))))
+ (mapc #'byte-compile-dynamic-variable-bind dynbinds)
+ (byte-compile-inline-lapcode
+ (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)
+ (1+ start-depth))
+ ;; Unbind dynamic variables.
+ (when dynbinds
+ (byte-compile-out 'byte-unbind (length dynbinds)))
+ (assert (eq byte-compile-depth (1+ start-depth))
+ nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
+
+(defun byte-compile-check-variable (var access-type)
+ "Do various error checks before a use of the variable VAR."
+ (when (symbolp var)
+ (byte-compile-set-symbol-position var))
+ (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
+ (when (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn (if (eq access-type 'let-bind)
+ "attempt to let-bind %s `%s`"
+ "variable reference to %s `%s'")
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var))))
+ ((let ((od (get var 'byte-obsolete-variable)))
+ (and od
+ (not (memq var byte-compile-not-obsolete-vars))
+ (not (memq var byte-compile-global-not-obsolete-vars))
+ (or (case (nth 1 od)
+ (set (not (eq access-type 'reference)))
+ (get (eq access-type 'reference))
+ (t t)))))
+ (byte-compile-warn-obsolete var))))
+
+(defsubst byte-compile-dynamic-variable-op (base-op var)
+ (let ((tmp (assq var byte-compile-variables)))