Function: comp--limplify-lap-inst
comp--limplify-lap-inst is a byte-compiled function defined in
comp.el.gz.
Signature
(comp--limplify-lap-inst INSN)
Documentation
Limplify LAP instruction INSN pushing it in the proper basic block.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/comp.el.gz
(defun comp--limplify-lap-inst (insn)
"Limplify LAP instruction INSN pushing it in the proper basic block."
(let ((op (car insn))
(arg (if (consp (cdr insn))
(cadr insn)
(cdr insn))))
(comp--op-case
(TAG
(cl-destructuring-bind (_TAG label-num . label-sp) insn
;; Paranoid?
(when label-sp
(cl-assert (= (1- label-sp) (comp-limplify-sp comp-pass))))
(comp--emit-annotation (format "LAP TAG %d" label-num))))
(byte-stack-ref
(comp--copy-slot (- (comp--sp) arg 1)))
(byte-varref
(comp--emit-set-call (comp--call 'symbol-value (make--comp-mvar
:constant arg))))
(byte-varset
(comp--emit (comp--call 'set_internal
(make--comp-mvar :constant arg)
(comp--slot+1))))
(byte-varbind ;; Verify
(comp--emit (comp--call 'specbind
(make--comp-mvar :constant arg)
(comp--slot+1))))
(byte-call
(incf (comp--sp) (- arg))
(comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp))))
(byte-unbind
(comp--emit (comp--call 'helper_unbind_n
(make--comp-mvar :constant arg))))
(byte-pophandler
(comp--emit '(pop-handler)))
(byte-pushconditioncase
(comp--emit-handler (cddr insn) 'condition-case))
(byte-pushcatch
(comp--emit-handler (cddr insn) 'catcher))
(byte-nth auto)
(byte-symbolp auto)
(byte-consp auto)
(byte-stringp auto)
(byte-listp auto)
(byte-eq auto)
(byte-memq auto)
(byte-not
(comp--emit-set-call (comp--call 'eq (comp--slot-n (comp--sp))
(make--comp-mvar :constant nil))))
(byte-car auto)
(byte-cdr auto)
(byte-cons auto)
(byte-list1
(comp--limplify-listn 1))
(byte-list2
(comp--limplify-listn 2))
(byte-list3
(comp--limplify-listn 3))
(byte-list4
(comp--limplify-listn 4))
(byte-length auto)
(byte-aref auto)
(byte-aset auto)
(byte-symbol-value auto)
(byte-symbol-function auto)
(byte-set auto)
(byte-fset auto)
(byte-get auto)
(byte-substring auto)
(byte-concat2
(comp--emit-set-call (comp--callref 'concat 2 (comp--sp))))
(byte-concat3
(comp--emit-set-call (comp--callref 'concat 3 (comp--sp))))
(byte-concat4
(comp--emit-set-call (comp--callref 'concat 4 (comp--sp))))
(byte-sub1 1-)
(byte-add1 1+)
(byte-eqlsign =)
(byte-gtr >)
(byte-lss <)
(byte-leq <=)
(byte-geq >=)
(byte-diff -)
(byte-negate
(comp--emit-set-call (comp--call 'negate (comp--slot))))
(byte-plus +)
(byte-max auto)
(byte-min auto)
(byte-mult *)
(byte-point auto)
(byte-goto-char auto)
(byte-insert auto)
(byte-point-max auto)
(byte-point-min auto)
(byte-char-after auto)
(byte-following-char auto)
(byte-preceding-char preceding-char)
(byte-current-column auto)
(byte-indent-to
(comp--emit-set-call (comp--call 'indent-to
(comp--slot)
(make--comp-mvar :constant nil))))
(byte-scan-buffer-OBSOLETE)
(byte-eolp auto)
(byte-eobp auto)
(byte-bolp auto)
(byte-bobp auto)
(byte-current-buffer auto)
(byte-set-buffer auto)
(byte-save-current-buffer
(comp--emit (comp--call 'record_unwind_current_buffer)))
(byte-set-mark-OBSOLETE)
(byte-interactive-p-OBSOLETE)
(byte-forward-char auto)
(byte-forward-word auto)
(byte-skip-chars-forward auto)
(byte-skip-chars-backward auto)
(byte-forward-line auto)
(byte-char-syntax auto)
(byte-buffer-substring auto)
(byte-delete-region auto)
(byte-narrow-to-region
(comp--emit-set-call (comp--call 'narrow-to-region
(comp--slot)
(comp--slot+1))))
(byte-widen
(comp--emit-set-call (comp--call 'widen)))
(byte-end-of-line auto)
(byte-constant2) ; TODO
;; Branches.
(byte-goto
(comp--emit-uncond-jump (cddr insn)))
(byte-goto-if-nil
(comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0
(cddr insn) nil))
(byte-goto-if-not-nil
(comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 0
(cddr insn) t))
(byte-goto-if-nil-else-pop
(comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1
(cddr insn) nil))
(byte-goto-if-not-nil-else-pop
(comp--emit-cond-jump (comp--slot+1) (make--comp-mvar :constant nil) 1
(cddr insn) t))
(byte-return
(comp--emit `(return ,(comp--slot+1))))
(byte-discard 'pass)
(byte-dup
(comp--copy-slot (1- (comp--sp))))
(byte-save-excursion
(comp--emit (comp--call 'record_unwind_protect_excursion)))
(byte-save-window-excursion-OBSOLETE)
(byte-save-restriction
(comp--emit (comp--call 'helper_save_restriction)))
(byte-catch) ;; Obsolete
(byte-unwind-protect
(comp--emit (comp--call 'helper_unwind_protect (comp--slot+1))))
(byte-condition-case) ;; Obsolete
(byte-temp-output-buffer-setup-OBSOLETE)
(byte-temp-output-buffer-show-OBSOLETE)
(byte-set-marker auto)
(byte-match-beginning auto)
(byte-match-end auto)
(byte-upcase auto)
(byte-downcase auto)
(byte-string= string-equal)
(byte-string< string-lessp)
(byte-equal auto)
(byte-nthcdr auto)
(byte-elt auto)
(byte-member auto)
(byte-assq auto)
(byte-nreverse auto)
(byte-setcar auto)
(byte-setcdr auto)
(byte-car-safe auto)
(byte-cdr-safe auto)
(byte-nconc auto)
(byte-quo /)
(byte-rem %)
(byte-numberp auto)
(byte-integerp auto)
(byte-listN
(incf (comp--sp) (- 1 arg))
(comp--emit-set-call (comp--callref 'list arg (comp--sp))))
(byte-concatN
(incf (comp--sp) (- 1 arg))
(comp--emit-set-call (comp--callref 'concat arg (comp--sp))))
(byte-insertN
(incf (comp--sp) (- 1 arg))
(comp--emit-set-call (comp--callref 'insert arg (comp--sp))))
(byte-stack-set
(comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1)))
(byte-stack-set2 (cl-assert nil)) ;; TODO
(byte-discardN
(incf (comp--sp) (- arg)))
(byte-switch
;; Assume to follow the emission of a setimm.
;; This is checked into comp--emit-switch.
(comp--emit-switch (comp--slot+1)
(cl-first (comp-block-insns
(comp-limplify-curr-block comp-pass)))))
(byte-constant
(comp--emit-setimm arg))
(byte-discardN-preserve-tos
(incf (comp--sp) (- arg))
(comp--copy-slot (+ arg (comp--sp)))))))