Function: byte-compile-out-toplevel

byte-compile-out-toplevel is a byte-compiled function defined in bytecomp.el.gz.

Signature

(byte-compile-out-toplevel &optional FOR-EFFECT OUTPUT-TYPE)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
(defun byte-compile-out-toplevel (&optional for-effect output-type)
  ;; OUTPUT-TYPE can be like that of `byte-compile-top-level'.
  (if for-effect
      ;; The stack is empty. Push a value to be returned from (byte-code ..).
      (if (eq (car (car byte-compile-output)) 'byte-discard)
	  (setq byte-compile-output (cdr byte-compile-output))
	(byte-compile-push-constant
	 ;; Push any constant - preferably one which already is used, and
	 ;; a number or symbol - ie not some big sequence.  The return value
	 ;; isn't returned, but it would be a shame if some textually large
	 ;; constant was not optimized away because we chose to return it.
	 (and (not (assq nil byte-compile-constants)) ; Nil is often there.
	      (let ((tmp (reverse byte-compile-constants)))
		(while (and tmp (not (or (symbolp (caar tmp))
					 (numberp (caar tmp)))))
		  (setq tmp (cdr tmp)))
		(caar tmp))))))
  (byte-compile-out 'byte-return 0)
  (setq byte-compile-output (nreverse byte-compile-output))
  (if (memq byte-optimize '(t byte))
      (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.  The compiled form is always faster.
  ;;	eval	-> atom, quote or (function atom atom 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 (eq output-type 'file)
                                (cdr (cdr rest))
                                (eql (length body) (cdr (car rest))) ;bug#34757
                                (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 (any #'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)))))