bug#34757: Invalid bytecode from byte compiler

[Stefan Monnier]

>> diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
>> index 0b8f8824b4c..4e54e08ce14 100644
>> --- a/lisp/emacs-lisp/bytecomp.el
>> +++ b/lisp/emacs-lisp/bytecomp.el
>> @@ -3025,6 +3025,7 @@ byte-compile-out-toplevel
>>                         (or (null (cdr rest))
>>                             (and (memq output-type '(file progn t))
>>                                  (cdr (cdr rest))
>> +                                (eql (length body) (cdr (car rest)))
>>                                  (eq (car (nth 1 rest)) 'byte-discard)
>>                                  (progn (setq rest (cdr rest)) t))))
>>                    (setq maycall nil)    ; Only allow one real function call.
>
> Stefan, any comments?

Looks good to me, thanks.

I'm personally running with the following patch instead, which is much
more risky and hasn't been sufficiently tested yet.


        Stefan


diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f46cab2c17..573b0489d4 100644
*** a/lisp/emacs-lisp/bytecomp.el
--- b/lisp/emacs-lisp/bytecomp.el
***************
*** 2990,3059 ****
        (setq byte-compile-output
            (byte-optimize-lapcode byte-compile-output)))
  
!   ;; Decompile trivial functions:
!   ;; only constants and variables, or a single funcall except in lambdas.
!   ;; Except for Lisp_Compiled objects, forms like (foo "hi")
!   ;; are still quicker than (byte-code "..." [foo "hi"] 2).
!   ;; Note that even (quote foo) must be parsed just as any subr by the
!   ;; interpreter, so quote should be compiled into byte-code in some contexts.
!   ;; What to leave uncompiled:
!   ;;  lambda  -> never.  we used to leave it uncompiled if the body was
!   ;;             a single atom, but that causes confusion if the docstring
!   ;;             uses the (file . pos) syntax.  Besides, now that we have
!   ;;             the Lisp_Compiled type, the compiled form is faster.
!   ;;  eval    -> atom, quote or (function atom atom atom)
!   ;;  progn   -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
!   ;;  file    -> as progn, but takes both quotes and atoms, and longer forms.
!   (let (rest
!       (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
!       tmp body)
!     (cond
!      ;; #### This should be split out into byte-compile-nontrivial-function-p.
!      ((or (eq output-type 'lambda)
!         (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
!         (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
!         (not (setq tmp (assq 'byte-return byte-compile-output)))
!         (progn
!           (setq rest (nreverse
!                       (cdr (memq tmp (reverse byte-compile-output)))))
!           (while
!                 (cond
!                  ((memq (car (car rest)) '(byte-varref byte-constant))
!                   (setq tmp (car (cdr (car rest))))
!                   (if (if (eq (car (car rest)) 'byte-constant)
!                           (or (consp tmp)
!                               (and (symbolp tmp)
!                                    (not (macroexp--const-symbol-p tmp)))))
!                       (if maycall
!                           (setq body (cons (list 'quote tmp) body)))
!                     (setq body (cons tmp body))))
!                  ((and maycall
!                        ;; Allow a funcall if at most one atom follows it.
!                        (null (nthcdr 3 rest))
!                        (setq tmp (get (car (car rest)) 'byte-opcode-invert))
!                        (or (null (cdr rest))
!                            (and (memq output-type '(file progn t))
!                                 (cdr (cdr rest))
!                                 (eq (car (nth 1 rest)) 'byte-discard)
!                                 (progn (setq rest (cdr rest)) t))))
!                   (setq maycall nil)  ; Only allow one real function call.
!                   (setq body (nreverse body))
!                   (setq body (list
!                               (if (and (eq tmp 'funcall)
!                                        (eq (car-safe (car body)) 'quote)
!                                      (symbolp (nth 1 (car body))))
!                                   (cons (nth 1 (car body)) (cdr body))
!                                 (cons tmp body))))
!                   (or (eq output-type 'file)
!                       (not (delq nil (mapcar 'consp (cdr (car body))))))))
!             (setq rest (cdr rest)))
!           rest))
!       (let ((byte-compile-vector (byte-compile-constants-vector)))
!       (list 'byte-code (byte-compile-lapcode byte-compile-output)
!             byte-compile-vector byte-compile-maxdepth)))
!      ;; it's a trivial function
!      ((cdr body) (cons 'progn (nreverse body)))
!      ((car body)))))
  
  ;; Given BODY, compile it and return a new body.
  (defun byte-compile-top-level-body (body &optional for-effect)
--- 2993,3013 ----
        (setq byte-compile-output
            (byte-optimize-lapcode byte-compile-output)))
  
!   (cond
!    ((and (not (eq output-type 'lambda)) ;;The caller really wants (byte-code 
...)
!          (null (cddr byte-compile-output))
!          (eq (car (nth 0 byte-compile-output)) 'byte-constant)
!          (eq (car (nth 1 byte-compile-output)) 'byte-return))
!     ;; Special case for trivial code returning a function.
!     ;; This is so that when compiling #'(lambda ...) we return
!     ;; a #[...] byte-code object instead of a (byte-code "...")
!     ;; expression that returns this object.  It's not indispensable,
!     ;; but it's cleaner.
!     (macroexp-quote (cadr (nth 0 byte-compile-output))))
!    (t
!     (let ((byte-compile-vector (byte-compile-constants-vector)))
!       (list 'byte-code (byte-compile-lapcode byte-compile-output)
!           byte-compile-vector byte-compile-maxdepth)))))
  
  ;; Given BODY, compile it and return a new body.
  (defun byte-compile-top-level-body (body &optional for-effect)