-(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)