;; Some versions of `file' can be customized to recognize that.
(require 'backquote)
+(require 'macroexp)
(eval-when-compile (require 'cl))
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
(load "byte-run"))
+;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation
+;; errors; however that file also wants to do (require 'bytecomp) for the
+;; same reason. Since we know it's OK to load byte-lexbind.el second, we
+;; have that file require a feature that's provided before at the beginning
+;; of this file, to avoid an infinite require loop.
+;; `eval-when-compile' is defined in byte-run.el, so it must come after the
+;; preceding load expression.
+(provide 'bytecomp-preload)
+(eval-when-compile (require 'byte-lexbind))
+
+;; The feature of compiling in a specific target Emacs version
+;; has been turned off because compile time options are a bad idea.
+(defmacro byte-compile-single-version () nil)
+(defmacro byte-compile-version-cond (cond) cond)
+
+;; The crud you see scattered through this file of the form
+;; (or (and (boundp 'epoch::version) epoch::version)
+;; (string-lessp emacs-version "19"))
+;; is because the Epoch folks couldn't be bothered to follow the
+;; normal emacs version numbering convention.
+
+;; (if (byte-compile-version-cond
+;; (or (and (boundp 'epoch::version) epoch::version)
+;; (string-lessp emacs-version "19")))
+;; (progn
+;; ;; emacs-18 compatibility.
+;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined
+;;
+;; (if (byte-compile-single-version)
+;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
+;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
+;;
+;; (or (and (fboundp 'member)
+;; ;; avoid using someone else's possibly bogus definition of this.
+;; (subrp (symbol-function 'member)))
+;; (defun member (elt list)
+;; "like memq, but uses equal instead of eq. In v19, this is a subr."
+;; (while (and list (not (equal elt (car list))))
+;; (setq list (cdr list)))
+;; list))))
+
+
(defgroup bytecomp nil
"Emacs Lisp byte-compiler."
:group 'lisp)
:type '(choice (const name) (const callers) (const calls)
(const calls+callers) (const nil)))
-(defvar byte-compile-debug nil)
+;(defvar byte-compile-debug nil)
+(defvar byte-compile-debug t)
+(setq debug-on-error t)
+
+;; (defvar byte-compile-overwrite-file t
+;; "If nil, old .elc files are deleted before the new is saved, and .elc
+;; files will have the same modes as the corresponding .el file. Otherwise,
+;; existing .elc files will simply be overwritten, and the existing modes
+;; will not be changed. If this variable is nil, then an .elc file which
+;; is a symbolic link will be turned into a normal file, instead of the file
+;; which the link points to being overwritten.")
+
(defvar byte-compile-constants nil
"List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
;; (byte-compiler-options . (lambda (&rest forms)
;; (apply 'byte-compiler-options-handler forms)))
(eval-when-compile . (lambda (&rest body)
- (list 'quote
- (byte-compile-eval (byte-compile-top-level
- (cons 'progn body))))))
+ (list
+ 'quote
+ (byte-compile-eval
+ (byte-compile-top-level
+ (macroexpand-all
+ (cons 'progn body)
+ byte-compile-initial-macro-environment))))))
(eval-and-compile . (lambda (&rest body)
(byte-compile-eval-before-compile (cons 'progn body))
(cons 'progn body))))
Used for warnings about calling a function that is defined during compilation
but won't necessarily be defined when the compiled file is loaded.")
+;; Variables for lexical binding
+(defvar byte-compile-lexical-environment nil
+ "The current lexical environment.")
+(defvar byte-compile-current-heap-environment nil
+ "If non-nil, a descriptor for the current heap-allocated lexical environment.")
+(defvar byte-compile-current-num-closures 0
+ "The number of lexical closures that close over `byte-compile-current-heap-environment'.")
+
(defvar byte-compile-tag-number 0)
(defvar byte-compile-output nil
"Alist describing contents to put in byte code string.
(put 'byte-stack+-info 'tmp-compile-time-value nil)))
-;; unused: 0-7
-
;; These opcodes are special in that they pack their argument into the
;; opcode word.
;;
+(byte-defop 0 1 byte-stack-ref "for stack reference")
(byte-defop 8 1 byte-varref "for variable reference")
(byte-defop 16 -1 byte-varset "for setting a variable")
(byte-defop 24 -1 byte-varbind "for binding a variable")
(byte-defop 168 0 byte-integerp)
;; unused: 169-174
+
(byte-defop 175 nil byte-listN)
(byte-defop 176 nil byte-concatN)
(byte-defop 177 nil byte-insertN)
-;; unused: 178-191
+(byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte
+(byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes
+(byte-defop 180 1 byte-vec-ref) ; vector offset in following one byte
+(byte-defop 181 -1 byte-vec-set) ; vector offset in following one byte
+
+;; if (following one byte & 0x80) == 0
+;; discard (following one byte & 0x7F) stack entries
+;; else
+;; discard (following one byte & 0x7F) stack entries _underneath_ the top of stack
+;; (that is, if the operand = 0x83, ... X Y Z T => ... T)
+(byte-defop 182 nil byte-discardN)
+;; `byte-discardN-preserve-tos' is a pseudo-op that gets turned into
+;; `byte-discardN' with the high bit in the operand set (by
+;; `byte-compile-lapcode').
+(defconst byte-discardN-preserve-tos byte-discardN)
+
+;; unused: 182-191
(byte-defop 192 1 byte-constant "for reference to a constant")
;; codes 193-255 are consumed by byte-constant.
;; front of the constants-vector than the constant-referencing instructions.
;; Also, this lets us notice references to free variables.
+(defmacro byte-compile-push-bytecodes (&rest args)
+ "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed.
+ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names.
+BYTES and PC are updated after evaluating all the arguments."
+ (let ((byte-exprs (butlast args 2))
+ (bytes-var (car (last args 2)))
+ (pc-var (car (last args))))
+ `(setq ,bytes-var ,(if (null (cdr byte-exprs))
+ `(cons ,@byte-exprs ,bytes-var)
+ `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
+ ,pc-var (+ ,(length byte-exprs) ,pc-var))))
+
+(defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc)
+ "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
+CONST2 may be evaulated multiple times."
+ `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8)
+ ,bytes ,pc))
+
(defun byte-compile-lapcode (lap)
"Turns lapcode into bytecode. The lapcode is destroyed."
;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
(let ((pc 0) ; Program counter
op off ; Operation & offset
+ opcode ; numeric value of OP
(bytes '()) ; Put the output bytes here
- (patchlist nil)) ; List of tags and goto's to patch
- (while lap
- (setq op (car (car lap))
- off (cdr (car lap)))
+ (patchlist nil)) ; List of gotos to patch
+ (dolist (lap-entry lap)
+ (setq op (car lap-entry)
+ off (cdr lap-entry))
(cond ((not (symbolp op))
(error "Non-symbolic opcode `%s'" op))
((eq op 'TAG)
- (setcar off pc)
- (setq patchlist (cons off patchlist)))
- ((memq op byte-goto-ops)
- (setq pc (+ pc 3))
- (setq bytes (cons (cons pc (cdr off))
- (cons nil
- (cons (symbol-value op) bytes))))
- (setq patchlist (cons bytes patchlist)))
+ (setcar off pc))
+ ((null op)
+ ;; a no-op added by `byte-compile-delay-out'
+ (unless (zerop off)
+ (error
+ "Placeholder added by `byte-compile-delay-out' not filled in.")
+ ))
(t
- (setq bytes
- (cond ((cond ((consp off)
- ;; Variable or constant reference
- (setq off (cdr off))
- (eq op 'byte-constant)))
- (cond ((< off byte-constant-limit)
- (setq pc (1+ pc))
- (cons (+ byte-constant off) bytes))
- (t
- (setq pc (+ 3 pc))
- (cons (lsh off -8)
- (cons (logand off 255)
- (cons byte-constant2 bytes))))))
- ((<= byte-listN (symbol-value op))
- (setq pc (+ 2 pc))
- (cons off (cons (symbol-value op) bytes)))
- ((< off 6)
- (setq pc (1+ pc))
- (cons (+ (symbol-value op) off) bytes))
- ((< off 256)
- (setq pc (+ 2 pc))
- (cons off (cons (+ (symbol-value op) 6) bytes)))
- (t
- (setq pc (+ 3 pc))
- (cons (lsh off -8)
- (cons (logand off 255)
- (cons (+ (symbol-value op) 7)
- bytes))))))))
- (setq lap (cdr lap)))
+ (if (eq op 'byte-discardN-preserve-tos)
+ ;; byte-discardN-preserve-tos is a psuedo op, which is actually
+ ;; the same as byte-discardN with a modified argument
+ (setq opcode byte-discardN)
+ (setq opcode (symbol-value op)))
+ (cond ((memq op byte-goto-ops)
+ ;; 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)))
+ ;; constant ref
+ (if (< off byte-constant-limit)
+ (byte-compile-push-bytecodes (+ byte-constant off)
+ bytes pc)
+ (byte-compile-push-bytecode-const2 byte-constant2 off
+ bytes pc)))
+ ((and (= opcode byte-stack-set)
+ (> off 255))
+ ;; Use the two-byte version of byte-stack-set if the
+ ;; offset is too large for the normal version.
+ (byte-compile-push-bytecode-const2 byte-stack-set2 off
+ bytes pc))
+ ((and (>= opcode byte-listN)
+ (< opcode byte-discardN))
+ ;; These insns all put their operand into one extra byte.
+ (byte-compile-push-bytecodes opcode off bytes pc))
+ ((= opcode byte-discardN)
+ ;; byte-discardN is wierd in that it encodes a flag in the
+ ;; top bit of its one-byte argument. If the argument is
+ ;; too large to fit in 7 bits, the opcode can be repeated.
+ (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0)))
+ (while (> off #x7f)
+ (byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc)
+ (setq off (- off #x7f)))
+ (byte-compile-push-bytecodes opcode (logior off flag) bytes pc)))
+ ((null off)
+ ;; opcode that doesn't use OFF
+ (byte-compile-push-bytecodes opcode bytes pc))
+ ;; The following three cases are for the special
+ ;; insns that encode their operand into 0, 1, or 2
+ ;; extra bytes depending on its magnitude.
+ ((< off 6)
+ (byte-compile-push-bytecodes (+ opcode off) bytes pc))
+ ((< off 256)
+ (byte-compile-push-bytecodes (+ opcode 6) off bytes pc))
+ (t
+ (byte-compile-push-bytecode-const2 (+ opcode 7) off
+ bytes pc))))))
;;(if (not (= pc (length bytes)))
;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
- ;; Patch PC into jumps
- (let (bytes)
- (while patchlist
- (setq bytes (car patchlist))
- (cond ((atom (car bytes))) ; Tag
- (t ; Absolute jump
- (setq pc (car (cdr (car bytes)))) ; Pick PC from tag
- (setcar (cdr bytes) (logand pc 255))
- (setcar bytes (lsh pc -8))
- ;; FIXME: Replace this by some workaround.
- (if (> (car bytes) 255) (error "Bytecode overflow"))))
- (setq patchlist (cdr patchlist))))
+
+ ;; Patch tag PCs into absolute jumps
+ (dolist (bytes-tail patchlist)
+ (setq pc (caar bytes-tail)) ; Pick PC from goto's tag
+ (setcar (cdr bytes-tail) (logand pc 255))
+ (setcar bytes-tail (lsh pc -8))
+ ;; FIXME: Replace this by some workaround.
+ (if (> (car bytes) 255) (error "Bytecode overflow")))
+
(apply 'unibyte-string (nreverse bytes))))
\f
(defun byte-compile-file-form (form)
(let ((byte-compile-current-form nil) ; close over this for warnings.
bytecomp-handler)
- (cond
- ((not (consp form))
- (byte-compile-keep-pending form))
- ((and (symbolp (car form))
- (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
- (cond ((setq form (funcall bytecomp-handler form))
- (byte-compile-flush-pending)
- (byte-compile-output-file-form form))))
- ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
- (byte-compile-keep-pending form))
- (t
- (byte-compile-file-form form)))))
+ (setq form (macroexpand-all form byte-compile-macro-environment))
+ (cond ((not (consp form))
+ (byte-compile-keep-pending form))
+ ((and (symbolp (car form))
+ (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
+ (cond ((setq form (funcall bytecomp-handler form))
+ (byte-compile-flush-pending)
+ (byte-compile-output-file-form form))))
+ (t
+ (byte-compile-keep-pending form)))))
;; Functions and variables with doc strings must be output separately,
;; so make-docfile can recognise them. Most other things can be output
(setq byte-compile-current-form (nth 1 form))
(byte-compile-warn "defsubst `%s' was used before it was defined"
(nth 1 form)))
- (byte-compile-file-form
- (macroexpand form byte-compile-macro-environment))
+ (byte-compile-file-form form)
;; Return nil so the form is not output twice.
nil)
(if macro
(setq fun (cdr fun)))
(cond ((eq (car-safe fun) 'lambda)
+ ;; expand macros
+ (setq fun
+ (macroexpand-all fun
+ byte-compile-initial-macro-environment))
+ ;; get rid of the `function' quote added by the `lambda' macro
+ (setq fun (cadr fun))
(setq fun (if macro
(cons 'macro (byte-compile-lambda fun))
(byte-compile-lambda fun)))
(setq list (cdr list)))))
+(autoload 'byte-compile-make-lambda-lexenv "byte-lexbind")
+
;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
;; lambda-expression.
(byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string bytecomp-int)))))
;; Process the body.
- (let ((compiled (byte-compile-top-level
- (cons 'progn bytecomp-body) nil 'lambda)))
+ (let* ((byte-compile-lexical-environment
+ ;; If doing lexical binding, push a new lexical environment
+ ;; containing the args and any closed-over variables.
+ (and lexical-binding
+ (byte-compile-make-lambda-lexenv
+ fun
+ byte-compile-lexical-environment)))
+ (is-closure
+ ;; This is true if we should be making a closure instead of
+ ;; a simple lambda (because some variables from the
+ ;; containing lexical environment are closed over).
+ (and lexical-binding
+ (byte-compile-closure-initial-lexenv-p
+ byte-compile-lexical-environment)))
+ (byte-compile-current-heap-environment nil)
+ (byte-compile-current-num-closures 0)
+ (compiled
+ (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
;; Build the actual byte-coded function.
(if (eq 'byte-code (car-safe compiled))
- (apply 'make-byte-code
- (append (list bytecomp-arglist)
- ;; byte-string, constants-vector, stack depth
- (cdr compiled)
- ;; optionally, the doc string.
- (if (or bytecomp-doc bytecomp-int)
- (list bytecomp-doc))
- ;; optionally, the interactive spec.
- (if bytecomp-int
- (list (nth 1 bytecomp-int)))))
+ (let ((code
+ (apply 'make-byte-code
+ (append (list bytecomp-arglist)
+ ;; byte-string, constants-vector, stack depth
+ (cdr compiled)
+ ;; optionally, the doc string.
+ (if (or bytecomp-doc bytecomp-int
+ lexical-binding)
+ (list bytecomp-doc))
+ ;; optionally, the interactive spec.
+ (if (or bytecomp-int lexical-binding)
+ (list (nth 1 bytecomp-int)))
+ (if lexical-binding
+ '(t))))))
+ (if is-closure
+ (cons 'closure code)
+ code))
(setq compiled
(nconc (if bytecomp-int (list bytecomp-int))
(cond ((eq (car-safe compiled) 'progn) (cdr compiled))
(bytecomp-body (list nil))))
compiled))))))
+(defun byte-compile-closure-code-p (code)
+ (eq (car-safe code) 'closure))
+
+(defun byte-compile-make-closure (code)
+ ;; A real closure requires that the constant be curried with an
+ ;; environment vector to make a closure object.
+ (if for-effect
+ (setq for-effect nil)
+ (byte-compile-push-constant 'curry)
+ (byte-compile-push-constant code)
+ (byte-compile-lexical-variable-ref byte-compile-current-heap-environment)
+ (byte-compile-out 'byte-call 2)))
+
+(defun byte-compile-closure (form &optional add-lambda)
+ (let ((code (byte-compile-lambda form add-lambda)))
+ (if (byte-compile-closure-code-p code)
+ (byte-compile-make-closure code)
+ ;; A simple lambda is just a constant
+ (byte-compile-constant code))))
+
(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).
(byte-compile-depth 0)
(byte-compile-maxdepth 0)
(byte-compile-output nil))
- (if (memq byte-optimize '(t source))
- (setq form (byte-optimize-form form for-effect)))
- (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
- (setq form (nth 1 form)))
- (if (and (eq 'byte-code (car-safe form))
- (not (memq byte-optimize '(t byte)))
- (stringp (nth 1 form)) (vectorp (nth 2 form))
- (natnump (nth 3 form)))
- form
- (byte-compile-form form for-effect)
- (byte-compile-out-toplevel for-effect output-type))))
+ (if (memq byte-optimize '(t source))
+ (setq form (byte-optimize-form form for-effect)))
+ (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
+ (setq form (nth 1 form)))
+ (if (and (eq 'byte-code (car-safe form))
+ (not (memq byte-optimize '(t byte)))
+ (stringp (nth 1 form)) (vectorp (nth 2 form))
+ (natnump (nth 3 form)))
+ form
+ ;; Set up things for a lexically-bound function
+ (when (and lexical-binding (eq output-type 'lambda))
+ ;; See how many arguments there are, and set the current stack depth
+ ;; accordingly
+ (dolist (var byte-compile-lexical-environment)
+ (when (byte-compile-lexvar-on-stack-p var)
+ (setq byte-compile-depth (1+ byte-compile-depth))))
+ ;; If there are args, output a tag to record the initial
+ ;; stack-depth for the optimizer
+ (when (> byte-compile-depth 0)
+ (byte-compile-out-tag (byte-compile-make-tag)))
+ ;; If this is the top-level of a lexically bound lambda expression,
+ ;; perhaps some parameters on stack need to be copied into a heap
+ ;; environment, so check for them, and do so if necessary.
+ (let ((lforminfo (byte-compile-make-lforminfo)))
+ ;; Add any lexical variable that's on the stack to the analysis set.
+ (dolist (var byte-compile-lexical-environment)
+ (when (byte-compile-lexvar-on-stack-p var)
+ (byte-compile-lforminfo-add-var lforminfo (car var) t)))
+ ;; Analyze the body
+ (unless (null (byte-compile-lforminfo-vars lforminfo))
+ (byte-compile-lforminfo-analyze lforminfo form nil nil))
+ ;; If the analysis revealed some argument need to be in a heap
+ ;; environment (because they're closed over by an embedded
+ ;; lambda), put them there.
+ (setq byte-compile-lexical-environment
+ (nconc (byte-compile-maybe-push-heap-environment lforminfo)
+ byte-compile-lexical-environment))
+ (dolist (arginfo (byte-compile-lforminfo-vars lforminfo))
+ (when (byte-compile-lvarinfo-closed-over-p arginfo)
+ (byte-compile-bind (car arginfo)
+ byte-compile-lexical-environment
+ lforminfo)))))
+ ;; Now compile FORM
+ (byte-compile-form form for-effect)
+ (byte-compile-out-toplevel for-effect output-type))))
(defun byte-compile-out-toplevel (&optional for-effect output-type)
(if for-effect
;; Given BYTECOMP-BODY, compile it and return a new body.
(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
+ ;; FIXME: lexbind. Check all callers!
(setq bytecomp-body
(byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
(cond ((eq (car-safe bytecomp-body) 'progn)
;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
;;
(defun byte-compile-form (form &optional for-effect)
- (setq form (macroexpand form byte-compile-macro-environment))
(cond ((not (consp form))
(cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
(when (symbolp form)
(when (symbolp form)
(byte-compile-set-symbol-position form))
(setq for-effect nil))
- (t (byte-compile-variable-ref 'byte-varref form))))
+ (t
+ (byte-compile-variable-ref form))))
((symbolp (car form))
(let* ((bytecomp-fn (car form))
(bytecomp-handler (get bytecomp-fn 'byte-compile)))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
-(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)))
+(defun byte-compile-check-variable (var &optional binding)
+ "Do various error checks before a use of the variable VAR.
+If BINDING is non-nil, VAR is being bound."
+ (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 binding
+ "attempt to let-bind %s `%s`"
+ "variable reference to %s `%s'")
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var))))
+ ((and (get var 'byte-obsolete-variable)
+ (not (memq var byte-compile-not-obsolete-vars)))
+ (byte-compile-warn-obsolete var))))
+
+(defsubst byte-compile-dynamic-variable-op (base-op var)
+ (let ((tmp (assq var byte-compile-variables)))
(unless tmp
- (setq tmp (list bytecomp-var))
+ (setq tmp (list var))
(push tmp byte-compile-variables))
(byte-compile-out base-op tmp)))
+(defun byte-compile-dynamic-variable-bind (var)
+ "Generate code to bind the lexical variable VAR to the top-of-stack value."
+ (byte-compile-check-variable var t)
+ (when (byte-compile-warning-enabled-p 'free-vars)
+ (push var byte-compile-bound-variables))
+ (byte-compile-dynamic-variable-op 'byte-varbind var))
+
+;; This is used when it's know that VAR _definitely_ has a lexical
+;; binding, and no error-checking should be done.
+(defun byte-compile-lexical-variable-ref (var)
+ "Generate code to push the value of the lexical variable VAR on the stack."
+ (let ((binding (assq var byte-compile-lexical-environment)))
+ (when (null binding)
+ (error "Lexical binding not found for `%s'" var))
+ (if (byte-compile-lexvar-on-stack-p binding)
+ ;; On the stack
+ (byte-compile-stack-ref (byte-compile-lexvar-offset binding))
+ ;; In a heap environment vector; first push the vector on the stack
+ (byte-compile-lexical-variable-ref
+ (byte-compile-lexvar-environment binding))
+ ;; Now get the value from it
+ (byte-compile-out 'byte-vec-ref (byte-compile-lexvar-offset binding)))))
+
+(defun byte-compile-variable-ref (var)
+ "Generate code to push the value of the variable VAR on the stack."
+ (byte-compile-check-variable var)
+ (let ((lex-binding (assq var byte-compile-lexical-environment)))
+ (if lex-binding
+ ;; VAR is lexically bound
+ (if (byte-compile-lexvar-on-stack-p lex-binding)
+ ;; On the stack
+ (byte-compile-stack-ref (byte-compile-lexvar-offset lex-binding))
+ ;; In a heap environment vector
+ (byte-compile-lexical-variable-ref
+ (byte-compile-lexvar-environment lex-binding))
+ (byte-compile-out 'byte-vec-ref
+ (byte-compile-lexvar-offset lex-binding)))
+ ;; VAR is dynamically bound
+ (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+ (boundp var)
+ (memq var byte-compile-bound-variables)
+ (memq var byte-compile-free-references))
+ (byte-compile-warn "reference to free variable `%s'" var)
+ (push var byte-compile-free-references))
+ (byte-compile-dynamic-variable-op 'byte-varref var))))
+
+(defun byte-compile-variable-set (var)
+ "Generate code to set the variable VAR from the top-of-stack value."
+ (byte-compile-check-variable var)
+ (let ((lex-binding (assq var byte-compile-lexical-environment)))
+ (if lex-binding
+ ;; VAR is lexically bound
+ (if (byte-compile-lexvar-on-stack-p lex-binding)
+ ;; On the stack
+ (byte-compile-stack-set (byte-compile-lexvar-offset lex-binding))
+ ;; In a heap environment vector
+ (byte-compile-lexical-variable-ref
+ (byte-compile-lexvar-environment lex-binding))
+ (byte-compile-out 'byte-vec-set
+ (byte-compile-lexvar-offset lex-binding)))
+ ;; VAR is dynamically bound
+ (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+ (boundp var)
+ (memq var byte-compile-bound-variables)
+ (memq var byte-compile-free-assignments))
+ (byte-compile-warn "assignment to free variable `%s'" var)
+ (push var byte-compile-free-assignments))
+ (byte-compile-dynamic-variable-op 'byte-varset var))))
+
(defmacro byte-compile-get-constant (const)
`(or (if (stringp ,const)
;; In a string constant, treat properties as significant.
(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))
+
\f
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
(defun byte-compile-noop (form)
(byte-compile-constant nil))
-(defun byte-compile-discard ()
- (byte-compile-out 'byte-discard 0))
+(defun byte-compile-discard (&optional num preserve-tos)
+ "Output byte codes to discard the NUM entries at the top of the stack (NUM defaults to 1).
+If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were
+popped before discarding the num values, and then pushed back again after
+discarding."
+ (if (and (null num) (not preserve-tos))
+ ;; common case
+ (byte-compile-out 'byte-discard)
+ ;; general case
+ (unless num
+ (setq num 1))
+ (when (and preserve-tos (> num 0))
+ ;; Preserve the top-of-stack value by writing it directly to the stack
+ ;; location which will be at the top-of-stack after popping.
+ (byte-compile-stack-set (1- (- byte-compile-depth num)))
+ ;; Now we actually discard one less value, since we want to keep
+ ;; the eventual TOS
+ (setq num (1- num)))
+ (while (> num 0)
+ (byte-compile-out 'byte-discard)
+ (setq num (1- num)))))
+
+(defun byte-compile-stack-ref (stack-pos)
+ "Output byte codes to push the value at position STACK-POS in the stack, on the top of the stack."
+ (if (= byte-compile-depth (1+ stack-pos))
+ ;; A simple optimization
+ (byte-compile-out 'byte-dup)
+ ;; normal case
+ (byte-compile-out 'byte-stack-ref stack-pos)))
+
+(defun byte-compile-stack-set (stack-pos)
+ "Output byte codes to store the top-of-stack value at position STACK-POS in the stack."
+ (byte-compile-out 'byte-stack-set stack-pos))
;; Compile a function that accepts one or more args and is right-associative.
the syntax (function (lambda (...) ...)) instead.")))))
(byte-compile-two-args form))
-(defun byte-compile-funarg (form)
- ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
- ;; for cases where it's guaranteed that first arg will be used as a lambda.
- (byte-compile-normal-call
- (let ((fn (nth 1 form)))
- (if (and (eq (car-safe fn) 'quote)
- (eq (car-safe (nth 1 fn)) 'lambda))
- (cons (car form)
- (cons (cons 'function (cdr fn))
- (cdr (cdr form))))
- form))))
-
-(defun byte-compile-funarg-2 (form)
- ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
- ;; for cases where it's guaranteed that second arg will be used as a lambda.
- (byte-compile-normal-call
- (let ((fn (nth 2 form)))
- (if (and (eq (car-safe fn) 'quote)
- (eq (car-safe (nth 1 fn)) 'lambda))
- (cons (car form)
- (cons (nth 1 form)
- (cons (cons 'function (cdr fn))
- (cdr (cdr (cdr form))))))
- form))))
-
;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
;; Otherwise it will be incompatible with the interpreter,
;; and (funcall (function foo)) will lose with autoloads.
(defun byte-compile-function-form (form)
- (byte-compile-constant
- (cond ((symbolp (nth 1 form))
- (nth 1 form))
- ((byte-compile-lambda (nth 1 form))))))
+ (if (symbolp (nth 1 form))
+ (byte-compile-constant (nth 1 form))
+ (byte-compile-closure (nth 1 form))))
(defun byte-compile-indent-to (form)
(let ((len (length form)))
(byte-compile-form (car (cdr bytecomp-args)))
(or for-effect (cdr (cdr bytecomp-args))
(byte-compile-out 'byte-dup 0))
- (byte-compile-variable-ref 'byte-varset (car bytecomp-args))
+ (byte-compile-variable-set (car bytecomp-args))
(setq bytecomp-args (cdr (cdr bytecomp-args))))
;; (setq), with no arguments.
(byte-compile-form nil for-effect))
(byte-defop-compiler-1 or)
(byte-defop-compiler-1 while)
(byte-defop-compiler-1 funcall)
-(byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-funarg)
-(byte-defop-compiler-1 mapatoms byte-compile-funarg)
-(byte-defop-compiler-1 mapconcat byte-compile-funarg)
-(byte-defop-compiler-1 mapc byte-compile-funarg)
-(byte-defop-compiler-1 maphash byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg-2)
-;; map-charset-chars should be funarg but has optional third arg
-(byte-defop-compiler-1 sort byte-compile-funarg-2)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let*)
(defun byte-compile-while (form)
(let ((endtag (byte-compile-make-tag))
- (looptag (byte-compile-make-tag)))
+ (looptag (byte-compile-make-tag))
+ ;; Heap environments can't be shared between a loop and its
+ ;; enclosing environment (because any lexical variables bound
+ ;; inside the loop should have an independent value for each
+ ;; iteration). Setting `byte-compile-current-num-closures' to
+ ;; an invalid value causes the code that tries to merge
+ ;; environments to not do so.
+ (byte-compile-current-num-closures -1))
(byte-compile-out-tag looptag)
(byte-compile-form (car (cdr form)))
(byte-compile-goto-if nil for-effect endtag)
(mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-call (length (cdr (cdr form)))))
+\f
+;; let binding
+
+;; All other lexical-binding functions are guarded by a non-nil return
+;; value from `byte-compile-compute-lforminfo', so they needn't be
+;; autoloaded.
+(autoload 'byte-compile-compute-lforminfo "byte-lexbind")
+
+(defun byte-compile-push-binding-init (clause init-lexenv lforminfo)
+ "Emit byte-codes to push the initialization value for CLAUSE on the stack.
+INIT-LEXENV is the lexical environment created for initializations
+already done for this form.
+LFORMINFO should be information about lexical variables being bound.
+Return INIT-LEXENV updated to include the newest initialization, or nil
+if LFORMINFO is nil (meaning all bindings are dynamic)."
+ (let* ((var (if (consp clause) (car clause) clause))
+ (vinfo
+ (and lforminfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+ (unused (and vinfo (zerop (cadr vinfo)))))
+ (unless (and unused (symbolp clause))
+ (when (and lforminfo (not unused))
+ ;; We record the stack position even of dynamic bindings and
+ ;; variables in non-stack lexical environments; we'll put
+ ;; them in the proper place below.
+ (push (byte-compile-make-lexvar var byte-compile-depth) init-lexenv))
+ (if (consp clause)
+ (byte-compile-form (cadr clause) unused)
+ (byte-compile-push-constant nil))))
+ init-lexenv)
(defun byte-compile-let (form)
- ;; First compute the binding values in the old scope.
- (let ((varlist (car (cdr form))))
- (dolist (var varlist)
- (if (consp var)
- (byte-compile-form (car (cdr var)))
- (byte-compile-push-constant nil))))
- (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
- (varlist (reverse (car (cdr form)))))
- (dolist (var varlist)
- (byte-compile-variable-ref 'byte-varbind
- (if (consp var) (car var) var)))
- (byte-compile-body-do-effect (cdr (cdr form)))
- (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+ "Generate code for the `let' form FORM."
+ (let ((clauses (cadr form))
+ (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+ (init-lexenv nil)
+ ;; bind these to restrict the scope of any changes
+ (byte-compile-current-heap-environment
+ byte-compile-current-heap-environment)
+ (byte-compile-current-num-closures byte-compile-current-num-closures))
+ (when (and lforminfo (byte-compile-non-stack-bindings-p clauses lforminfo))
+ ;; Some of the variables we're binding are lexical variables on
+ ;; the stack, but not all. As much as we can, rearrange the list
+ ;; so that non-stack lexical variables and dynamically bound
+ ;; variables come last, which allows slightly more optimal
+ ;; byte-code for binding them.
+ (setq clauses (byte-compile-rearrange-let-clauses clauses lforminfo)))
+ ;; If necessary, create a new heap environment to hold some of the
+ ;; variables bound here.
+ (when lforminfo
+ (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
+ ;; First compute the binding values in the old scope.
+ (dolist (clause clauses)
+ (setq init-lexenv
+ (byte-compile-push-binding-init clause init-lexenv lforminfo)))
+ ;; Now do the bindings, execute the body, and undo the bindings
+ (let ((byte-compile-bound-variables byte-compile-bound-variables)
+ (byte-compile-lexical-environment byte-compile-lexical-environment)
+ (preserve-body-value (not for-effect)))
+ (dolist (clause (reverse clauses))
+ (let ((var (if (consp clause) (car clause) clause)))
+ (cond ((null lforminfo)
+ ;; If there are no lexical bindings, we can do things simply.
+ (byte-compile-dynamic-variable-bind var))
+ ((byte-compile-bind var init-lexenv lforminfo)
+ (pop init-lexenv)))))
+ ;; Emit the body
+ (byte-compile-body-do-effect (cdr (cdr form)))
+ ;; Unbind the variables
+ (if lforminfo
+ ;; Unbind both lexical and dynamic variables
+ (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+ ;; Unbind dynamic variables
+ (byte-compile-out 'byte-unbind (length clauses))))))
(defun byte-compile-let* (form)
- (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
- (varlist (copy-sequence (car (cdr form)))))
- (dolist (var varlist)
- (if (atom var)
- (byte-compile-push-constant nil)
- (byte-compile-form (car (cdr var)))
- (setq var (car var)))
- (byte-compile-variable-ref 'byte-varbind var))
+ "Generate code for the `let*' form FORM."
+ (let ((clauses (cadr form))
+ (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+ (init-lexenv nil)
+ (preserve-body-value (not for-effect))
+ ;; bind these to restrict the scope of any changes
+ (byte-compile-bound-variables byte-compile-bound-variables)
+ (byte-compile-lexical-environment byte-compile-lexical-environment)
+ (byte-compile-current-heap-environment
+ byte-compile-current-heap-environment)
+ (byte-compile-current-num-closures byte-compile-current-num-closures))
+ ;; If necessary, create a new heap environment to hold some of the
+ ;; variables bound here.
+ (when lforminfo
+ (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
+ ;; Bind the variables
+ (dolist (clause clauses)
+ (setq init-lexenv
+ (byte-compile-push-binding-init clause init-lexenv lforminfo))
+ (let ((var (if (consp clause) (car clause) clause)))
+ (cond ((null lforminfo)
+ ;; If there are no lexical bindings, we can do things simply.
+ (byte-compile-dynamic-variable-bind var))
+ ((byte-compile-bind var init-lexenv lforminfo)
+ (pop init-lexenv)))))
+ ;; Emit the body
(byte-compile-body-do-effect (cdr (cdr form)))
- (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+ ;; Unbind the variables
+ (if lforminfo
+ ;; Unbind both lexical and dynamic variables
+ (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+ ;; Unbind dynamic variables
+ (byte-compile-out 'byte-unbind (length clauses)))))
+\f
(byte-defop-compiler-1 /= byte-compile-negated)
(byte-defop-compiler-1 atom byte-compile-negated)
"Compiler error: `%s' has no `byte-compile-negated-op' property"
(car form)))
(cdr form))))
+
\f
;;; other tricky macro-like special-forms
(defun byte-compile-track-mouse (form)
(byte-compile-form
+ ;; Use quote rather that #' here, because we don't want to go
+ ;; through the body again, which would lead to an infinite recursion:
+ ;; "byte-compile-track-mouse" (0xbffc98e4)
+ ;; "byte-compile-form" (0xbffc9c54)
+ ;; "byte-compile-top-level" (0xbffc9fd4)
+ ;; "byte-compile-lambda" (0xbffca364)
+ ;; "byte-compile-closure" (0xbffca6d4)
+ ;; "byte-compile-function-form" (0xbffcaa44)
+ ;; "byte-compile-form" (0xbffcadc0)
+ ;; "mapc" (0xbffcaf74)
+ ;; "byte-compile-funcall" (0xbffcb2e4)
+ ;; "byte-compile-form" (0xbffcb654)
+ ;; "byte-compile-track-mouse" (0xbffcb9d4)
`(funcall '(lambda nil
(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
;; "`%s' is not a known condition name (in condition-case)"
;; condition))
)
- (setq compiled-clauses
- (cons (cons condition
- (byte-compile-top-level-body
- (cdr clause) for-effect))
- compiled-clauses)))
+ (push (cons condition
+ (byte-compile-top-level-body
+ (cdr clause) for-effect))
+ compiled-clauses))
(setq clauses (cdr clauses)))
(byte-compile-push-constant (nreverse compiled-clauses)))
(byte-compile-out 'byte-condition-case 0)))
(byte-compile-set-symbol-position (car form))
(byte-compile-set-symbol-position 'defun)
(error "defun name must be a symbol, not %s" (car form)))
- ;; We prefer to generate a defalias form so it will record the function
- ;; definition just like interpreting a defun.
- (byte-compile-form
- (list 'defalias
- (list 'quote (nth 1 form))
- (byte-compile-byte-code-maker
- (byte-compile-lambda (cdr (cdr form)) t)))
- t)
- (byte-compile-constant (nth 1 form)))
+ (let ((for-effect nil))
+ (byte-compile-push-constant 'defalias)
+ (byte-compile-push-constant (nth 1 form))
+ (byte-compile-closure (cdr (cdr form)) t))
+ (byte-compile-out 'byte-call 2))
(defun byte-compile-defmacro (form)
;; This is not used for file-level defmacros with doc strings.
- (byte-compile-body-do-effect
- (let ((decls (byte-compile-defmacro-declaration form))
- (code (byte-compile-byte-code-maker
- (byte-compile-lambda (cdr (cdr form)) t))))
- `((defalias ',(nth 1 form)
- ,(if (eq (car-safe code) 'make-byte-code)
- `(cons 'macro ,code)
- `'(macro . ,(eval code))))
- ,@decls
- ',(nth 1 form)))))
+ ;; FIXME handle decls, use defalias?
+ (let ((decls (byte-compile-defmacro-declaration form))
+ (code (byte-compile-lambda (cdr (cdr form)) t))
+ (for-effect nil))
+ (byte-compile-push-constant (nth 1 form))
+ (if (not (byte-compile-closure-code-p code))
+ ;; simple lambda
+ (byte-compile-push-constant (cons 'macro code))
+ (byte-compile-push-constant 'macro)
+ (byte-compile-make-closure code)
+ (byte-compile-out 'byte-cons))
+ (byte-compile-out 'byte-fset)
+ (byte-compile-discard))
+ (byte-compile-constant (nth 1 form)))
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
;; Put the defined variable in this library's load-history entry
;; just as a real defvar would, but only in top-level forms.
(when (and (cddr form) (null byte-compile-current-form))
- `(push ',var current-load-list))
+ `(setq current-load-list (cons ',var current-load-list)))
(when (> (length form) 3)
(when (and string (not (stringp string)))
(byte-compile-warn "third arg to `%s %s' is not a string: %s"
`(if (not (default-boundp ',var)) (setq-default ,var ,value))))
(when (eq fun 'defconst)
;; This will signal an appropriate error at runtime.
- `(eval ',form)))
+ `(eval ',form))) ;FIXME: lexbind
`',var))))
(defun byte-compile-autoload (form)
(setq byte-compile-depth (and (not (eq opcode 'byte-goto))
(1- byte-compile-depth))))
-(defun byte-compile-out (opcode offset)
- (push (cons opcode offset) byte-compile-output)
- (cond ((eq opcode 'byte-call)
- (setq byte-compile-depth (- byte-compile-depth offset)))
- ((eq opcode 'byte-return)
- ;; This is actually an unnecessary case, because there should be
- ;; no more opcodes behind byte-return.
- (setq byte-compile-depth nil))
- (t
- (setq byte-compile-depth (+ byte-compile-depth
- (or (aref byte-stack+-info
- (symbol-value opcode))
- (- (1- offset))))
- byte-compile-maxdepth (max byte-compile-depth
- byte-compile-maxdepth))))
- ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
- )
+(defun byte-compile-stack-adjustment (op operand)
+ "Return the amount by which an operation adjusts the stack.
+OP and OPERAND are as passed to `byte-compile-out'."
+ (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos))
+ ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1
+ ;; elements, and the push the result, for a total of -OPERAND.
+ ;; For discardN*, of course, we just pop OPERAND elements.
+ (- operand)
+ (or (aref byte-stack+-info (symbol-value op))
+ ;; Ops with a nil entry in `byte-stack+-info' are byte-codes
+ ;; that take OPERAND values off the stack and push a result, for
+ ;; a total of 1 - OPERAND
+ (- 1 operand))))
+
+(defun byte-compile-out (op &optional operand)
+ (push (cons op operand) byte-compile-output)
+ (if (eq op 'byte-return)
+ ;; This is actually an unnecessary case, because there should be no
+ ;; more ops behind byte-return.
+ (setq byte-compile-depth nil)
+ (setq byte-compile-depth
+ (+ byte-compile-depth (byte-compile-stack-adjustment op operand)))
+ (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth))
+ ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
+ ))
+
+(defun byte-compile-delay-out (&optional stack-used stack-adjust)
+ "Add a placeholder to the output, which can be used to later add byte-codes.
+Return a position tag that can be passed to `byte-compile-delayed-out'
+to add the delayed byte-codes. STACK-USED is the maximum amount of
+stack-spaced used by the delayed byte-codes (defaulting to 0), and
+STACK-ADJUST is the amount by which the later-added code will adjust the
+stack (defaulting to 0); the byte-codes added later _must_ adjust the
+stack by this amount! If STACK-ADJUST is 0, then it's not necessary to
+actually add anything later; the effect as if nothing was added at all."
+ ;; We just add a no-op to `byte-compile-output', and return a pointer to
+ ;; the tail of the list; `byte-compile-delayed-out' uses list surgery
+ ;; to add the byte-codes.
+ (when stack-used
+ (setq byte-compile-maxdepth
+ (max byte-compile-depth (+ byte-compile-depth (or stack-used 0)))))
+ (when stack-adjust
+ (setq byte-compile-depth
+ (+ byte-compile-depth stack-adjust)))
+ (push (cons nil (or stack-adjust 0)) byte-compile-output))
+
+(defun byte-compile-delayed-out (position op &optional operand)
+ "Add at POSITION the byte-operation OP, with optional numeric arg OPERAND.
+POSITION should a position returned by `byte-compile-delay-out'.
+Return a new position, which can be used to add further operations."
+ (unless (null (caar position))
+ (error "Bad POSITION arg to `byte-compile-delayed-out'"))
+ ;; This is kind of like `byte-compile-out', but we splice into the list
+ ;; where POSITION is. We don't bother updating `byte-compile-maxdepth'
+ ;; because that was already done by `byte-compile-delay-out', but we do
+ ;; update the relative operand stored in the no-op marker currently at
+ ;; POSITION; since we insert before that marker, this means that if the
+ ;; caller doesn't insert a sequence of byte-codes that matches the expected
+ ;; operand passed to `byte-compile-delay-out', then the nop will still have
+ ;; a non-zero operand when `byte-compile-lapcode' is called, which will
+ ;; cause an error to be signaled.
+
+ ;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op
+ (setcdr (car position)
+ (- (cdar position) (byte-compile-stack-adjustment op operand)))
+ ;; Add the new operation onto the list tail at POSITION
+ (setcdr position (cons (cons op operand) (cdr position)))
+ position)
\f
;;; call tree stuff